Update to ghc-8.8, pantry-0.2 and Cabal-3.0

2026-01-11 19:58:28 +01:00 · 2020-02-12 02:09:35 +03:00 · 2020-02-12 02:09:35 +03:00 · 8e247dde03
commit 8e247dde03
parent 722260e1d4
22 changed files with 57 additions and 61 deletions
--- a/package.yaml
+++ b/package.yaml
@ -39,6 +39,7 @@ dependencies:
 - persistent-template
 - resourcet
 - rio
+- semialign
 - shakespeare
 - tar-conduit
 - template-haskell
--- a/src/Data/WebsiteContent.hs
+++ b/src/Data/WebsiteContent.hs
@ -11,7 +11,6 @@ module Data.WebsiteContent

 import ClassyPrelude.Yesod
 import CMarkGFM
-import Data.Aeson (withObject)
 import Data.GhcLinks
 import Data.Yaml
 import System.FilePath (takeFileName)
--- a/src/Handler/Blog.hs
+++ b/src/Handler/Blog.hs
@ -86,4 +86,5 @@ getBlogFeedR = do
            , feedEntryTitle = postTitle post
            , feedEntryContent = postBody post
            , feedEntryEnclosure = Nothing
+            , feedEntryCategories = []
            }
--- a/src/Handler/Download.hs
+++ b/src/Handler/Download.hs
@ -12,7 +12,6 @@ import Import
 import Data.GhcLinks
 import Yesod.GitRepo (grContent)
 import Stackage.Database
-import Stackage.Database.Types (ghcVersion)

 getDownloadR :: Handler Html
 getDownloadR = track "Hoogle.Download.getDownloadR" $
--- a/src/Handler/Feed.hs
+++ b/src/Handler/Feed.hs
@ -12,7 +12,6 @@ import RIO.Time (getCurrentTime)
 import Stackage.Database
 import Stackage.Snapshot.Diff
 import Text.Blaze (text)
-import Yesod.Core.Handler (lookupGetParam)

 getFeedR :: Handler TypedContent
 getFeedR = track "Handler.Feed.getBranchFeedR" $ getBranchFeed Nothing
@ -38,6 +37,7 @@ mkFeed mBranch snaps = do
            , feedEntryTitle = snapshotTitle snap
            , feedEntryContent = content
            , feedEntryEnclosure = Nothing
+            , feedEntryCategories = []
            }
    updated <-
        case entries of
--- a/src/Handler/Haddock.hs
+++ b/src/Handler/Haddock.hs
@ -7,7 +7,6 @@ module Handler.Haddock
 import Import
 import qualified Data.Text as T (takeEnd)
 import Stackage.Database
-import Stackage.Database.Types (haddockBucketName)

 makeURL :: SnapName -> [Text] -> Text
 makeURL snapName rest = concat
--- a/src/Handler/Hoogle.hs
+++ b/src/Handler/Hoogle.hs
@ -8,7 +8,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Handler.Hoogle where

-import Control.DeepSeq (NFData(..))
 import qualified Data.Text as T
 import Data.Text.Read (decimal)
 import qualified Hoogle
--- a/src/Handler/MirrorStatus.hs
+++ b/src/Handler/MirrorStatus.hs
@ -8,7 +8,7 @@ module Handler.MirrorStatus
 import Import
 import Control.AutoUpdate
 import Network.HTTP.Simple
-import RIO.Time (parseTimeM, diffUTCTime, addUTCTime, getCurrentTime)
+import RIO.Time (diffUTCTime, addUTCTime, getCurrentTime)
 import Text.XML.Stream.Parse
 import Data.XML.Types (Event (EventContent), Content (ContentText))
 import qualified Prelude
--- a/src/Handler/Package.hs
+++ b/src/Handler/Package.hs
@ -27,8 +27,6 @@ import Graphics.Badge.Barrier
 import Import
 import Stackage.Database
 import Stackage.Database.PackageInfo (PackageInfo(..), Identifier(..), renderEmail)
-import Stackage.Database.Types (HackageCabalInfo(..), LatestInfo(..),
-                                ModuleListingInfo(..))
 import qualified Text.Blaze.Html.Renderer.Text as LT
 import Yesod.GitRepo

--- a/src/Handler/PackageDeps.hs
+++ b/src/Handler/PackageDeps.hs
@ -9,9 +9,7 @@ module Handler.PackageDeps

 import Handler.StackageSdist (pnvToSnapshotPackageInfo)
 import Import
-import Types (PackageVersionRev(..))
 import Stackage.Database
-import Stackage.Database.Types (SnapshotPackageInfo(..))

 getPackageDepsR :: PackageNameP -> Handler Html
 getPackageDepsR pname = do
