diff --git a/Application.hs b/Application.hs index 214003d..a526580 100644 --- a/Application.hs +++ b/Application.hs @@ -9,12 +9,8 @@ module Application import qualified Aws import Control.Concurrent (forkIO, threadDelay) import Control.Exception (catch) -import Control.Monad.Logger (runLoggingT, LoggingT, runStdoutLoggingT, defaultLogStr, LogLevel (LevelDebug)) -import Control.Monad.Reader (MonadReader (..)) -import Control.Monad.Reader (runReaderT, ReaderT) -import Control.Monad.Trans.Control +import Control.Monad.Logger (runLoggingT, LoggingT, defaultLogStr) import Data.BlobStore (fileStore, storeWrite, cachedS3Store) -import Data.Conduit.Lazy (MonadActive, monadActive) import Data.Hackage import Data.Hackage.Views import Data.Time (diffUTCTime) diff --git a/Data/BlobStore.hs b/Data/BlobStore.hs index 2a6f71c..65ee779 100644 --- a/Data/BlobStore.hs +++ b/Data/BlobStore.hs @@ -11,9 +11,7 @@ module Data.BlobStore ) where import ClassyPrelude.Yesod -import Control.Exception.Lifted (bracketOnError) import qualified Filesystem as F -import Control.Monad.Reader (MonadReader, ask) import Control.Monad.Trans.Resource (release) import qualified Aws import Aws.S3 as Aws diff --git a/Data/Hackage.hs b/Data/Hackage.hs index 3c91fb3..2082f88 100644 --- a/Data/Hackage.hs +++ b/Data/Hackage.hs @@ -14,13 +14,11 @@ import Types import Data.BlobStore import Data.Conduit.Lazy (MonadActive (..), lazyConsume) import qualified Codec.Archive.Tar as Tar -import Control.Monad.Reader (MonadReader, ask, runReaderT) import Control.Monad.Logger (runNoLoggingT) import qualified Data.Text as T import Data.Conduit.Zlib (ungzip, gzip) import System.IO.Temp (withSystemTempFile, withSystemTempDirectory) import System.IO (IOMode (ReadMode), openBinaryFile) -import Control.Monad.Catch (MonadMask) import Model (Uploaded (Uploaded), Metadata (..)) import Filesystem (createTree) import Distribution.PackageDescription.Parse (parsePackageDescription, ParseResult (ParseOk)) diff --git a/Data/Slug.hs b/Data/Slug.hs index 50d8f3a..cc60ef3 100644 --- a/Data/Slug.hs +++ b/Data/Slug.hs @@ -13,7 +13,6 @@ module Data.Slug import ClassyPrelude.Yesod import Database.Persist.Sql (PersistFieldSql (sqlType)) import qualified System.Random.MWC as MWC -import Control.Monad.Reader (MonadReader, ask) import GHC.Prim (RealWorld) import Text.Blaze (ToMarkup) @@ -32,9 +31,9 @@ mkSlug t where mkSlugLen :: MonadThrow m => Int -> Int -> Text -> m Slug -mkSlugLen minLen maxLen t - | length t < minLen = throwM $ InvalidSlugException t "Too short" - | length t > maxLen = throwM $ InvalidSlugException t "Too long" +mkSlugLen minLen' maxLen' t + | length t < minLen' = throwM $ InvalidSlugException t "Too short" + | length t > maxLen' = throwM $ InvalidSlugException t "Too long" | any (not . validChar) t = throwM $ InvalidSlugException t "Contains invalid characters" | "-" `isPrefixOf` t = throwM $ InvalidSlugException t "Must not start with a hyphen" | otherwise = return $ Slug t diff --git a/Foundation.hs b/Foundation.hs index 9a73f08..65ea1fe 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -112,7 +112,7 @@ instance Yesod App where mcurr <- getCurrentRoute let notHome = mcurr /= Just HomeR - giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") + withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This is done to provide an optimization for serving static files from -- a separate domain. Please see the staticRoot setting in Settings.hs diff --git a/Handler/Package.hs b/Handler/Package.hs index 73dffb4..31e5469 100644 --- a/Handler/Package.hs +++ b/Handler/Package.hs @@ -20,8 +20,6 @@ import Text.Email.Validate getPackageR :: PackageName -> Handler Html getPackageR pn = do let maxSnaps = 10 - asInt :: Int -> Int - asInt = id haddocksLink ident version = HaddockR ident [concat [toPathPiece pn, "-", toPathPiece version]] muid <- maybeAuthId @@ -38,8 +36,8 @@ getPackageR pn = do let getLiked uid = (>0) <$> count [LikePackage ==. pn, LikeVoter ==. uid] liked <- maybe (return False) getLiked muid downloads <- count [DownloadPackage ==. pn] - now <- liftIO getCurrentTime - let nowMinus30 = addUTCTime (-30 * 24 * 60 * 60) now + now' <- liftIO getCurrentTime + let nowMinus30 = addUTCTime (-30 * 24 * 60 * 60) now' recentDownloads <- count [DownloadPackage ==. pn, DownloadTimestamp >=. nowMinus30] metadata <- getBy404 (UniqueMetadata pn) diff --git a/Handler/Snapshots.hs b/Handler/Snapshots.hs index 4f8e710..067bc0d 100644 --- a/Handler/Snapshots.hs +++ b/Handler/Snapshots.hs @@ -17,8 +17,8 @@ import Import -- inclined, or create a single monolithic file. getAllSnapshotsR :: Handler Html getAllSnapshotsR = do - now <- liftIO getCurrentTime - groups <- fmap (groupBy (on (==) (\(_,_,uploaded,_,_) -> uploaded)) . map (uncrapify now)) $ + now' <- liftIO getCurrentTime + groups <- fmap (groupBy (on (==) (\(_,_,uploaded,_,_) -> uploaded)) . map (uncrapify now')) $ runDB $ E.select $ E.from $ \(stackage `E.InnerJoin` user) -> do E.on (stackage E.^. StackageUser E.==. user E.^. UserId) E.orderBy [E.desc $ stackage E.^. StackageUploaded] @@ -32,6 +32,6 @@ getAllSnapshotsR = do defaultLayout $ do setTitle "Stackage Server" $(widgetFile "all-snapshots") - where uncrapify now c = - let (E.Value ident, E.Value title, E.Value uploaded, E.Value display, E.Value handle) = c - in (ident,title,format (diff True) (diffUTCTime uploaded now),display,handle) + where uncrapify now' c = + let (E.Value ident, E.Value title, E.Value uploaded, E.Value display, E.Value handle') = c + in (ident,title,format (diff True) (diffUTCTime uploaded now'),display,handle') diff --git a/Handler/StackageIndex.hs b/Handler/StackageIndex.hs index 0e95139..38feeda 100644 --- a/Handler/StackageIndex.hs +++ b/Handler/StackageIndex.hs @@ -2,7 +2,6 @@ module Handler.StackageIndex where import Import import Data.BlobStore -import Network.Wai (responseBuilder) getStackageIndexR :: PackageSetIdent -> Handler TypedContent getStackageIndexR ident = do diff --git a/templates/all-snapshots.hamlet b/templates/all-snapshots.hamlet index 39d13d0..7fafd1a 100644 --- a/templates/all-snapshots.hamlet +++ b/templates/all-snapshots.hamlet @@ -5,7 +5,7 @@