--- a/src/Handler/StackageHome.hs
+++ b/src/Handler/StackageHome.hs
@ -17,7 +17,6 @@ import Data.These
 import RIO.Time (FormatTime)
 import Import
 import Stackage.Database
-import Stackage.Database.Types (PackageListingInfo(..), isLts)
 import Stackage.Snapshot.Diff

 getStackageHomeR :: SnapName -> Handler TypedContent
--- a/src/Handler/StackageSdist.hs
+++ b/src/Handler/StackageSdist.hs
@ -6,7 +6,6 @@ module Handler.StackageSdist

 import Import
 import Stackage.Database
-import Stackage.Database.Types (SnapshotPackageInfo(..))
 import Handler.Package (packagePage)

 handlePNVTarball :: PackageNameP -> VersionP -> Handler TypedContent
--- a/src/Import.hs
+++ b/src/Import.hs
@ -3,19 +3,16 @@ module Import
    ( module Import
    ) where

-import Control.Monad.Trans.Class (lift)
 import ClassyPrelude.Yesod as Import hiding (getCurrentTime)
 import Foundation as Import
 import Settings as Import
 import Settings.StaticFiles as Import
 import Types as Import
 import Yesod.Auth as Import
-import Yesod.Core.Handler (getYesod)
 import Data.WebsiteContent as Import (WebsiteContent (..))
 import Data.Text.Read (decimal)
 import RIO.Time (diffUTCTime)
 --import qualified Prometheus as P
-import Stackage.Database (SnapName)
 import Stackage.Database.Types (ModuleListingInfo(..))
 import Formatting (format)
 import Formatting.Time (diff)
--- a/src/Stackage/Database/Cron.hs
+++ b/src/Stackage/Database/Cron.hs
@ -28,24 +28,21 @@ import Data.Streaming.Network (bindPortTCP)
 import Data.Yaml (decodeFileEither)
 import Database.Persist
 import Database.Persist.Postgresql
-import Distribution.PackageDescription (GenericPackageDescription)
 import qualified Hoogle
 import Network.AWS hiding (Request, Response)
-import Network.AWS.Data.Body (toBody)
 import Network.AWS.Data.Text (toText)
 import Network.AWS.S3
 import Network.HTTP.Client
 import Network.HTTP.Client.Conduit (bodyReaderSource)
-import Network.HTTP.Simple (getResponseBody, httpJSONEither, parseRequest)
+import Network.HTTP.Simple (getResponseBody, httpJSONEither)
 import Network.HTTP.Types (status200, status404)
 import Pantry (CabalFileInfo(..), DidUpdateOccur(..),
               HpackExecutable(HpackBundled), PackageIdentifierRevision(..),
-               defaultHackageSecurityConfig)
-import Pantry.Internal.Stackage (HackageCabalId, HackageTarballResult(..),
+               defaultHackageSecurityConfig, defaultCasaRepoPrefix, defaultCasaMaxPerRequest)
+import Pantry.Internal.Stackage (HackageTarballResult(..),
                                 PantryConfig(..), Storage(..),
                                 forceUpdateHackageIndex, getHackageTarball,
-                                 getTreeForKey, loadBlobById, packageTreeKey,
-                                 treeCabal)
+                                 packageTreeKey)
 import Path (parseAbsDir, toFilePath)
 import RIO
 import RIO.Directory
@ -192,6 +189,8 @@ stackageServerCron StackageCronOptions {..} = do
                        , pcParsedCabalFilesRawImmutable = cabalImmutable
                        , pcParsedCabalFilesMutable = cabalMutable
                        , pcConnectionCount = connectionCount
+                        , pcCasaRepoPrefix = defaultCasaRepoPrefix
+                        , pcCasaMaxPerRequest = defaultCasaMaxPerRequest
                        }
                stackage =
                    StackageCron
@ -453,19 +452,15 @@ sourceSnapshots = do
                            "Error parsing snapshot file: " <> fromString fp <> "\n" <>
                            fromString (displayException exc)
                        return Nothing
-        lastGitFileUpdate gitDir fp >>= \case
-            Left err -> do
-                logError $ "Error parsing git commit date: " <> fromString err
-                return Nothing
-            Right updatedOn -> do
-                env <- lift ask
-                return $
-                    Just
-                        SnapshotFileInfo
-                            { sfiSnapName = snapName
-                            , sfiUpdatedOn = updatedOn
-                            , sfiSnapshotFileGetter = runRIO env (parseSnapshot updatedOn)
-                            }
+        mUpdatedOn <- lastGitFileUpdate gitDir fp
+        forM mUpdatedOn $ \updatedOn -> do
+            env <- lift ask
+            return $
+                SnapshotFileInfo
+                    { sfiSnapName = snapName
+                    , sfiUpdatedOn = updatedOn
+                    , sfiSnapshotFileGetter = runRIO env (parseSnapshot updatedOn)
+                    }
    getLtsParser gitDir fp =
        case mapM (BS8.readInt . BS8.pack) $ take 2 $ reverse (splitPath fp) of
            Just [(minor, ".yaml"), (major, "/")] ->
--- a/src/Stackage/Database/Github.hs
+++ b/src/Stackage/Database/Github.hs
@ -15,6 +15,7 @@ import RIO.FilePath
 import RIO.Process
 import RIO.Time

+
 data GithubRepo = GithubRepo
    { grAccount :: !String
    , grName    :: !String
@ -33,17 +34,22 @@ lastGitFileUpdate ::
       (MonadReader env m, HasLogFunc env, HasProcessContext env, MonadUnliftIO m)
    => FilePath -- ^ Root dir of the repository
    -> FilePath -- ^ Relative path of the file
-    -> m (Either String UTCTime)
+    -> m (Maybe UTCTime)
 lastGitFileUpdate gitDir filePath = do
    lastCommitTimestamps <- gitLog gitDir filePath ["-1", "--format=%cD"]
    parseGitDate rfc822DateFormat lastCommitTimestamps
  where
    parseGitDate fmt dates =
        case listToMaybe $ LBS8.lines dates of
-            Nothing -> return $ Left "Git log is empty for the file"
-            Just lbsDate ->
-                mapLeft (displayException :: SomeException -> String) <$>
-                try (parseTimeM False defaultTimeLocale fmt (LBS8.unpack lbsDate))
+            Nothing -> do
+                logError "Git log is empty for the file"
+                return Nothing
+            Just lbsDate -> do
+                let parseDateTime = parseTimeM False defaultTimeLocale fmt (LBS8.unpack lbsDate)
+                catchAny (Just <$> liftIO parseDateTime) $ \exc -> do
+                    logError $
+                        "Error parsing git commit date: " <> fromString (displayException exc)
+                    pure Nothing

 -- | Clone a repository locally. In case when repository is already present sync it up with
 -- remote. Returns the full path where repository was cloned into.
--- a/src/Stackage/Database/Haddock.hs
+++ b/src/Stackage/Database/Haddock.hs
@ -38,9 +38,7 @@ hToHtml =
        H.dt (go x) ++ H.dd (go y)
    go (DocCodeBlock x) = H.pre $ H.code $ go x
    go (DocHyperlink (Hyperlink url mlabel)) =
-        H.a H.! A.href (H.toValue url) $ toHtml label
-      where
-        label = fromMaybe url mlabel
+        H.a H.! A.href (H.toValue url) $ maybe (toHtml url) (toHtml . go) mlabel
    go (DocPic (Picture url mtitle)) =
        H.img H.! A.src (H.toValue url) H.! A.title (H.toValue $ fromMaybe mempty mtitle)
    go (DocAName s) = H.div H.! A.id (H.toValue s) $ mempty
--- a/src/Stackage/Database/PackageInfo.hs
+++ b/src/Stackage/Database/PackageInfo.hs
@ -18,8 +18,6 @@ import Data.Coerce
 import Data.Char (isSpace)
 import Data.Map.Merge.Strict as Map
 import qualified Data.Text as T
-import Data.Text.Encoding (decodeUtf8With)
-import Data.Text.Encoding.Error (lenientDecode)
 import Distribution.Compiler (CompilerFlavor(GHC))
 import Distribution.Package (Dependency(..))
 import Distribution.PackageDescription (CondTree(..), Condition(..),
@ -172,7 +170,7 @@ getDeps checkCond = goTree
  where
    goTree (CondNode _data deps comps) =
        combineDeps $
-        map (\(Dependency name range) -> Map.singleton (PackageNameP name) range) deps ++
+        map (\(Dependency name range _) -> Map.singleton (PackageNameP name) range) deps ++
        map goComp comps
    goComp (CondBranch cond yes no)
        | checkCond cond = goTree yes
--- a/src/Stackage/Database/Query.hs
+++ b/src/Stackage/Database/Query.hs
@ -72,10 +72,10 @@ import Database.Esqueleto
 import Database.Esqueleto.Internal.Language (FromPreprocess)
 import Database.Esqueleto.Internal.Sql
 import qualified Database.Persist as P
-import Pantry.Internal.Stackage (EntityField(..), PackageName, Unique(..),
+import Pantry.Internal.Stackage (EntityField(..), PackageName,
                                 Version, getBlobKey, getPackageNameById,
                                 getPackageNameId, getTreeForKey, getVersionId,
-                                 loadBlobById, mkSafeFilePath, treeCabal)
+                                 loadBlobById, mkSafeFilePath)
 import RIO hiding (on, (^.))
 import qualified RIO.Map as Map
 import qualified RIO.Set as Set
@ -364,7 +364,7 @@ getPackageVersionForSnapshot snapshotId pname =
             pure (v ^. VersionVersion))

 getLatest ::
-       FromPreprocess SqlQuery SqlExpr SqlBackend t
+       FromPreprocess t
    => PackageNameP
    -> (t -> SqlExpr (Value SnapshotId))
    -> (t -> SqlQuery ())
--- a/src/Stackage/Database/Schema.hs
+++ b/src/Stackage/Database/Schema.hs
@ -1,3 +1,4 @@
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
@ -8,8 +9,10 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Stackage.Database.Schema
    ( -- * Database
      run
--- a/src/Stackage/Database/Types.hs
+++ b/src/Stackage/Database/Types.hs
@ -52,8 +52,7 @@ import Data.Text.Read (decimal)
 import Network.AWS (Env, HasEnv(..))
 import Pantry (BlobKey(..), CabalFileInfo(..), FileSize(..),
               HasPantryConfig(..), PackageIdentifierRevision(..), TreeKey(..))
-import Pantry.Internal.Stackage as Pantry (PackageNameP(..), PantryConfig,
-                                           VersionP(..))
+import Pantry.Internal.Stackage as Pantry (PantryConfig)
 import Pantry.SHA256 (fromHexText)
 import RIO
 import RIO.Process (HasProcessContext(..), ProcessContext)
--- a/src/Types.hs
+++ b/src/Types.hs
@ -49,7 +49,6 @@ module Types
    ) where

 import ClassyPrelude.Yesod (ToBuilder(..))
-import Control.Monad.Catch (MonadThrow, throwM)
 import Data.Aeson
 import Data.Bifunctor (bimap)
 import Data.Char (ord)
@ -63,7 +62,9 @@ import Database.Persist.Sql (PersistFieldSql(sqlType))
 import qualified Distribution.ModuleName as DT (components, fromComponents,
                                                validModuleComponent)
 import Distribution.PackageDescription (FlagName, GenericPackageDescription)
-import qualified Distribution.Text as DT (Text, display, simpleParse)
+import Distribution.Parsec as DT (Parsec)
+import Distribution.Pretty as DT (Pretty)
+import qualified Distribution.Text as DT (display, simpleParse)
 import Distribution.Types.VersionRange (VersionRange)
 import Distribution.Version (mkVersion, versionNumbers)
 import Pantry (Revision(..))
@ -84,14 +85,14 @@ instance Exception ParseFailedException where
    displayException (ParseFailedException tyRep origString) =
        "Was unable to parse " ++ showsTypeRep tyRep ": " ++ origString

-dtParse :: forall a m. (Typeable a, DT.Text a, MonadThrow m) => Text -> m a
+dtParse :: forall a m. (Typeable a, DT.Parsec a, MonadThrow m) => Text -> m a
 dtParse txt =
    let str = T.unpack txt
     in case DT.simpleParse str of
            Nothing -> throwM $ ParseFailedException (typeRep (Proxy :: Proxy a)) str
            Just dt -> pure dt

-dtDisplay :: (DT.Text a, IsString b) => a -> b
+dtDisplay :: (DT.Pretty a, IsString b) => a -> b
 dtDisplay = fromString . DT.display


--- a/stack.yaml
+++ b/stack.yaml
@ -1,10 +1,17 @@
-resolver: lts-13.16
+resolver: nightly-2020-02-08
 packages:
  - '.'
 extra-deps:
- git: https://github.com/commercialhaskell/stack
-  commit: dfbf85ad7e8af5b01cf7b51367290870ffc2c90e
+- barrier-0.1.1@sha256:2021f84c3aba67bb635d72825d3bc0371942444dc014bc307b875071e29eea98,3931
+- hackage-security-0.6.0.0@sha256:69987d46e7b55fe5f0fc537021c3873c5f6f44a6665d349ee6995fd593df8147,11976
+- hoogle-5.0.17.14@sha256:a35eab4f833cd131f1abc79360e3bdbc5aecd7526b9a530ac606580e18691e2b,3173
+- hpack-0.33.0@sha256:ca82f630abe0fba199aa05dcc9942ee8bf137e1425049a7a9ac8458c82d9dcc9,4406
+- yesod-gitrepo-0.3.0@sha256:7aad996935065726ce615c395d735cc01dcef3993b1788f670f6bfc866085e02,1191
+- lukko-0.1.1.1@sha256:5c674bdd8a06b926ba55d872abe254155ed49a58df202b4d842b643e5ed6bcc9,4289
+- github: commercialhaskell/pantry
+  commit: 86462a97c4d8091993cc6e246fd0f2ae5aa608f0
+- github: fpco/casa
+  commit: fc0ed26858bfc4f2966ed2dfb2871bae9266dda6
  subdirs:
-  - subs/http-download
-  - subs/pantry
-  - subs/rio-prettyprint
+     - casa-client
+     - casa-types