{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
module Pantry.Types
( PantryConfig (..)
, PackageIndexConfig (..)
, HackageSecurityConfig (..)
, defaultHackageSecurityConfig
, Storage (..)
, HasPantryConfig (..)
, BlobKey (..)
, PackageName
, Version
, PackageIdentifier (..)
, Revision (..)
, ModuleName
, CabalFileInfo (..)
, PrintWarnings (..)
, PackageNameP (..)
, VersionP (..)
, ModuleNameP (..)
, PackageIdentifierRevision (..)
, pirForHash
, FileType (..)
, BuildFile (..)
, FileSize (..)
, TreeEntry (..)
, SafeFilePath
, unSafeFilePath
, mkSafeFilePath
, safeFilePathToPath
, hpackSafeFilePath
, TreeKey (..)
, Tree (..)
, renderTree
, parseTree
, parseTreeM
, SHA256
, Unresolved
, resolvePaths
, Package (..)
, PackageCabal (..)
, PHpack (..)
, RawPackageLocation (..)
, PackageLocation (..)
, toRawPL
, RawPackageLocationImmutable (..)
, PackageLocationImmutable (..)
, toRawPLI
, RawArchive (..)
, Archive (..)
, toRawArchive
, Repo (..)
, AggregateRepo (..)
, SimpleRepo (..)
, toAggregateRepos
, rToSimpleRepo
, arToSimpleRepo
, RepoType (..)
, parsePackageIdentifier
, parsePackageName
, parsePackageNameThrowing
, parseFlagName
, parseVersion
, parseVersionThrowing
, packageIdentifierString
, packageNameString
, flagNameString
, versionString
, moduleNameString
, OptionalSubdirs (..)
, ArchiveLocation (..)
, RelFilePath (..)
, CabalString (..)
, toCabalStringMap
, unCabalStringMap
, parsePackageIdentifierRevision
, Mismatch (..)
, PantryException (..)
, FuzzyResults (..)
, ResolvedPath (..)
, HpackExecutable (..)
, WantedCompiler (..)
, snapshotLocation
, defaultSnapshotLocation
, SnapName (..)
, parseSnapName
, RawSnapshotLocation (..)
, SnapshotLocation (..)
, toRawSL
, parseHackageText
, parseRawSnapshotLocation
, RawSnapshotLayer (..)
, SnapshotLayer (..)
, toRawSnapshotLayer
, RawSnapshot (..)
, Snapshot (..)
, RawSnapshotPackage (..)
, SnapshotPackage (..)
, parseWantedCompiler
, RawPackageMetadata (..)
, PackageMetadata (..)
, toRawPM
, cabalFileName
, SnapshotCacheHash (..)
, getGlobalHintsFile
, bsToBlobKey
, warnMissingCabalFile
, connRDBMS
) where
import RIO
import qualified Data.Conduit.Tar as Tar
import qualified RIO.Text as T
import qualified RIO.ByteString as B
import qualified RIO.ByteString.Lazy as BL
import RIO.List (intersperse, groupBy)
import RIO.Time (toGregorian, Day, UTCTime)
import qualified RIO.Map as Map
import RIO.PrettyPrint (bulletedList, fillSep, flow, hang, line, mkNarrativeList, parens, string, style)
import RIO.PrettyPrint.Types (Style (..))
import qualified Data.Map.Strict as Map (mapKeysMonotonic)
import qualified RIO.Set as Set
import Data.Aeson.Types (toJSONKeyText, Parser)
import Pantry.Internal.AesonExtended
( FromJSON (..), FromJSONKey (..), FromJSONKeyFunction (..), Object
, ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..)
, WarningParser, WithJSONWarnings, (..:), (..:?), (..!=), (.=), (.:)
, (...:?), jsonSubWarnings, jsonSubWarningsT, noJSONWarnings, object
, tellJSONField, withObject, withObjectWarnings, withText
)
import Data.Aeson.Encoding.Internal (unsafeToEncoding)
import Data.ByteString.Builder (toLazyByteString, byteString, wordDec)
import Database.Persist
import Database.Persist.Sql
import Pantry.SHA256 (SHA256)
import qualified Pantry.SHA256 as SHA256
import qualified Distribution.Compat.CharParsing as Parse
import Distribution.CabalSpecVersion (cabalSpecLatest)
#if MIN_VERSION_Cabal(3,4,0)
import Distribution.CabalSpecVersion (cabalSpecToVersionDigits)
#else
import Distribution.CabalSpecVersion (CabalSpecVersion (..))
#endif
import Distribution.Parsec (PError (..), PWarning (..), showPos, parsec, explicitEitherParsec, ParsecParser)
import Distribution.Types.PackageName (PackageName, unPackageName, mkPackageName)
import Distribution.Types.VersionRange (VersionRange)
import Distribution.PackageDescription (FlagName, unFlagName, GenericPackageDescription)
import Distribution.Types.PackageId (PackageIdentifier (..))
import qualified Distribution.Pretty
import qualified Distribution.Text
import qualified Hpack.Config as Hpack
import Distribution.ModuleName (ModuleName)
import Distribution.Types.Version (Version, mkVersion, nullVersion)
import Network.HTTP.Client (parseRequest)
import Network.HTTP.Types (Status, statusCode)
import Text.PrettyPrint.Leijen.Extended (Pretty (..), StyleDoc)
import Data.Text.Read (decimal)
import Path (Path, Abs, Dir, File, toFilePath, filename, (</>), parseRelFile)
import Path.IO (resolveFile, resolveDir)
import qualified Data.List.NonEmpty as NE
import Casa.Client (CasaRepoPrefix)
#if MIN_VERSION_persistent(2, 13, 0)
import Database.Persist.SqlBackend.Internal (connRDBMS)
#endif
#if MIN_VERSION_aeson(2, 0, 0)
import qualified Data.Aeson.KeyMap as HM
import qualified Data.Aeson.Key
type AesonKey = Data.Aeson.Key.Key
#else
import qualified RIO.HashMap as HM
type AesonKey = Text
#endif
data Package = Package
{ Package -> TreeKey
packageTreeKey :: !TreeKey
, Package -> Tree
packageTree :: !Tree
, Package -> PackageCabal
packageCabalEntry :: !PackageCabal
, Package -> PackageIdentifier
packageIdent :: !PackageIdentifier
}
deriving (Int -> Package -> ShowS
[Package] -> ShowS
Package -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Package] -> ShowS
$cshowList :: [Package] -> ShowS
show :: Package -> [Char]
$cshow :: Package -> [Char]
showsPrec :: Int -> Package -> ShowS
$cshowsPrec :: Int -> Package -> ShowS
Show, Package -> Package -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c== :: Package -> Package -> Bool
Eq, Eq Package
Package -> Package -> Bool
Package -> Package -> Ordering
Package -> Package -> Package
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Package -> Package -> Package
$cmin :: Package -> Package -> Package
max :: Package -> Package -> Package
$cmax :: Package -> Package -> Package
>= :: Package -> Package -> Bool
$c>= :: Package -> Package -> Bool
> :: Package -> Package -> Bool
$c> :: Package -> Package -> Bool
<= :: Package -> Package -> Bool
$c<= :: Package -> Package -> Bool
< :: Package -> Package -> Bool
$c< :: Package -> Package -> Bool
compare :: Package -> Package -> Ordering
$ccompare :: Package -> Package -> Ordering
Ord)
data PHpack = PHpack
{
PHpack -> TreeEntry
phOriginal :: !TreeEntry,
PHpack -> TreeEntry
phGenerated :: !TreeEntry,
PHpack -> Version
phVersion :: !Version
} deriving (Int -> PHpack -> ShowS
[PHpack] -> ShowS
PHpack -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PHpack] -> ShowS
$cshowList :: [PHpack] -> ShowS
show :: PHpack -> [Char]
$cshow :: PHpack -> [Char]
showsPrec :: Int -> PHpack -> ShowS
$cshowsPrec :: Int -> PHpack -> ShowS
Show, PHpack -> PHpack -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PHpack -> PHpack -> Bool
$c/= :: PHpack -> PHpack -> Bool
== :: PHpack -> PHpack -> Bool
$c== :: PHpack -> PHpack -> Bool
Eq, Eq PHpack
PHpack -> PHpack -> Bool
PHpack -> PHpack -> Ordering
PHpack -> PHpack -> PHpack
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PHpack -> PHpack -> PHpack
$cmin :: PHpack -> PHpack -> PHpack
max :: PHpack -> PHpack -> PHpack
$cmax :: PHpack -> PHpack -> PHpack
>= :: PHpack -> PHpack -> Bool
$c>= :: PHpack -> PHpack -> Bool
> :: PHpack -> PHpack -> Bool
$c> :: PHpack -> PHpack -> Bool
<= :: PHpack -> PHpack -> Bool
$c<= :: PHpack -> PHpack -> Bool
< :: PHpack -> PHpack -> Bool
$c< :: PHpack -> PHpack -> Bool
compare :: PHpack -> PHpack -> Ordering
$ccompare :: PHpack -> PHpack -> Ordering
Ord)
data PackageCabal = PCCabalFile !TreeEntry
| PCHpack !PHpack
deriving (Int -> PackageCabal -> ShowS
[PackageCabal] -> ShowS
PackageCabal -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PackageCabal] -> ShowS
$cshowList :: [PackageCabal] -> ShowS
show :: PackageCabal -> [Char]
$cshow :: PackageCabal -> [Char]
showsPrec :: Int -> PackageCabal -> ShowS
$cshowsPrec :: Int -> PackageCabal -> ShowS
Show, PackageCabal -> PackageCabal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageCabal -> PackageCabal -> Bool
$c/= :: PackageCabal -> PackageCabal -> Bool
== :: PackageCabal -> PackageCabal -> Bool
$c== :: PackageCabal -> PackageCabal -> Bool
Eq, Eq PackageCabal
PackageCabal -> PackageCabal -> Bool
PackageCabal -> PackageCabal -> Ordering
PackageCabal -> PackageCabal -> PackageCabal
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageCabal -> PackageCabal -> PackageCabal
$cmin :: PackageCabal -> PackageCabal -> PackageCabal
max :: PackageCabal -> PackageCabal -> PackageCabal
$cmax :: PackageCabal -> PackageCabal -> PackageCabal
>= :: PackageCabal -> PackageCabal -> Bool
$c>= :: PackageCabal -> PackageCabal -> Bool
> :: PackageCabal -> PackageCabal -> Bool
$c> :: PackageCabal -> PackageCabal -> Bool
<= :: PackageCabal -> PackageCabal -> Bool
$c<= :: PackageCabal -> PackageCabal -> Bool
< :: PackageCabal -> PackageCabal -> Bool
$c< :: PackageCabal -> PackageCabal -> Bool
compare :: PackageCabal -> PackageCabal -> Ordering
$ccompare :: PackageCabal -> PackageCabal -> Ordering
Ord)
cabalFileName :: PackageName -> SafeFilePath
cabalFileName :: PackageName -> SafeFilePath
cabalFileName PackageName
name =
case Text -> Maybe SafeFilePath
mkSafeFilePath forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (PackageName -> [Char]
packageNameString PackageName
name) forall a. Semigroup a => a -> a -> a
<> Text
".cabal" of
Maybe SafeFilePath
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"cabalFileName: failed for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PackageName
name
Just SafeFilePath
sfp -> SafeFilePath
sfp
newtype Revision = Revision Word
deriving (forall x. Rep Revision x -> Revision
forall x. Revision -> Rep Revision x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Revision x -> Revision
$cfrom :: forall x. Revision -> Rep Revision x
Generic, Int -> Revision -> ShowS
[Revision] -> ShowS
Revision -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Revision] -> ShowS
$cshowList :: [Revision] -> ShowS
show :: Revision -> [Char]
$cshow :: Revision -> [Char]
showsPrec :: Int -> Revision -> ShowS
$cshowsPrec :: Int -> Revision -> ShowS
Show, Revision -> Revision -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Revision -> Revision -> Bool
$c/= :: Revision -> Revision -> Bool
== :: Revision -> Revision -> Bool
$c== :: Revision -> Revision -> Bool
Eq, Revision -> ()
forall a. (a -> ()) -> NFData a
rnf :: Revision -> ()
$crnf :: Revision -> ()
NFData, Typeable Revision
Revision -> DataType
Revision -> Constr
(forall b. Data b => b -> b) -> Revision -> Revision
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Revision -> u
forall u. (forall d. Data d => d -> u) -> Revision -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Revision -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Revision -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Revision
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Revision -> c Revision
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Revision)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Revision)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Revision -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Revision -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Revision -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Revision -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Revision -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Revision -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Revision -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Revision -> r
gmapT :: (forall b. Data b => b -> b) -> Revision -> Revision
$cgmapT :: (forall b. Data b => b -> b) -> Revision -> Revision
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Revision)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Revision)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Revision)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Revision)
dataTypeOf :: Revision -> DataType
$cdataTypeOf :: Revision -> DataType
toConstr :: Revision -> Constr
$ctoConstr :: Revision -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Revision
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Revision
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Revision -> c Revision
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Revision -> c Revision
Data, Typeable, Eq Revision
Revision -> Revision -> Bool
Revision -> Revision -> Ordering
Revision -> Revision -> Revision
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Revision -> Revision -> Revision
$cmin :: Revision -> Revision -> Revision
max :: Revision -> Revision -> Revision
$cmax :: Revision -> Revision -> Revision
>= :: Revision -> Revision -> Bool
$c>= :: Revision -> Revision -> Bool
> :: Revision -> Revision -> Bool
$c> :: Revision -> Revision -> Bool
<= :: Revision -> Revision -> Bool
$c<= :: Revision -> Revision -> Bool
< :: Revision -> Revision -> Bool
$c< :: Revision -> Revision -> Bool
compare :: Revision -> Revision -> Ordering
$ccompare :: Revision -> Revision -> Ordering
Ord, Eq Revision
Int -> Revision -> Int
Revision -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Revision -> Int
$chash :: Revision -> Int
hashWithSalt :: Int -> Revision -> Int
$chashWithSalt :: Int -> Revision -> Int
Hashable, Revision -> Text
Revision -> Utf8Builder
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
textDisplay :: Revision -> Text
$ctextDisplay :: Revision -> Text
display :: Revision -> Utf8Builder
$cdisplay :: Revision -> Utf8Builder
Display, PersistValue -> Either Text Revision
Revision -> PersistValue
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
fromPersistValue :: PersistValue -> Either Text Revision
$cfromPersistValue :: PersistValue -> Either Text Revision
toPersistValue :: Revision -> PersistValue
$ctoPersistValue :: Revision -> PersistValue
PersistField, PersistField Revision
Proxy Revision -> SqlType
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
sqlType :: Proxy Revision -> SqlType
$csqlType :: Proxy Revision -> SqlType
PersistFieldSql)
data Storage = Storage
{ Storage
-> forall env a.
HasLogFunc env =>
ReaderT SqlBackend (RIO env) a -> RIO env a
withStorage_ :: forall env a. HasLogFunc env => ReaderT SqlBackend (RIO env) a -> RIO env a
, Storage -> forall env a. HasLogFunc env => RIO env a -> RIO env a
withWriteLock_ :: forall env a. HasLogFunc env => RIO env a -> RIO env a
}
data PantryConfig = PantryConfig
{ PantryConfig -> PackageIndexConfig
pcPackageIndex :: !PackageIndexConfig
, PantryConfig -> HpackExecutable
pcHpackExecutable :: !HpackExecutable
, PantryConfig -> Path Abs Dir
pcRootDir :: !(Path Abs Dir)
, PantryConfig -> Storage
pcStorage :: !Storage
, PantryConfig -> MVar Bool
pcUpdateRef :: !(MVar Bool)
, PantryConfig
-> IORef
(Map RawPackageLocationImmutable GenericPackageDescription)
pcParsedCabalFilesRawImmutable :: !(IORef (Map RawPackageLocationImmutable GenericPackageDescription))
, PantryConfig
-> IORef
(Map
(Path Abs Dir)
(PrintWarnings -> IO GenericPackageDescription, PackageName,
Path Abs File))
pcParsedCabalFilesMutable ::
!(IORef
(Map
(Path Abs Dir)
(PrintWarnings -> IO GenericPackageDescription, PackageName, Path Abs File)
)
)
, PantryConfig -> Int
pcConnectionCount :: !Int
, PantryConfig -> CasaRepoPrefix
pcCasaRepoPrefix :: !CasaRepoPrefix
, PantryConfig -> Int
pcCasaMaxPerRequest :: !Int
, PantryConfig -> SnapName -> RawSnapshotLocation
pcSnapshotLocation :: SnapName -> RawSnapshotLocation
}
snapshotLocation :: HasPantryConfig env => SnapName -> RIO env RawSnapshotLocation
snapshotLocation :: forall env.
HasPantryConfig env =>
SnapName -> RIO env RawSnapshotLocation
snapshotLocation SnapName
name = do
SnapName -> RawSnapshotLocation
loc <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to PantryConfig -> SnapName -> RawSnapshotLocation
pcSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SnapName -> RawSnapshotLocation
loc SnapName
name
data PrintWarnings = YesPrintWarnings | NoPrintWarnings
newtype Unresolved a = Unresolved (Maybe (Path Abs Dir) -> IO a)
deriving forall a b. a -> Unresolved b -> Unresolved a
forall a b. (a -> b) -> Unresolved a -> Unresolved b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Unresolved b -> Unresolved a
$c<$ :: forall a b. a -> Unresolved b -> Unresolved a
fmap :: forall a b. (a -> b) -> Unresolved a -> Unresolved b
$cfmap :: forall a b. (a -> b) -> Unresolved a -> Unresolved b
Functor
instance Applicative Unresolved where
pure :: forall a. a -> Unresolved a
pure = forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
Unresolved Maybe (Path Abs Dir) -> IO (a -> b)
f <*> :: forall a b. Unresolved (a -> b) -> Unresolved a -> Unresolved b
<*> Unresolved Maybe (Path Abs Dir) -> IO a
x = forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir -> Maybe (Path Abs Dir) -> IO (a -> b)
f Maybe (Path Abs Dir)
mdir forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Path Abs Dir) -> IO a
x Maybe (Path Abs Dir)
mdir
resolvePaths
:: MonadIO m
=> Maybe (Path Abs Dir)
-> Unresolved a
-> m a
resolvePaths :: forall (m :: * -> *) a.
MonadIO m =>
Maybe (Path Abs Dir) -> Unresolved a -> m a
resolvePaths Maybe (Path Abs Dir)
mdir (Unresolved Maybe (Path Abs Dir) -> IO a
f) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe (Path Abs Dir) -> IO a
f Maybe (Path Abs Dir)
mdir)
data ResolvedPath t = ResolvedPath
{ forall t. ResolvedPath t -> RelFilePath
resolvedRelative :: !RelFilePath
, forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute :: !(Path Abs t)
}
deriving (Int -> ResolvedPath t -> ShowS
forall t. Int -> ResolvedPath t -> ShowS
forall t. [ResolvedPath t] -> ShowS
forall t. ResolvedPath t -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedPath t] -> ShowS
$cshowList :: forall t. [ResolvedPath t] -> ShowS
show :: ResolvedPath t -> [Char]
$cshow :: forall t. ResolvedPath t -> [Char]
showsPrec :: Int -> ResolvedPath t -> ShowS
$cshowsPrec :: forall t. Int -> ResolvedPath t -> ShowS
Show, ResolvedPath t -> ResolvedPath t -> Bool
forall t. ResolvedPath t -> ResolvedPath t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolvedPath t -> ResolvedPath t -> Bool
$c/= :: forall t. ResolvedPath t -> ResolvedPath t -> Bool
== :: ResolvedPath t -> ResolvedPath t -> Bool
$c== :: forall t. ResolvedPath t -> ResolvedPath t -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t x. Rep (ResolvedPath t) x -> ResolvedPath t
forall t x. ResolvedPath t -> Rep (ResolvedPath t) x
$cto :: forall t x. Rep (ResolvedPath t) x -> ResolvedPath t
$cfrom :: forall t x. ResolvedPath t -> Rep (ResolvedPath t) x
Generic, ResolvedPath t -> ResolvedPath t -> Bool
ResolvedPath t -> ResolvedPath t -> Ordering
forall t. Eq (ResolvedPath t)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. ResolvedPath t -> ResolvedPath t -> Bool
forall t. ResolvedPath t -> ResolvedPath t -> Ordering
forall t. ResolvedPath t -> ResolvedPath t -> ResolvedPath t
min :: ResolvedPath t -> ResolvedPath t -> ResolvedPath t
$cmin :: forall t. ResolvedPath t -> ResolvedPath t -> ResolvedPath t
max :: ResolvedPath t -> ResolvedPath t -> ResolvedPath t
$cmax :: forall t. ResolvedPath t -> ResolvedPath t -> ResolvedPath t
>= :: ResolvedPath t -> ResolvedPath t -> Bool
$c>= :: forall t. ResolvedPath t -> ResolvedPath t -> Bool
> :: ResolvedPath t -> ResolvedPath t -> Bool
$c> :: forall t. ResolvedPath t -> ResolvedPath t -> Bool
<= :: ResolvedPath t -> ResolvedPath t -> Bool
$c<= :: forall t. ResolvedPath t -> ResolvedPath t -> Bool
< :: ResolvedPath t -> ResolvedPath t -> Bool
$c< :: forall t. ResolvedPath t -> ResolvedPath t -> Bool
compare :: ResolvedPath t -> ResolvedPath t -> Ordering
$ccompare :: forall t. ResolvedPath t -> ResolvedPath t -> Ordering
Ord)
instance NFData (ResolvedPath t)
data RawPackageLocation
= RPLImmutable !RawPackageLocationImmutable
| RPLMutable !(ResolvedPath Dir)
deriving (Int -> RawPackageLocation -> ShowS
[RawPackageLocation] -> ShowS
RawPackageLocation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RawPackageLocation] -> ShowS
$cshowList :: [RawPackageLocation] -> ShowS
show :: RawPackageLocation -> [Char]
$cshow :: RawPackageLocation -> [Char]
showsPrec :: Int -> RawPackageLocation -> ShowS
$cshowsPrec :: Int -> RawPackageLocation -> ShowS
Show, RawPackageLocation -> RawPackageLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawPackageLocation -> RawPackageLocation -> Bool
$c/= :: RawPackageLocation -> RawPackageLocation -> Bool
== :: RawPackageLocation -> RawPackageLocation -> Bool
$c== :: RawPackageLocation -> RawPackageLocation -> Bool
Eq, forall x. Rep RawPackageLocation x -> RawPackageLocation
forall x. RawPackageLocation -> Rep RawPackageLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RawPackageLocation x -> RawPackageLocation
$cfrom :: forall x. RawPackageLocation -> Rep RawPackageLocation x
Generic)
instance NFData RawPackageLocation
data PackageLocation
= PLImmutable !PackageLocationImmutable
| PLMutable !(ResolvedPath Dir)
deriving (Int -> PackageLocation -> ShowS
[PackageLocation] -> ShowS
PackageLocation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PackageLocation] -> ShowS
$cshowList :: [PackageLocation] -> ShowS
show :: PackageLocation -> [Char]
$cshow :: PackageLocation -> [Char]
showsPrec :: Int -> PackageLocation -> ShowS
$cshowsPrec :: Int -> PackageLocation -> ShowS
Show, PackageLocation -> PackageLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageLocation -> PackageLocation -> Bool
$c/= :: PackageLocation -> PackageLocation -> Bool
== :: PackageLocation -> PackageLocation -> Bool
$c== :: PackageLocation -> PackageLocation -> Bool
Eq, forall x. Rep PackageLocation x -> PackageLocation
forall x. PackageLocation -> Rep PackageLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageLocation x -> PackageLocation
$cfrom :: forall x. PackageLocation -> Rep PackageLocation x
Generic)
instance NFData PackageLocation
instance Display PackageLocation where
display :: PackageLocation -> Utf8Builder
display (PLImmutable PackageLocationImmutable
loc) = forall a. Display a => a -> Utf8Builder
display PackageLocationImmutable
loc
display (PLMutable ResolvedPath Dir
fp) = forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> [Char]
toFilePath forall a b. (a -> b) -> a -> b
$ forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute ResolvedPath Dir
fp
toRawPL :: PackageLocation -> RawPackageLocation
toRawPL :: PackageLocation -> RawPackageLocation
toRawPL (PLImmutable PackageLocationImmutable
im) = RawPackageLocationImmutable -> RawPackageLocation
RPLImmutable (PackageLocationImmutable -> RawPackageLocationImmutable
toRawPLI PackageLocationImmutable
im)
toRawPL (PLMutable ResolvedPath Dir
m) = ResolvedPath Dir -> RawPackageLocation
RPLMutable ResolvedPath Dir
m
data RawPackageLocationImmutable
= RPLIHackage !PackageIdentifierRevision !(Maybe TreeKey)
| RPLIArchive !RawArchive !RawPackageMetadata
| RPLIRepo !Repo !RawPackageMetadata
deriving (Int -> RawPackageLocationImmutable -> ShowS
[RawPackageLocationImmutable] -> ShowS
RawPackageLocationImmutable -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RawPackageLocationImmutable] -> ShowS
$cshowList :: [RawPackageLocationImmutable] -> ShowS
show :: RawPackageLocationImmutable -> [Char]
$cshow :: RawPackageLocationImmutable -> [Char]
showsPrec :: Int -> RawPackageLocationImmutable -> ShowS
$cshowsPrec :: Int -> RawPackageLocationImmutable -> ShowS
Show, RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
$c/= :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
== :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
$c== :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
Eq, Eq RawPackageLocationImmutable
RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
RawPackageLocationImmutable
-> RawPackageLocationImmutable -> Ordering
RawPackageLocationImmutable
-> RawPackageLocationImmutable -> RawPackageLocationImmutable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RawPackageLocationImmutable
-> RawPackageLocationImmutable -> RawPackageLocationImmutable
$cmin :: RawPackageLocationImmutable
-> RawPackageLocationImmutable -> RawPackageLocationImmutable
max :: RawPackageLocationImmutable
-> RawPackageLocationImmutable -> RawPackageLocationImmutable
$cmax :: RawPackageLocationImmutable
-> RawPackageLocationImmutable -> RawPackageLocationImmutable
>= :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
$c>= :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
> :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
$c> :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
<= :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
$c<= :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
< :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
$c< :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
compare :: RawPackageLocationImmutable
-> RawPackageLocationImmutable -> Ordering
$ccompare :: RawPackageLocationImmutable
-> RawPackageLocationImmutable -> Ordering
Ord, forall x.
Rep RawPackageLocationImmutable x -> RawPackageLocationImmutable
forall x.
RawPackageLocationImmutable -> Rep RawPackageLocationImmutable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RawPackageLocationImmutable x -> RawPackageLocationImmutable
$cfrom :: forall x.
RawPackageLocationImmutable -> Rep RawPackageLocationImmutable x
Generic)
instance NFData RawPackageLocationImmutable
instance Display RawPackageLocationImmutable where
display :: RawPackageLocationImmutable -> Utf8Builder
display (RPLIHackage PackageIdentifierRevision
pir Maybe TreeKey
_tree) = forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" (from Hackage)"
display (RPLIArchive RawArchive
archive RawPackageMetadata
_pm) =
Utf8Builder
"Archive from " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (RawArchive -> ArchiveLocation
raLocation RawArchive
archive) forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ RawArchive -> Text
raSubdir RawArchive
archive
then forall a. Monoid a => a
mempty
else Utf8Builder
" in subdir " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (RawArchive -> Text
raSubdir RawArchive
archive))
display (RPLIRepo Repo
repo RawPackageMetadata
_pm) =
Utf8Builder
"Repo from " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoUrl Repo
repo) forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", commit " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoCommit Repo
repo) forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ Repo -> Text
repoSubdir Repo
repo
then forall a. Monoid a => a
mempty
else Utf8Builder
" in subdir " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoSubdir Repo
repo))
instance Pretty RawPackageLocationImmutable where
pretty :: RawPackageLocationImmutable -> StyleDoc
pretty (RPLIHackage PackageIdentifierRevision
pir Maybe TreeKey
_tree) = [StyleDoc] -> StyleDoc
fillSep
[ forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay PackageIdentifierRevision
pir
, StyleDoc -> StyleDoc
parens ([Char] -> StyleDoc
flow [Char]
"from Hackage")
]
pretty (RPLIArchive RawArchive
archive RawPackageMetadata
_pm) = [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Archive from"
, forall a. Pretty a => a -> StyleDoc
pretty (RawArchive -> ArchiveLocation
raLocation RawArchive
archive)
, if Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ RawArchive -> Text
raSubdir RawArchive
archive
then forall a. Monoid a => a
mempty
else [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"in subdir"
, Style -> StyleDoc -> StyleDoc
style Style
Dir (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (RawArchive -> Text
raSubdir RawArchive
archive))
]
]
pretty (RPLIRepo Repo
repo RawPackageMetadata
_pm) = [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Repo from"
, Style -> StyleDoc -> StyleDoc
style Style
Url (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Repo -> Text
repoUrl Repo
repo)) forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, StyleDoc
"commit"
, forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Repo -> Text
repoCommit Repo
repo)
, if Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ Repo -> Text
repoSubdir Repo
repo
then forall a. Monoid a => a
mempty
else [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"in subdir"
, Style -> StyleDoc -> StyleDoc
style Style
Dir (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Repo -> Text
repoSubdir Repo
repo))
]
]
data PackageLocationImmutable
= PLIHackage !PackageIdentifier !BlobKey !TreeKey
| PLIArchive !Archive !PackageMetadata
| PLIRepo !Repo !PackageMetadata
deriving (forall x.
Rep PackageLocationImmutable x -> PackageLocationImmutable
forall x.
PackageLocationImmutable -> Rep PackageLocationImmutable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PackageLocationImmutable x -> PackageLocationImmutable
$cfrom :: forall x.
PackageLocationImmutable -> Rep PackageLocationImmutable x
Generic, Int -> PackageLocationImmutable -> ShowS
[PackageLocationImmutable] -> ShowS
PackageLocationImmutable -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PackageLocationImmutable] -> ShowS
$cshowList :: [PackageLocationImmutable] -> ShowS
show :: PackageLocationImmutable -> [Char]
$cshow :: PackageLocationImmutable -> [Char]
showsPrec :: Int -> PackageLocationImmutable -> ShowS
$cshowsPrec :: Int -> PackageLocationImmutable -> ShowS
Show, PackageLocationImmutable -> PackageLocationImmutable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
$c/= :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
== :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
$c== :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
Eq, Eq PackageLocationImmutable
PackageLocationImmutable -> PackageLocationImmutable -> Bool
PackageLocationImmutable -> PackageLocationImmutable -> Ordering
PackageLocationImmutable
-> PackageLocationImmutable -> PackageLocationImmutable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageLocationImmutable
-> PackageLocationImmutable -> PackageLocationImmutable
$cmin :: PackageLocationImmutable
-> PackageLocationImmutable -> PackageLocationImmutable
max :: PackageLocationImmutable
-> PackageLocationImmutable -> PackageLocationImmutable
$cmax :: PackageLocationImmutable
-> PackageLocationImmutable -> PackageLocationImmutable
>= :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
$c>= :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
> :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
$c> :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
<= :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
$c<= :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
< :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
$c< :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
compare :: PackageLocationImmutable -> PackageLocationImmutable -> Ordering
$ccompare :: PackageLocationImmutable -> PackageLocationImmutable -> Ordering
Ord, Typeable)
instance NFData PackageLocationImmutable
instance Display PackageLocationImmutable where
display :: PackageLocationImmutable -> Utf8Builder
display (PLIHackage PackageIdentifier
ident BlobKey
_cabalHash TreeKey
_tree) =
forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
packageNameString forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> PackageName
pkgName PackageIdentifier
ident) forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" (from Hackage)"
display (PLIArchive Archive
archive PackageMetadata
_pm) =
Utf8Builder
"Archive from " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (Archive -> ArchiveLocation
archiveLocation Archive
archive) forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ Archive -> Text
archiveSubdir Archive
archive
then forall a. Monoid a => a
mempty
else Utf8Builder
" in subdir " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (Archive -> Text
archiveSubdir Archive
archive))
display (PLIRepo Repo
repo PackageMetadata
_pm) =
Utf8Builder
"Repo from " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoUrl Repo
repo) forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", commit " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoCommit Repo
repo) forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ Repo -> Text
repoSubdir Repo
repo
then forall a. Monoid a => a
mempty
else Utf8Builder
" in subdir " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoSubdir Repo
repo))
instance ToJSON PackageLocationImmutable where
toJSON :: PackageLocationImmutable -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageLocationImmutable -> RawPackageLocationImmutable
toRawPLI
pirForHash :: PackageIdentifier -> BlobKey -> PackageIdentifierRevision
pirForHash :: PackageIdentifier -> BlobKey -> PackageIdentifierRevision
pirForHash (PackageIdentifier PackageName
name Version
ver) (BlobKey SHA256
sha FileSize
size') =
let cfi :: CabalFileInfo
cfi = SHA256 -> Maybe FileSize -> CabalFileInfo
CFIHash SHA256
sha (forall a. a -> Maybe a
Just FileSize
size')
in PackageName
-> Version -> CabalFileInfo -> PackageIdentifierRevision
PackageIdentifierRevision PackageName
name Version
ver CabalFileInfo
cfi
toRawPLI :: PackageLocationImmutable -> RawPackageLocationImmutable
toRawPLI :: PackageLocationImmutable -> RawPackageLocationImmutable
toRawPLI (PLIHackage PackageIdentifier
ident BlobKey
cfKey TreeKey
treeKey) = PackageIdentifierRevision
-> Maybe TreeKey -> RawPackageLocationImmutable
RPLIHackage (PackageIdentifier -> BlobKey -> PackageIdentifierRevision
pirForHash PackageIdentifier
ident BlobKey
cfKey) (forall a. a -> Maybe a
Just TreeKey
treeKey)
toRawPLI (PLIArchive Archive
archive PackageMetadata
pm) = RawArchive -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIArchive (Archive -> RawArchive
toRawArchive Archive
archive) (PackageMetadata -> RawPackageMetadata
toRawPM PackageMetadata
pm)
toRawPLI (PLIRepo Repo
repo PackageMetadata
pm) = Repo -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIRepo Repo
repo (PackageMetadata -> RawPackageMetadata
toRawPM PackageMetadata
pm)
data RawArchive = RawArchive
{ RawArchive -> ArchiveLocation
raLocation :: !ArchiveLocation
, RawArchive -> Maybe SHA256
raHash :: !(Maybe SHA256)
, RawArchive -> Maybe FileSize
raSize :: !(Maybe FileSize)
, RawArchive -> Text
raSubdir :: !Text
}
deriving (forall x. Rep RawArchive x -> RawArchive
forall x. RawArchive -> Rep RawArchive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RawArchive x -> RawArchive
$cfrom :: forall x. RawArchive -> Rep RawArchive x
Generic, Int -> RawArchive -> ShowS
[RawArchive] -> ShowS
RawArchive -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RawArchive] -> ShowS
$cshowList :: [RawArchive] -> ShowS
show :: RawArchive -> [Char]
$cshow :: RawArchive -> [Char]
showsPrec :: Int -> RawArchive -> ShowS
$cshowsPrec :: Int -> RawArchive -> ShowS
Show, RawArchive -> RawArchive -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawArchive -> RawArchive -> Bool
$c/= :: RawArchive -> RawArchive -> Bool
== :: RawArchive -> RawArchive -> Bool
$c== :: RawArchive -> RawArchive -> Bool
Eq, Eq RawArchive
RawArchive -> RawArchive -> Bool
RawArchive -> RawArchive -> Ordering
RawArchive -> RawArchive -> RawArchive
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RawArchive -> RawArchive -> RawArchive
$cmin :: RawArchive -> RawArchive -> RawArchive
max :: RawArchive -> RawArchive -> RawArchive
$cmax :: RawArchive -> RawArchive -> RawArchive
>= :: RawArchive -> RawArchive -> Bool
$c>= :: RawArchive -> RawArchive -> Bool
> :: RawArchive -> RawArchive -> Bool
$c> :: RawArchive -> RawArchive -> Bool
<= :: RawArchive -> RawArchive -> Bool
$c<= :: RawArchive -> RawArchive -> Bool
< :: RawArchive -> RawArchive -> Bool
$c< :: RawArchive -> RawArchive -> Bool
compare :: RawArchive -> RawArchive -> Ordering
$ccompare :: RawArchive -> RawArchive -> Ordering
Ord, Typeable)
instance NFData RawArchive
data Archive = Archive
{ Archive -> ArchiveLocation
archiveLocation :: !ArchiveLocation
, Archive -> SHA256
archiveHash :: !SHA256
, Archive -> FileSize
archiveSize :: !FileSize
, Archive -> Text
archiveSubdir :: !Text
}
deriving (forall x. Rep Archive x -> Archive
forall x. Archive -> Rep Archive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Archive x -> Archive
$cfrom :: forall x. Archive -> Rep Archive x
Generic, Int -> Archive -> ShowS
[Archive] -> ShowS
Archive -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Archive] -> ShowS
$cshowList :: [Archive] -> ShowS
show :: Archive -> [Char]
$cshow :: Archive -> [Char]
showsPrec :: Int -> Archive -> ShowS
$cshowsPrec :: Int -> Archive -> ShowS
Show, Archive -> Archive -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Archive -> Archive -> Bool
$c/= :: Archive -> Archive -> Bool
== :: Archive -> Archive -> Bool
$c== :: Archive -> Archive -> Bool
Eq, Eq Archive
Archive -> Archive -> Bool
Archive -> Archive -> Ordering
Archive -> Archive -> Archive
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Archive -> Archive -> Archive
$cmin :: Archive -> Archive -> Archive
max :: Archive -> Archive -> Archive
$cmax :: Archive -> Archive -> Archive
>= :: Archive -> Archive -> Bool
$c>= :: Archive -> Archive -> Bool
> :: Archive -> Archive -> Bool
$c> :: Archive -> Archive -> Bool
<= :: Archive -> Archive -> Bool
$c<= :: Archive -> Archive -> Bool
< :: Archive -> Archive -> Bool
$c< :: Archive -> Archive -> Bool
compare :: Archive -> Archive -> Ordering
$ccompare :: Archive -> Archive -> Ordering
Ord, Typeable)
instance NFData Archive
toRawArchive :: Archive -> RawArchive
toRawArchive :: Archive -> RawArchive
toRawArchive Archive
archive =
ArchiveLocation
-> Maybe SHA256 -> Maybe FileSize -> Text -> RawArchive
RawArchive (Archive -> ArchiveLocation
archiveLocation Archive
archive) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Archive -> SHA256
archiveHash Archive
archive)
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Archive -> FileSize
archiveSize Archive
archive) (Archive -> Text
archiveSubdir Archive
archive)
data RepoType = RepoGit | RepoHg
deriving (forall x. Rep RepoType x -> RepoType
forall x. RepoType -> Rep RepoType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepoType x -> RepoType
$cfrom :: forall x. RepoType -> Rep RepoType x
Generic, Int -> RepoType -> ShowS
[RepoType] -> ShowS
RepoType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RepoType] -> ShowS
$cshowList :: [RepoType] -> ShowS
show :: RepoType -> [Char]
$cshow :: RepoType -> [Char]
showsPrec :: Int -> RepoType -> ShowS
$cshowsPrec :: Int -> RepoType -> ShowS
Show, RepoType -> RepoType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepoType -> RepoType -> Bool
$c/= :: RepoType -> RepoType -> Bool
== :: RepoType -> RepoType -> Bool
$c== :: RepoType -> RepoType -> Bool
Eq, Eq RepoType
RepoType -> RepoType -> Bool
RepoType -> RepoType -> Ordering
RepoType -> RepoType -> RepoType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RepoType -> RepoType -> RepoType
$cmin :: RepoType -> RepoType -> RepoType
max :: RepoType -> RepoType -> RepoType
$cmax :: RepoType -> RepoType -> RepoType
>= :: RepoType -> RepoType -> Bool
$c>= :: RepoType -> RepoType -> Bool
> :: RepoType -> RepoType -> Bool
$c> :: RepoType -> RepoType -> Bool
<= :: RepoType -> RepoType -> Bool
$c<= :: RepoType -> RepoType -> Bool
< :: RepoType -> RepoType -> Bool
$c< :: RepoType -> RepoType -> Bool
compare :: RepoType -> RepoType -> Ordering
$ccompare :: RepoType -> RepoType -> Ordering
Ord, Typeable)
instance NFData RepoType
instance PersistField RepoType where
toPersistValue :: RepoType -> PersistValue
toPersistValue RepoType
RepoGit = forall a. PersistField a => a -> PersistValue
toPersistValue (Int32
1 :: Int32)
toPersistValue RepoType
RepoHg = forall a. PersistField a => a -> PersistValue
toPersistValue (Int32
2 :: Int32)
fromPersistValue :: PersistValue -> Either Text RepoType
fromPersistValue PersistValue
v = do
Int32
i <- forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
case Int32
i :: Int32 of
Int32
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoType
RepoGit
Int32
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoType
RepoHg
Int32
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid RepoType: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int32
i
instance PersistFieldSql RepoType where
sqlType :: Proxy RepoType -> SqlType
sqlType Proxy RepoType
_ = SqlType
SqlInt32
data Repo = Repo
{ Repo -> Text
repoUrl :: !Text
, Repo -> Text
repoCommit :: !Text
, Repo -> RepoType
repoType :: !RepoType
, Repo -> Text
repoSubdir :: !Text
}
deriving (forall x. Rep Repo x -> Repo
forall x. Repo -> Rep Repo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Repo x -> Repo
$cfrom :: forall x. Repo -> Rep Repo x
Generic, Repo -> Repo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repo -> Repo -> Bool
$c/= :: Repo -> Repo -> Bool
== :: Repo -> Repo -> Bool
$c== :: Repo -> Repo -> Bool
Eq, Eq Repo
Repo -> Repo -> Bool
Repo -> Repo -> Ordering
Repo -> Repo -> Repo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Repo -> Repo -> Repo
$cmin :: Repo -> Repo -> Repo
max :: Repo -> Repo -> Repo
$cmax :: Repo -> Repo -> Repo
>= :: Repo -> Repo -> Bool
$c>= :: Repo -> Repo -> Bool
> :: Repo -> Repo -> Bool
$c> :: Repo -> Repo -> Bool
<= :: Repo -> Repo -> Bool
$c<= :: Repo -> Repo -> Bool
< :: Repo -> Repo -> Bool
$c< :: Repo -> Repo -> Bool
compare :: Repo -> Repo -> Ordering
$ccompare :: Repo -> Repo -> Ordering
Ord, Typeable)
instance NFData Repo
instance Show Repo where
show :: Repo -> [Char]
show = Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display
instance Display Repo where
display :: Repo -> Utf8Builder
display (Repo Text
url Text
commit RepoType
typ Text
subdir) =
(case RepoType
typ of
RepoType
RepoGit -> Utf8Builder
"Git"
RepoType
RepoHg -> Utf8Builder
"Mercurial") forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" repo at " forall a. Semigroup a => a -> a -> a
<>
forall a. Display a => a -> Utf8Builder
display Text
url forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", commit " forall a. Semigroup a => a -> a -> a
<>
forall a. Display a => a -> Utf8Builder
display Text
commit forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null Text
subdir
then forall a. Monoid a => a
mempty
else Utf8Builder
" in subdirectory " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
subdir)
rToSimpleRepo :: Repo -> SimpleRepo
rToSimpleRepo :: Repo -> SimpleRepo
rToSimpleRepo Repo {Text
RepoType
repoSubdir :: Text
repoType :: RepoType
repoCommit :: Text
repoUrl :: Text
repoType :: Repo -> RepoType
repoSubdir :: Repo -> Text
repoCommit :: Repo -> Text
repoUrl :: Repo -> Text
..} = SimpleRepo { sRepoUrl :: Text
sRepoUrl = Text
repoUrl, sRepoCommit :: Text
sRepoCommit = Text
repoCommit, sRepoType :: RepoType
sRepoType = RepoType
repoType }
data AggregateRepo = AggregateRepo
{ AggregateRepo -> SimpleRepo
aRepo :: !SimpleRepo
, AggregateRepo -> [(Text, RawPackageMetadata)]
aRepoSubdirs :: [(Text, RawPackageMetadata)]
}
deriving (Int -> AggregateRepo -> ShowS
[AggregateRepo] -> ShowS
AggregateRepo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AggregateRepo] -> ShowS
$cshowList :: [AggregateRepo] -> ShowS
show :: AggregateRepo -> [Char]
$cshow :: AggregateRepo -> [Char]
showsPrec :: Int -> AggregateRepo -> ShowS
$cshowsPrec :: Int -> AggregateRepo -> ShowS
Show, forall x. Rep AggregateRepo x -> AggregateRepo
forall x. AggregateRepo -> Rep AggregateRepo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AggregateRepo x -> AggregateRepo
$cfrom :: forall x. AggregateRepo -> Rep AggregateRepo x
Generic, AggregateRepo -> AggregateRepo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AggregateRepo -> AggregateRepo -> Bool
$c/= :: AggregateRepo -> AggregateRepo -> Bool
== :: AggregateRepo -> AggregateRepo -> Bool
$c== :: AggregateRepo -> AggregateRepo -> Bool
Eq, Eq AggregateRepo
AggregateRepo -> AggregateRepo -> Bool
AggregateRepo -> AggregateRepo -> Ordering
AggregateRepo -> AggregateRepo -> AggregateRepo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AggregateRepo -> AggregateRepo -> AggregateRepo
$cmin :: AggregateRepo -> AggregateRepo -> AggregateRepo
max :: AggregateRepo -> AggregateRepo -> AggregateRepo
$cmax :: AggregateRepo -> AggregateRepo -> AggregateRepo
>= :: AggregateRepo -> AggregateRepo -> Bool
$c>= :: AggregateRepo -> AggregateRepo -> Bool
> :: AggregateRepo -> AggregateRepo -> Bool
$c> :: AggregateRepo -> AggregateRepo -> Bool
<= :: AggregateRepo -> AggregateRepo -> Bool
$c<= :: AggregateRepo -> AggregateRepo -> Bool
< :: AggregateRepo -> AggregateRepo -> Bool
$c< :: AggregateRepo -> AggregateRepo -> Bool
compare :: AggregateRepo -> AggregateRepo -> Ordering
$ccompare :: AggregateRepo -> AggregateRepo -> Ordering
Ord, Typeable)
toAggregateRepos :: [(Repo, RawPackageMetadata)] -> [AggregateRepo]
toAggregateRepos :: [(Repo, RawPackageMetadata)] -> [AggregateRepo]
toAggregateRepos = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [(Repo, RawPackageMetadata)] -> Maybe AggregateRepo
toAggregateRepo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy forall {b} {b}. (Repo, b) -> (Repo, b) -> Bool
matchRepoExclSubdir
where
toAggregateRepo :: [(Repo, RawPackageMetadata)] -> Maybe AggregateRepo
toAggregateRepo :: [(Repo, RawPackageMetadata)] -> Maybe AggregateRepo
toAggregateRepo [] = forall a. Maybe a
Nothing
toAggregateRepo xs :: [(Repo, RawPackageMetadata)]
xs@((Repo
repo, RawPackageMetadata
_):[(Repo, RawPackageMetadata)]
_) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SimpleRepo -> [(Text, RawPackageMetadata)] -> AggregateRepo
AggregateRepo (Repo -> SimpleRepo
rToSimpleRepo Repo
repo) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Repo -> Text
repoSubdir) [(Repo, RawPackageMetadata)]
xs)
matchRepoExclSubdir :: (Repo, b) -> (Repo, b) -> Bool
matchRepoExclSubdir (Repo, b)
x1 (Repo, b)
x2 =
let (Repo Text
url1 Text
commit1 RepoType
type1 Text
_, b
_) = (Repo, b)
x1
(Repo Text
url2 Text
commit2 RepoType
type2 Text
_, b
_) = (Repo, b)
x2
in (Text
url1, Text
commit1, RepoType
type1) forall a. Eq a => a -> a -> Bool
== (Text
url2, Text
commit2, RepoType
type2)
arToSimpleRepo :: AggregateRepo -> SimpleRepo
arToSimpleRepo :: AggregateRepo -> SimpleRepo
arToSimpleRepo AggregateRepo {[(Text, RawPackageMetadata)]
SimpleRepo
aRepoSubdirs :: [(Text, RawPackageMetadata)]
aRepo :: SimpleRepo
aRepoSubdirs :: AggregateRepo -> [(Text, RawPackageMetadata)]
aRepo :: AggregateRepo -> SimpleRepo
..} = SimpleRepo
aRepo
data SimpleRepo = SimpleRepo
{ SimpleRepo -> Text
sRepoUrl :: !Text
, SimpleRepo -> Text
sRepoCommit :: !Text
, SimpleRepo -> RepoType
sRepoType :: !RepoType
}
deriving (Int -> SimpleRepo -> ShowS
[SimpleRepo] -> ShowS
SimpleRepo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SimpleRepo] -> ShowS
$cshowList :: [SimpleRepo] -> ShowS
show :: SimpleRepo -> [Char]
$cshow :: SimpleRepo -> [Char]
showsPrec :: Int -> SimpleRepo -> ShowS
$cshowsPrec :: Int -> SimpleRepo -> ShowS
Show, forall x. Rep SimpleRepo x -> SimpleRepo
forall x. SimpleRepo -> Rep SimpleRepo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimpleRepo x -> SimpleRepo
$cfrom :: forall x. SimpleRepo -> Rep SimpleRepo x
Generic, SimpleRepo -> SimpleRepo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleRepo -> SimpleRepo -> Bool
$c/= :: SimpleRepo -> SimpleRepo -> Bool
== :: SimpleRepo -> SimpleRepo -> Bool
$c== :: SimpleRepo -> SimpleRepo -> Bool
Eq, Eq SimpleRepo
SimpleRepo -> SimpleRepo -> Bool
SimpleRepo -> SimpleRepo -> Ordering
SimpleRepo -> SimpleRepo -> SimpleRepo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SimpleRepo -> SimpleRepo -> SimpleRepo
$cmin :: SimpleRepo -> SimpleRepo -> SimpleRepo
max :: SimpleRepo -> SimpleRepo -> SimpleRepo
$cmax :: SimpleRepo -> SimpleRepo -> SimpleRepo
>= :: SimpleRepo -> SimpleRepo -> Bool
$c>= :: SimpleRepo -> SimpleRepo -> Bool
> :: SimpleRepo -> SimpleRepo -> Bool
$c> :: SimpleRepo -> SimpleRepo -> Bool
<= :: SimpleRepo -> SimpleRepo -> Bool
$c<= :: SimpleRepo -> SimpleRepo -> Bool
< :: SimpleRepo -> SimpleRepo -> Bool
$c< :: SimpleRepo -> SimpleRepo -> Bool
compare :: SimpleRepo -> SimpleRepo -> Ordering
$ccompare :: SimpleRepo -> SimpleRepo -> Ordering
Ord, Typeable)
instance Display SimpleRepo where
display :: SimpleRepo -> Utf8Builder
display (SimpleRepo Text
url Text
commit RepoType
typ) =
(case RepoType
typ of
RepoType
RepoGit -> Utf8Builder
"Git"
RepoType
RepoHg -> Utf8Builder
"Mercurial") forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" repo at " forall a. Semigroup a => a -> a -> a
<>
forall a. Display a => a -> Utf8Builder
display Text
url forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", commit " forall a. Semigroup a => a -> a -> a
<>
forall a. Display a => a -> Utf8Builder
display Text
commit
newtype GitHubRepo = GitHubRepo Text
instance FromJSON GitHubRepo where
parseJSON :: Value -> Parser GitHubRepo
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"GitHubRepo" forall a b. (a -> b) -> a -> b
$ \Text
s -> do
case (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'/') Text
s of
[Text
x, Text
y] | Bool -> Bool
not (Text -> Bool
T.null Text
x Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
y) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> GitHubRepo
GitHubRepo Text
s)
[Text]
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expecting \"user/repo\""
data PackageIndexConfig = PackageIndexConfig
{ PackageIndexConfig -> Text
picDownloadPrefix :: !Text
, PackageIndexConfig -> HackageSecurityConfig
picHackageSecurityConfig :: !HackageSecurityConfig
}
deriving Int -> PackageIndexConfig -> ShowS
[PackageIndexConfig] -> ShowS
PackageIndexConfig -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PackageIndexConfig] -> ShowS
$cshowList :: [PackageIndexConfig] -> ShowS
show :: PackageIndexConfig -> [Char]
$cshow :: PackageIndexConfig -> [Char]
showsPrec :: Int -> PackageIndexConfig -> ShowS
$cshowsPrec :: Int -> PackageIndexConfig -> ShowS
Show
instance FromJSON (WithJSONWarnings PackageIndexConfig) where
parseJSON :: Value -> Parser (WithJSONWarnings PackageIndexConfig)
parseJSON = forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"PackageIndexConfig" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Text
picDownloadPrefix <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"download-prefix"
HackageSecurityConfig
picHackageSecurityConfig <- forall a. WarningParser (WithJSONWarnings a) -> WarningParser a
jsonSubWarnings forall a b. (a -> b) -> a -> b
$
Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"hackage-security" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= forall a. a -> WithJSONWarnings a
noJSONWarnings HackageSecurityConfig
defaultHackageSecurityConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageIndexConfig {Text
HackageSecurityConfig
picHackageSecurityConfig :: HackageSecurityConfig
picDownloadPrefix :: Text
picHackageSecurityConfig :: HackageSecurityConfig
picDownloadPrefix :: Text
..}
defaultHackageSecurityConfig :: HackageSecurityConfig
defaultHackageSecurityConfig :: HackageSecurityConfig
defaultHackageSecurityConfig = HackageSecurityConfig
{ hscKeyIds :: [Text]
hscKeyIds =
[ Text
"0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d"
, Text
"1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42"
, Text
"2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3"
, Text
"51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921"
, Text
"fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0"
]
, hscKeyThreshold :: Int
hscKeyThreshold = Int
3
, hscIgnoreExpiry :: Bool
hscIgnoreExpiry = Bool
True
}
data HackageSecurityConfig = HackageSecurityConfig
{ HackageSecurityConfig -> [Text]
hscKeyIds :: ![Text]
, HackageSecurityConfig -> Int
hscKeyThreshold :: !Int
, HackageSecurityConfig -> Bool
hscIgnoreExpiry :: !Bool
}
deriving Int -> HackageSecurityConfig -> ShowS
[HackageSecurityConfig] -> ShowS
HackageSecurityConfig -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HackageSecurityConfig] -> ShowS
$cshowList :: [HackageSecurityConfig] -> ShowS
show :: HackageSecurityConfig -> [Char]
$cshow :: HackageSecurityConfig -> [Char]
showsPrec :: Int -> HackageSecurityConfig -> ShowS
$cshowsPrec :: Int -> HackageSecurityConfig -> ShowS
Show
instance FromJSON (WithJSONWarnings HackageSecurityConfig) where
parseJSON :: Value -> Parser (WithJSONWarnings HackageSecurityConfig)
parseJSON = forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"HackageSecurityConfig" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
[Text]
hscKeyIds <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"keyids"
Int
hscKeyThreshold <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"key-threshold"
Bool
hscIgnoreExpiry <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"ignore-expiry" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Bool
True
forall (f :: * -> *) a. Applicative f => a -> f a
pure HackageSecurityConfig {Bool
Int
[Text]
hscIgnoreExpiry :: Bool
hscKeyThreshold :: Int
hscKeyIds :: [Text]
hscIgnoreExpiry :: Bool
hscKeyThreshold :: Int
hscKeyIds :: [Text]
..}
class HasPantryConfig env where
pantryConfigL :: Lens' env PantryConfig
newtype FileSize = FileSize Word
deriving (Int -> FileSize -> ShowS
[FileSize] -> ShowS
FileSize -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FileSize] -> ShowS
$cshowList :: [FileSize] -> ShowS
show :: FileSize -> [Char]
$cshow :: FileSize -> [Char]
showsPrec :: Int -> FileSize -> ShowS
$cshowsPrec :: Int -> FileSize -> ShowS
Show, FileSize -> FileSize -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileSize -> FileSize -> Bool
$c/= :: FileSize -> FileSize -> Bool
== :: FileSize -> FileSize -> Bool
$c== :: FileSize -> FileSize -> Bool
Eq, Eq FileSize
FileSize -> FileSize -> Bool
FileSize -> FileSize -> Ordering
FileSize -> FileSize -> FileSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileSize -> FileSize -> FileSize
$cmin :: FileSize -> FileSize -> FileSize
max :: FileSize -> FileSize -> FileSize
$cmax :: FileSize -> FileSize -> FileSize
>= :: FileSize -> FileSize -> Bool
$c>= :: FileSize -> FileSize -> Bool
> :: FileSize -> FileSize -> Bool
$c> :: FileSize -> FileSize -> Bool
<= :: FileSize -> FileSize -> Bool
$c<= :: FileSize -> FileSize -> Bool
< :: FileSize -> FileSize -> Bool
$c< :: FileSize -> FileSize -> Bool
compare :: FileSize -> FileSize -> Ordering
$ccompare :: FileSize -> FileSize -> Ordering
Ord, Typeable, forall x. Rep FileSize x -> FileSize
forall x. FileSize -> Rep FileSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileSize x -> FileSize
$cfrom :: forall x. FileSize -> Rep FileSize x
Generic, FileSize -> Text
FileSize -> Utf8Builder
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
textDisplay :: FileSize -> Text
$ctextDisplay :: FileSize -> Text
display :: FileSize -> Utf8Builder
$cdisplay :: FileSize -> Utf8Builder
Display, Eq FileSize
Int -> FileSize -> Int
FileSize -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: FileSize -> Int
$chash :: FileSize -> Int
hashWithSalt :: Int -> FileSize -> Int
$chashWithSalt :: Int -> FileSize -> Int
Hashable, FileSize -> ()
forall a. (a -> ()) -> NFData a
rnf :: FileSize -> ()
$crnf :: FileSize -> ()
NFData, PersistValue -> Either Text FileSize
FileSize -> PersistValue
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
fromPersistValue :: PersistValue -> Either Text FileSize
$cfromPersistValue :: PersistValue -> Either Text FileSize
toPersistValue :: FileSize -> PersistValue
$ctoPersistValue :: FileSize -> PersistValue
PersistField, PersistField FileSize
Proxy FileSize -> SqlType
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
sqlType :: Proxy FileSize -> SqlType
$csqlType :: Proxy FileSize -> SqlType
PersistFieldSql, [FileSize] -> Encoding
[FileSize] -> Value
FileSize -> Encoding
FileSize -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FileSize] -> Encoding
$ctoEncodingList :: [FileSize] -> Encoding
toJSONList :: [FileSize] -> Value
$ctoJSONList :: [FileSize] -> Value
toEncoding :: FileSize -> Encoding
$ctoEncoding :: FileSize -> Encoding
toJSON :: FileSize -> Value
$ctoJSON :: FileSize -> Value
ToJSON, Value -> Parser [FileSize]
Value -> Parser FileSize
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FileSize]
$cparseJSONList :: Value -> Parser [FileSize]
parseJSON :: Value -> Parser FileSize
$cparseJSON :: Value -> Parser FileSize
FromJSON)
data BlobKey = BlobKey !SHA256 !FileSize
deriving (BlobKey -> BlobKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlobKey -> BlobKey -> Bool
$c/= :: BlobKey -> BlobKey -> Bool
== :: BlobKey -> BlobKey -> Bool
$c== :: BlobKey -> BlobKey -> Bool
Eq, Eq BlobKey
BlobKey -> BlobKey -> Bool
BlobKey -> BlobKey -> Ordering
BlobKey -> BlobKey -> BlobKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlobKey -> BlobKey -> BlobKey
$cmin :: BlobKey -> BlobKey -> BlobKey
max :: BlobKey -> BlobKey -> BlobKey
$cmax :: BlobKey -> BlobKey -> BlobKey
>= :: BlobKey -> BlobKey -> Bool
$c>= :: BlobKey -> BlobKey -> Bool
> :: BlobKey -> BlobKey -> Bool
$c> :: BlobKey -> BlobKey -> Bool
<= :: BlobKey -> BlobKey -> Bool
$c<= :: BlobKey -> BlobKey -> Bool
< :: BlobKey -> BlobKey -> Bool
$c< :: BlobKey -> BlobKey -> Bool
compare :: BlobKey -> BlobKey -> Ordering
$ccompare :: BlobKey -> BlobKey -> Ordering
Ord, Typeable, forall x. Rep BlobKey x -> BlobKey
forall x. BlobKey -> Rep BlobKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlobKey x -> BlobKey
$cfrom :: forall x. BlobKey -> Rep BlobKey x
Generic)
instance NFData BlobKey
instance Show BlobKey where
show :: BlobKey -> [Char]
show = Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display
instance Display BlobKey where
display :: BlobKey -> Utf8Builder
display (BlobKey SHA256
sha FileSize
size') = forall a. Display a => a -> Utf8Builder
display SHA256
sha forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"," forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display FileSize
size'
blobKeyPairs :: BlobKey -> [(AesonKey, Value)]
blobKeyPairs :: BlobKey -> [(AesonKey, Value)]
blobKeyPairs (BlobKey SHA256
sha FileSize
size') =
[ AesonKey
"sha256" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= SHA256
sha
, AesonKey
"size" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= FileSize
size'
]
instance ToJSON BlobKey where
toJSON :: BlobKey -> Value
toJSON = [(AesonKey, Value)] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlobKey -> [(AesonKey, Value)]
blobKeyPairs
instance FromJSON BlobKey where
parseJSON :: Value -> Parser BlobKey
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"BlobKey" forall a b. (a -> b) -> a -> b
$ \Object
o -> SHA256 -> FileSize -> BlobKey
BlobKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"sha256"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"size"
newtype PackageNameP = PackageNameP { PackageNameP -> PackageName
unPackageNameP :: PackageName }
deriving (PackageNameP -> PackageNameP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageNameP -> PackageNameP -> Bool
$c/= :: PackageNameP -> PackageNameP -> Bool
== :: PackageNameP -> PackageNameP -> Bool
$c== :: PackageNameP -> PackageNameP -> Bool
Eq, Eq PackageNameP
PackageNameP -> PackageNameP -> Bool
PackageNameP -> PackageNameP -> Ordering
PackageNameP -> PackageNameP -> PackageNameP
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageNameP -> PackageNameP -> PackageNameP
$cmin :: PackageNameP -> PackageNameP -> PackageNameP
max :: PackageNameP -> PackageNameP -> PackageNameP
$cmax :: PackageNameP -> PackageNameP -> PackageNameP
>= :: PackageNameP -> PackageNameP -> Bool
$c>= :: PackageNameP -> PackageNameP -> Bool
> :: PackageNameP -> PackageNameP -> Bool
$c> :: PackageNameP -> PackageNameP -> Bool
<= :: PackageNameP -> PackageNameP -> Bool
$c<= :: PackageNameP -> PackageNameP -> Bool
< :: PackageNameP -> PackageNameP -> Bool
$c< :: PackageNameP -> PackageNameP -> Bool
compare :: PackageNameP -> PackageNameP -> Ordering
$ccompare :: PackageNameP -> PackageNameP -> Ordering
Ord, Int -> PackageNameP -> ShowS
[PackageNameP] -> ShowS
PackageNameP -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PackageNameP] -> ShowS
$cshowList :: [PackageNameP] -> ShowS
show :: PackageNameP -> [Char]
$cshow :: PackageNameP -> [Char]
showsPrec :: Int -> PackageNameP -> ShowS
$cshowsPrec :: Int -> PackageNameP -> ShowS
Show, ReadPrec [PackageNameP]
ReadPrec PackageNameP
Int -> ReadS PackageNameP
ReadS [PackageNameP]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PackageNameP]
$creadListPrec :: ReadPrec [PackageNameP]
readPrec :: ReadPrec PackageNameP
$creadPrec :: ReadPrec PackageNameP
readList :: ReadS [PackageNameP]
$creadList :: ReadS [PackageNameP]
readsPrec :: Int -> ReadS PackageNameP
$creadsPrec :: Int -> ReadS PackageNameP
Read, PackageNameP -> ()
forall a. (a -> ()) -> NFData a
rnf :: PackageNameP -> ()
$crnf :: PackageNameP -> ()
NFData)
instance Display PackageNameP where
display :: PackageNameP -> Utf8Builder
display = forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> [Char]
packageNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageNameP -> PackageName
unPackageNameP
instance PersistField PackageNameP where
toPersistValue :: PackageNameP -> PersistValue
toPersistValue (PackageNameP PackageName
pn) = Text -> PersistValue
PersistText forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ PackageName -> [Char]
packageNameString PackageName
pn
fromPersistValue :: PersistValue -> Either Text PackageNameP
fromPersistValue PersistValue
v = do
[Char]
str <- forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
case [Char] -> Maybe PackageName
parsePackageName [Char]
str of
Maybe PackageName
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Invalid package name: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
str
Just PackageName
pn -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ PackageName -> PackageNameP
PackageNameP PackageName
pn
instance PersistFieldSql PackageNameP where
sqlType :: Proxy PackageNameP -> SqlType
sqlType Proxy PackageNameP
_ = SqlType
SqlString
instance ToJSON PackageNameP where
toJSON :: PackageNameP -> Value
toJSON (PackageNameP PackageName
pn) = Text -> Value
String forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ PackageName -> [Char]
packageNameString PackageName
pn
instance FromJSON PackageNameP where
parseJSON :: Value -> Parser PackageNameP
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"PackageNameP" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> PackageNameP
PackageNameP forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> PackageName
mkPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
instance ToJSONKey PackageNameP where
toJSONKey :: ToJSONKeyFunction PackageNameP
toJSONKey =
forall a.
(a -> AesonKey) -> (a -> Encoding' AesonKey) -> ToJSONKeyFunction a
ToJSONKeyText
(forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> [Char]
packageNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageNameP -> PackageName
unPackageNameP)
(forall a. Builder -> Encoding' a
unsafeToEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Builder
getUtf8Builder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display)
instance FromJSONKey PackageNameP where
fromJSONKey :: FromJSONKeyFunction PackageNameP
fromJSONKey = forall a. (Text -> a) -> FromJSONKeyFunction a
FromJSONKeyText forall a b. (a -> b) -> a -> b
$ PackageName -> PackageNameP
PackageNameP forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> PackageName
mkPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
newtype VersionP = VersionP { VersionP -> Version
unVersionP :: Version }
deriving (VersionP -> VersionP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionP -> VersionP -> Bool
$c/= :: VersionP -> VersionP -> Bool
== :: VersionP -> VersionP -> Bool
$c== :: VersionP -> VersionP -> Bool
Eq, Eq VersionP
VersionP -> VersionP -> Bool
VersionP -> VersionP -> Ordering
VersionP -> VersionP -> VersionP
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VersionP -> VersionP -> VersionP
$cmin :: VersionP -> VersionP -> VersionP
max :: VersionP -> VersionP -> VersionP
$cmax :: VersionP -> VersionP -> VersionP
>= :: VersionP -> VersionP -> Bool
$c>= :: VersionP -> VersionP -> Bool
> :: VersionP -> VersionP -> Bool
$c> :: VersionP -> VersionP -> Bool
<= :: VersionP -> VersionP -> Bool
$c<= :: VersionP -> VersionP -> Bool
< :: VersionP -> VersionP -> Bool
$c< :: VersionP -> VersionP -> Bool
compare :: VersionP -> VersionP -> Ordering
$ccompare :: VersionP -> VersionP -> Ordering
Ord, Int -> VersionP -> ShowS
[VersionP] -> ShowS
VersionP -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [VersionP] -> ShowS
$cshowList :: [VersionP] -> ShowS
show :: VersionP -> [Char]
$cshow :: VersionP -> [Char]
showsPrec :: Int -> VersionP -> ShowS
$cshowsPrec :: Int -> VersionP -> ShowS
Show, ReadPrec [VersionP]
ReadPrec VersionP
Int -> ReadS VersionP
ReadS [VersionP]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VersionP]
$creadListPrec :: ReadPrec [VersionP]
readPrec :: ReadPrec VersionP
$creadPrec :: ReadPrec VersionP
readList :: ReadS [VersionP]
$creadList :: ReadS [VersionP]
readsPrec :: Int -> ReadS VersionP
$creadsPrec :: Int -> ReadS VersionP
Read, VersionP -> ()
forall a. (a -> ()) -> NFData a
rnf :: VersionP -> ()
$crnf :: VersionP -> ()
NFData)
instance PersistField VersionP where
toPersistValue :: VersionP -> PersistValue
toPersistValue (VersionP Version
v) = Text -> PersistValue
PersistText forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Version -> [Char]
versionString Version
v
fromPersistValue :: PersistValue -> Either Text VersionP
fromPersistValue PersistValue
v = do
[Char]
str <- forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
case [Char] -> Maybe Version
parseVersion [Char]
str of
Maybe Version
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Invalid version number: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
str
Just Version
ver -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Version -> VersionP
VersionP Version
ver
instance PersistFieldSql VersionP where
sqlType :: Proxy VersionP -> SqlType
sqlType Proxy VersionP
_ = SqlType
SqlString
instance Display VersionP where
display :: VersionP -> Utf8Builder
display (VersionP Version
v) = forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Version -> [Char]
versionString Version
v
instance ToJSON VersionP where
toJSON :: VersionP -> Value
toJSON (VersionP Version
v) = Text -> Value
String forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Version -> [Char]
versionString Version
v
instance FromJSON VersionP where
parseJSON :: Value -> Parser VersionP
parseJSON =
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"VersionP" forall a b. (a -> b) -> a -> b
$
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> [Char]
displayException) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> VersionP
VersionP) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadThrow m => [Char] -> m Version
parseVersionThrowing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
newtype ModuleNameP = ModuleNameP
{ ModuleNameP -> ModuleName
unModuleNameP :: ModuleName
} deriving (ModuleNameP -> ModuleNameP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleNameP -> ModuleNameP -> Bool
$c/= :: ModuleNameP -> ModuleNameP -> Bool
== :: ModuleNameP -> ModuleNameP -> Bool
$c== :: ModuleNameP -> ModuleNameP -> Bool
Eq, Eq ModuleNameP
ModuleNameP -> ModuleNameP -> Bool
ModuleNameP -> ModuleNameP -> Ordering
ModuleNameP -> ModuleNameP -> ModuleNameP
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModuleNameP -> ModuleNameP -> ModuleNameP
$cmin :: ModuleNameP -> ModuleNameP -> ModuleNameP
max :: ModuleNameP -> ModuleNameP -> ModuleNameP
$cmax :: ModuleNameP -> ModuleNameP -> ModuleNameP
>= :: ModuleNameP -> ModuleNameP -> Bool
$c>= :: ModuleNameP -> ModuleNameP -> Bool
> :: ModuleNameP -> ModuleNameP -> Bool
$c> :: ModuleNameP -> ModuleNameP -> Bool
<= :: ModuleNameP -> ModuleNameP -> Bool
$c<= :: ModuleNameP -> ModuleNameP -> Bool
< :: ModuleNameP -> ModuleNameP -> Bool
$c< :: ModuleNameP -> ModuleNameP -> Bool
compare :: ModuleNameP -> ModuleNameP -> Ordering
$ccompare :: ModuleNameP -> ModuleNameP -> Ordering
Ord, Int -> ModuleNameP -> ShowS
[ModuleNameP] -> ShowS
ModuleNameP -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ModuleNameP] -> ShowS
$cshowList :: [ModuleNameP] -> ShowS
show :: ModuleNameP -> [Char]
$cshow :: ModuleNameP -> [Char]
showsPrec :: Int -> ModuleNameP -> ShowS
$cshowsPrec :: Int -> ModuleNameP -> ShowS
Show, ModuleNameP -> ()
forall a. (a -> ()) -> NFData a
rnf :: ModuleNameP -> ()
$crnf :: ModuleNameP -> ()
NFData)
instance Display ModuleNameP where
display :: ModuleNameP -> Utf8Builder
display = forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [Char]
moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleNameP -> ModuleName
unModuleNameP
instance PersistField ModuleNameP where
toPersistValue :: ModuleNameP -> PersistValue
toPersistValue (ModuleNameP ModuleName
mn) = Text -> PersistValue
PersistText forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ModuleName -> [Char]
moduleNameString ModuleName
mn
fromPersistValue :: PersistValue -> Either Text ModuleNameP
fromPersistValue PersistValue
v = do
[Char]
str <- forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
case [Char] -> Maybe ModuleName
parseModuleName [Char]
str of
Maybe ModuleName
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Invalid module name: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
str
Just ModuleName
pn -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ModuleName -> ModuleNameP
ModuleNameP ModuleName
pn
instance PersistFieldSql ModuleNameP where
sqlType :: Proxy ModuleNameP -> SqlType
sqlType Proxy ModuleNameP
_ = SqlType
SqlString
data CabalFileInfo
= CFILatest
| CFIHash !SHA256 !(Maybe FileSize)
| CFIRevision !Revision
deriving (forall x. Rep CabalFileInfo x -> CabalFileInfo
forall x. CabalFileInfo -> Rep CabalFileInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CabalFileInfo x -> CabalFileInfo
$cfrom :: forall x. CabalFileInfo -> Rep CabalFileInfo x
Generic, Int -> CabalFileInfo -> ShowS
[CabalFileInfo] -> ShowS
CabalFileInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CabalFileInfo] -> ShowS
$cshowList :: [CabalFileInfo] -> ShowS
show :: CabalFileInfo -> [Char]
$cshow :: CabalFileInfo -> [Char]
showsPrec :: Int -> CabalFileInfo -> ShowS
$cshowsPrec :: Int -> CabalFileInfo -> ShowS
Show, CabalFileInfo -> CabalFileInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CabalFileInfo -> CabalFileInfo -> Bool
$c/= :: CabalFileInfo -> CabalFileInfo -> Bool
== :: CabalFileInfo -> CabalFileInfo -> Bool
$c== :: CabalFileInfo -> CabalFileInfo -> Bool
Eq, Eq CabalFileInfo
CabalFileInfo -> CabalFileInfo -> Bool
CabalFileInfo -> CabalFileInfo -> Ordering
CabalFileInfo -> CabalFileInfo -> CabalFileInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CabalFileInfo -> CabalFileInfo -> CabalFileInfo
$cmin :: CabalFileInfo -> CabalFileInfo -> CabalFileInfo
max :: CabalFileInfo -> CabalFileInfo -> CabalFileInfo
$cmax :: CabalFileInfo -> CabalFileInfo -> CabalFileInfo
>= :: CabalFileInfo -> CabalFileInfo -> Bool
$c>= :: CabalFileInfo -> CabalFileInfo -> Bool
> :: CabalFileInfo -> CabalFileInfo -> Bool
$c> :: CabalFileInfo -> CabalFileInfo -> Bool
<= :: CabalFileInfo -> CabalFileInfo -> Bool
$c<= :: CabalFileInfo -> CabalFileInfo -> Bool
< :: CabalFileInfo -> CabalFileInfo -> Bool
$c< :: CabalFileInfo -> CabalFileInfo -> Bool
compare :: CabalFileInfo -> CabalFileInfo -> Ordering
$ccompare :: CabalFileInfo -> CabalFileInfo -> Ordering
Ord, Typeable)
instance NFData CabalFileInfo
instance Hashable CabalFileInfo
instance Display CabalFileInfo where
display :: CabalFileInfo -> Utf8Builder
display CabalFileInfo
CFILatest = forall a. Monoid a => a
mempty
display (CFIHash SHA256
hash' Maybe FileSize
msize) =
Utf8Builder
"@sha256:" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display SHA256
hash' forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\FileSize
i -> Utf8Builder
"," forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display FileSize
i) Maybe FileSize
msize
display (CFIRevision Revision
rev) = Utf8Builder
"@rev:" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Revision
rev
data PackageIdentifierRevision = PackageIdentifierRevision !PackageName !Version !CabalFileInfo
deriving (forall x.
Rep PackageIdentifierRevision x -> PackageIdentifierRevision
forall x.
PackageIdentifierRevision -> Rep PackageIdentifierRevision x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PackageIdentifierRevision x -> PackageIdentifierRevision
$cfrom :: forall x.
PackageIdentifierRevision -> Rep PackageIdentifierRevision x
Generic, PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
$c/= :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
== :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
$c== :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
Eq, Eq PackageIdentifierRevision
PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
PackageIdentifierRevision -> PackageIdentifierRevision -> Ordering
PackageIdentifierRevision
-> PackageIdentifierRevision -> PackageIdentifierRevision
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageIdentifierRevision
-> PackageIdentifierRevision -> PackageIdentifierRevision
$cmin :: PackageIdentifierRevision
-> PackageIdentifierRevision -> PackageIdentifierRevision
max :: PackageIdentifierRevision
-> PackageIdentifierRevision -> PackageIdentifierRevision
$cmax :: PackageIdentifierRevision
-> PackageIdentifierRevision -> PackageIdentifierRevision
>= :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
$c>= :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
> :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
$c> :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
<= :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
$c<= :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
< :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
$c< :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
compare :: PackageIdentifierRevision -> PackageIdentifierRevision -> Ordering
$ccompare :: PackageIdentifierRevision -> PackageIdentifierRevision -> Ordering
Ord, Typeable)
instance NFData PackageIdentifierRevision
instance Show PackageIdentifierRevision where
show :: PackageIdentifierRevision -> [Char]
show = Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display
instance Display PackageIdentifierRevision where
display :: PackageIdentifierRevision -> Utf8Builder
display (PackageIdentifierRevision PackageName
name Version
version CabalFileInfo
cfi) =
forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
packageNameString PackageName
name) forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"-" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
version) forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display CabalFileInfo
cfi
instance ToJSON PackageIdentifierRevision where
toJSON :: PackageIdentifierRevision -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display
instance FromJSON PackageIdentifierRevision where
parseJSON :: Value -> Parser PackageIdentifierRevision
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"PackageIdentifierRevision" forall a b. (a -> b) -> a -> b
$ \Text
t ->
case Text -> Either PantryException PackageIdentifierRevision
parsePackageIdentifierRevision Text
t of
Left PantryException
e -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show PantryException
e
Right PackageIdentifierRevision
pir -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageIdentifierRevision
pir
parseHackageText :: Text -> Either PantryException (PackageIdentifier, BlobKey)
parseHackageText :: Text -> Either PantryException (PackageIdentifier, BlobKey)
parseHackageText Text
t =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\[Char]
x -> forall a. HasCallStack => [Char] -> a
error (forall a. Show a => a -> [Char]
show [Char]
x) forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> PantryException
PackageIdentifierRevisionParseFail Text
t) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
forall a. ParsecParser a -> [Char] -> Either [Char] a
explicitEitherParsec (ParsecParser (PackageIdentifier, BlobKey)
hackageTextParsec forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). Parsing m => m ()
Parse.eof) forall a b. (a -> b) -> a -> b
$
Text -> [Char]
T.unpack Text
t
hackageTextParsec :: ParsecParser (PackageIdentifier, BlobKey)
hackageTextParsec :: ParsecParser (PackageIdentifier, BlobKey)
hackageTextParsec = do
PackageIdentifier
ident <- ParsecParser PackageIdentifier
packageIdentifierParsec
[Char]
_ <- forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
Parse.string [Char]
"@sha256:"
[Char]
shaT <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m [Char]
Parse.munch (forall a. Eq a => a -> a -> Bool
/= Char
',')
SHA256
sha <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Either SHA256Exception SHA256
SHA256.fromHexText forall a b. (a -> b) -> a -> b
$ forall a. IsString a => [Char] -> a
fromString [Char]
shaT
Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
Parse.char Char
','
Word
size' <- forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
Parse.integral
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageIdentifier
ident, SHA256 -> FileSize -> BlobKey
BlobKey SHA256
sha (Word -> FileSize
FileSize Word
size'))
splitColon :: Text -> Maybe (Text, Text)
splitColon :: Text -> Maybe (Text, Text)
splitColon Text
t' =
let (Text
x, Text
y) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
':') Text
t'
in (Text
x, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
T.stripPrefix Text
":" Text
y
parsePackageIdentifierRevision :: Text -> Either PantryException PackageIdentifierRevision
parsePackageIdentifierRevision :: Text -> Either PantryException PackageIdentifierRevision
parsePackageIdentifierRevision Text
t = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> PantryException
PackageIdentifierRevisionParseFail Text
t) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ do
let (Text
identT, Text
cfiT) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
'@') Text
t
PackageIdentifier PackageName
name Version
version <- [Char] -> Maybe PackageIdentifier
parsePackageIdentifier forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
identT
CabalFileInfo
cfi <-
case Text -> Maybe (Text, Text)
splitColon Text
cfiT of
Just (Text
"@sha256", Text
shaSizeT) -> do
let (Text
shaT, Text
sizeT) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
',') Text
shaSizeT
SHA256
sha <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Either SHA256Exception SHA256
SHA256.fromHexText Text
shaT
Maybe FileSize
msize <-
case Text -> Text -> Maybe Text
T.stripPrefix Text
"," Text
sizeT of
Maybe Text
Nothing -> forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
Just Text
sizeT' ->
case forall a. Integral a => Reader a
decimal Text
sizeT' of
Right (Word
size', Text
"") -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word -> FileSize
FileSize Word
size'
Either [Char] (Word, Text)
_ -> forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SHA256 -> Maybe FileSize -> CabalFileInfo
CFIHash SHA256
sha Maybe FileSize
msize
Just (Text
"@rev", Text
revT) ->
case forall a. Integral a => Reader a
decimal Text
revT of
Right (Word
rev, Text
"") -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Revision -> CabalFileInfo
CFIRevision forall a b. (a -> b) -> a -> b
$ Word -> Revision
Revision Word
rev
Either [Char] (Word, Text)
_ -> forall a. Maybe a
Nothing
Maybe (Text, Text)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CabalFileInfo
CFILatest
Maybe (Text, Text)
_ -> forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PackageName
-> Version -> CabalFileInfo -> PackageIdentifierRevision
PackageIdentifierRevision PackageName
name Version
version CabalFileInfo
cfi
data Mismatch a = Mismatch
{ forall a. Mismatch a -> a
mismatchExpected :: !a
, forall a. Mismatch a -> a
mismatchActual :: !a
}
data PantryException
= PackageIdentifierRevisionParseFail !Text
| InvalidCabalFile
!(Either RawPackageLocationImmutable (Path Abs File))
!(Maybe Version)
![PError]
![PWarning]
| TreeWithoutCabalFile !RawPackageLocationImmutable
| TreeWithMultipleCabalFiles !RawPackageLocationImmutable ![SafeFilePath]
| MismatchedCabalName !(Path Abs File) !PackageName
| NoLocalPackageDirFound !(Path Abs Dir)
| NoCabalFileFound !(Path Abs Dir)
| MultipleCabalFilesFound !(Path Abs Dir) ![Path Abs File]
| InvalidWantedCompiler !Text
| InvalidSnapshotLocation !(Path Abs Dir) !Text
| InvalidOverrideCompiler !WantedCompiler !WantedCompiler
| InvalidFilePathSnapshot !Text
| InvalidSnapshot !RawSnapshotLocation !SomeException
| MismatchedPackageMetadata
!RawPackageLocationImmutable
!RawPackageMetadata
!(Maybe TreeKey)
!PackageIdentifier
| Non200ResponseStatus !Status
| InvalidBlobKey !(Mismatch BlobKey)
| Couldn'tParseSnapshot !RawSnapshotLocation !String
| WrongCabalFileName !RawPackageLocationImmutable !SafeFilePath !PackageName
| DownloadInvalidSHA256 !Text !(Mismatch SHA256)
| DownloadInvalidSize !Text !(Mismatch FileSize)
| DownloadTooLarge !Text !(Mismatch FileSize)
| LocalInvalidSHA256 !(Path Abs File) !(Mismatch SHA256)
| LocalInvalidSize !(Path Abs File) !(Mismatch FileSize)
| UnknownArchiveType !ArchiveLocation
| InvalidTarFileType !ArchiveLocation !FilePath !Tar.FileType
| UnsupportedTarball !ArchiveLocation !Text
| NoHackageCryptographicHash !PackageIdentifier
| FailedToCloneRepo !SimpleRepo
| TreeReferencesMissingBlob !RawPackageLocationImmutable !SafeFilePath !BlobKey
| CompletePackageMetadataMismatch !RawPackageLocationImmutable !PackageMetadata
| CRC32Mismatch !ArchiveLocation !FilePath !(Mismatch Word32)
| UnknownHackagePackage !PackageIdentifierRevision !FuzzyResults
| CannotCompleteRepoNonSHA1 !Repo
| MutablePackageLocationFromUrl !Text
| MismatchedCabalFileForHackage !PackageIdentifierRevision !(Mismatch PackageIdentifier)
| PackageNameParseFail !Text
| PackageVersionParseFail !Text
| InvalidCabalFilePath !(Path Abs File)
| DuplicatePackageNames !Utf8Builder ![(PackageName, [RawPackageLocationImmutable])]
| MigrationFailure !Text !(Path Abs File) !SomeException
| InvalidTreeFromCasa !BlobKey !ByteString
| ParseSnapNameException !Text
| HpackLibraryException !(Path Abs File) !String
| HpackExeException !FilePath !(Path Abs Dir) !SomeException
deriving Typeable
instance Exception PantryException where
instance Show PantryException where
show :: PantryException -> [Char]
show = Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display
instance Display PantryException where
display :: PantryException -> Utf8Builder
display (InvalidTreeFromCasa BlobKey
blobKey ByteString
_bs) =
Utf8Builder
"Error: [S-258]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Invalid tree from casa: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display BlobKey
blobKey
display (PackageIdentifierRevisionParseFail Text
text) =
Utf8Builder
"Error: [S-360]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Invalid package identifier (with optional revision): "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
text
display (InvalidCabalFile Either RawPackageLocationImmutable (Path Abs File)
loc Maybe Version
mversion [PError]
errs [PWarning]
warnings) =
Utf8Builder
"Error: [S-242]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Unable to parse cabal file from package "
forall a. Semigroup a => a -> a -> a
<> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Display a => a -> Utf8Builder
display (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> [Char]
toFilePath) Either RawPackageLocationImmutable (Path Abs File)
loc
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\n\n"
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
( \(PError Position
pos [Char]
msg) ->
Utf8Builder
"- "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (Position -> [Char]
showPos Position
pos)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
msg
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\n"
)
[PError]
errs
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
( \(PWarning PWarnType
_ Position
pos [Char]
msg) ->
Utf8Builder
"- "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (Position -> [Char]
showPos Position
pos)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
msg
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\n"
)
[PWarning]
warnings
forall a. Semigroup a => a -> a -> a
<> ( case Maybe Version
mversion of
Just Version
version
| Version
version forall a. Ord a => a -> a -> Bool
> Version
cabalSpecLatestVersion ->
Utf8Builder
"\n\nThe cabal file uses the cabal specification version "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
version)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", but we only support up to version "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
cabalSpecLatestVersion)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
".\nRecommended action: upgrade your build tool (e.g., `stack upgrade`)."
Maybe Version
_ -> forall a. Monoid a => a
mempty
)
display (TreeWithoutCabalFile RawPackageLocationImmutable
pl) =
Utf8Builder
"Error: [S-654]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"No cabal file found for "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
pl
display (TreeWithMultipleCabalFiles RawPackageLocationImmutable
pl [SafeFilePath]
sfps) =
Utf8Builder
"Error: [S-500]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Multiple cabal files found for "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
pl
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Display a => a -> Utf8Builder
display [SafeFilePath]
sfps))
display (MismatchedCabalName Path Abs File
fp PackageName
name) =
Utf8Builder
"Error: [S-910]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"The Cabal file:\n"
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs File
fp)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nis not named after the package that it defines.\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Please rename the file to: "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
packageNameString PackageName
name)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
".cabal\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Hackage rejects packages where the first part of the Cabal file name "
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"is not the package name."
display (NoLocalPackageDirFound Path Abs Dir
dir) =
Utf8Builder
"Error: [S-395]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Stack looks for packages in the directories configured in\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"the 'packages' and 'extra-deps' fields defined in your stack.yaml\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"The current entry points to "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
dir)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
",\nbut no such directory could be found. If, alternatively, a package\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"in the package index was intended, its name and version must be\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"specified as an extra-dep."
display (NoCabalFileFound Path Abs Dir
dir) =
Utf8Builder
"Error: [S-636]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Stack looks for packages in the directories configured in\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"the 'packages' and 'extra-deps' fields defined in your stack.yaml\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"The current entry points to "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
dir)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
",\nbut no .cabal or package.yaml file could be found there."
display (MultipleCabalFilesFound Path Abs Dir
dir [Path Abs File]
files) =
Utf8Builder
"Error: [S-368]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Multiple .cabal files found in directory "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
dir)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
":\n"
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
( forall a. a -> [a] -> [a]
intersperse
Utf8Builder
"\n"
(forall a b. (a -> b) -> [a] -> [b]
map (\Path Abs File
x -> Utf8Builder
"- " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath (forall b. Path b File -> Path Rel File
filename Path Abs File
x))) [Path Abs File]
files)
)
display (InvalidWantedCompiler Text
t) =
Utf8Builder
"Error: [S-204]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Invalid wanted compiler: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
t
display (InvalidSnapshotLocation Path Abs Dir
dir Text
t) =
Utf8Builder
"Error: [S-935]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Invalid snapshot location "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow Text
t
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" relative to directory "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow (forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
dir)
display (InvalidOverrideCompiler WantedCompiler
x WantedCompiler
y) =
Utf8Builder
"Error: [S-287]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Specified compiler for a resolver ("
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display WantedCompiler
x
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"), but also specified an override compiler ("
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display WantedCompiler
y
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
")"
display (InvalidFilePathSnapshot Text
t) =
Utf8Builder
"Error: [S-617]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Specified snapshot as file path with "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow Text
t
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", but not reading from a local file"
display (InvalidSnapshot RawSnapshotLocation
loc SomeException
err) =
Utf8Builder
"Error: [S-775]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Exception while reading snapshot from "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawSnapshotLocation
loc
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
":\n"
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow SomeException
err
display (MismatchedPackageMetadata RawPackageLocationImmutable
loc RawPackageMetadata
pm Maybe TreeKey
mtreeKey PackageIdentifier
foundIdent) =
Utf8Builder
"Error: [S-427]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Mismatched package metadata for "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nFound: "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
foundIdent)
forall a. Semigroup a => a -> a -> a
<> ( case Maybe TreeKey
mtreeKey of
Maybe TreeKey
Nothing -> forall a. Monoid a => a
mempty
Just TreeKey
treeKey -> Utf8Builder
" with tree " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display TreeKey
treeKey
)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nExpected: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawPackageMetadata
pm
display (Non200ResponseStatus Status
status) =
Utf8Builder
"Error: [S-571]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Unexpected non-200 HTTP status code: "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow (Status -> Int
statusCode Status
status)
display (InvalidBlobKey Mismatch{BlobKey
mismatchActual :: BlobKey
mismatchExpected :: BlobKey
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
Utf8Builder
"Error: [S-236]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Invalid blob key found, expected: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display BlobKey
mismatchExpected
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", actual: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display BlobKey
mismatchActual
display (Couldn'tParseSnapshot RawSnapshotLocation
sl [Char]
err) =
Utf8Builder
"Error: [S-645]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Couldn't parse snapshot from "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawSnapshotLocation
sl
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
err
display (WrongCabalFileName RawPackageLocationImmutable
pl SafeFilePath
sfp PackageName
name) =
Utf8Builder
"Error: [S-575]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Wrong cabal file name for package "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
pl
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nThe cabal file is named "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display SafeFilePath
sfp
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", but package name is "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
packageNameString PackageName
name)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nFor more information, see:\n - https://github.com/commercialhaskell/stack/issues/317\n -https://github.com/commercialhaskell/stack/issues/895"
display (DownloadInvalidSHA256 Text
url Mismatch {SHA256
mismatchActual :: SHA256
mismatchExpected :: SHA256
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
Utf8Builder
"Error: [S-394]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Mismatched SHA256 hash from "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
url
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nExpected: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display SHA256
mismatchExpected
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nActual: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display SHA256
mismatchActual
display (DownloadInvalidSize Text
url Mismatch {FileSize
mismatchActual :: FileSize
mismatchExpected :: FileSize
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
Utf8Builder
"Error: [S-401]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Mismatched download size from "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
url
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nExpected: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display FileSize
mismatchExpected
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nActual: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display FileSize
mismatchActual
display (DownloadTooLarge Text
url Mismatch {FileSize
mismatchActual :: FileSize
mismatchExpected :: FileSize
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
Utf8Builder
"Error: [S-113]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Download from "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
url
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" was too large.\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Expected: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display FileSize
mismatchExpected
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", stopped after receiving: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display FileSize
mismatchActual
display (LocalInvalidSHA256 Path Abs File
path Mismatch {SHA256
mismatchActual :: SHA256
mismatchExpected :: SHA256
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
Utf8Builder
"Error: [S-834]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Mismatched SHA256 hash from "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs File
path)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nExpected: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display SHA256
mismatchExpected
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nActual: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display SHA256
mismatchActual
display (LocalInvalidSize Path Abs File
path Mismatch {FileSize
mismatchActual :: FileSize
mismatchExpected :: FileSize
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
Utf8Builder
"Error: [S-713]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Mismatched file size from "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs File
path)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nExpected: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display FileSize
mismatchExpected
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nActual: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display FileSize
mismatchActual
display (UnknownArchiveType ArchiveLocation
loc) =
Utf8Builder
"Error: [S-372]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Unable to determine archive type of: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display ArchiveLocation
loc
display (InvalidTarFileType ArchiveLocation
loc [Char]
fp FileType
x) =
Utf8Builder
"Error: [S-950]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Unsupported tar file type in archive "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display ArchiveLocation
loc
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" at file "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
fp
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow FileType
x
display (UnsupportedTarball ArchiveLocation
loc Text
err) =
Utf8Builder
"Error: [S-760]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Unsupported tarball from "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display ArchiveLocation
loc
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
err
display (NoHackageCryptographicHash PackageIdentifier
ident) =
Utf8Builder
"Error: [S-922]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"No cryptographic hash found for Hackage package "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
ident)
display (FailedToCloneRepo SimpleRepo
repo) =
Utf8Builder
"Error: [S-109]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Failed to clone repo "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display SimpleRepo
repo
display (TreeReferencesMissingBlob RawPackageLocationImmutable
loc SafeFilePath
sfp BlobKey
key) =
Utf8Builder
"Error: [S-237]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"The package "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" needs blob "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display BlobKey
key
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" for file path "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display SafeFilePath
sfp
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", but the blob is not available"
display (CompletePackageMetadataMismatch RawPackageLocationImmutable
loc PackageMetadata
pm) =
Utf8Builder
"Error: [S-984]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"When completing package metadata for "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", some values changed in the new package metadata: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display PackageMetadata
pm
display (CRC32Mismatch ArchiveLocation
loc [Char]
fp Mismatch {Word32
mismatchActual :: Word32
mismatchExpected :: Word32
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
Utf8Builder
"Error: [S-607]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"CRC32 mismatch in ZIP file from "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display ArchiveLocation
loc
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" on internal file "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
fp
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nExpected: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Word32
mismatchExpected
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nActual: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Word32
mismatchActual
display (UnknownHackagePackage PackageIdentifierRevision
pir FuzzyResults
fuzzy) =
Utf8Builder
"Error: [S-476]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Could not find "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" on Hackage"
forall a. Semigroup a => a -> a -> a
<> FuzzyResults -> Utf8Builder
displayFuzzy FuzzyResults
fuzzy
display (CannotCompleteRepoNonSHA1 Repo
repo) =
Utf8Builder
"Error: [S-112]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Cannot complete repo information for a non SHA1 commit due to non-reproducibility: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Repo
repo
display (MutablePackageLocationFromUrl Text
t) =
Utf8Builder
"Error: [S-321]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Cannot refer to a mutable package location from a URL: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
t
display (MismatchedCabalFileForHackage PackageIdentifierRevision
pir Mismatch{PackageIdentifier
mismatchActual :: PackageIdentifier
mismatchExpected :: PackageIdentifier
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
Utf8Builder
"Error: [S-377]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"When processing cabal file for Hackage package "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
":\nMismatched package identifier."
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nExpected: "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
mismatchExpected)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nActual: "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
mismatchActual)
display (PackageNameParseFail Text
t) =
Utf8Builder
"Error: [S-580]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Invalid package name: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
t
display (PackageVersionParseFail Text
t) =
Utf8Builder
"Error: [S-479]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Invalid version: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
t
display (InvalidCabalFilePath Path Abs File
fp) =
Utf8Builder
"Error: [S-824]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"File path contains a name which is not a valid package name: "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs File
fp)
display (DuplicatePackageNames Utf8Builder
source [(PackageName, [RawPackageLocationImmutable])]
pairs') =
Utf8Builder
"Error: [S-674]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Duplicate package names ("
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
source
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"):\n"
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
( \(PackageName
name, [RawPackageLocationImmutable]
locs) ->
forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
packageNameString PackageName
name)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
":\n"
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\RawPackageLocationImmutable
loc -> Utf8Builder
"- " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\n") [RawPackageLocationImmutable]
locs
)
[(PackageName, [RawPackageLocationImmutable])]
pairs'
display (MigrationFailure Text
desc Path Abs File
fp SomeException
err) =
Utf8Builder
"Error: [S-536]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Encountered error while migrating database "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
desc
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nlocated at "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs File
fp)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
":"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\n "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow SomeException
err
display (ParseSnapNameException Text
t) =
Utf8Builder
"Error: [S-994]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Invalid snapshot name: "
forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
t
display (HpackLibraryException Path Abs File
file [Char]
err) =
Utf8Builder
"Error: [S-305]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Failed to generate a Cabal file using the Hpack library on file:\n"
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs File
file)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\n\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"The error encountered was:\n\n"
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
err
display (HpackExeException [Char]
fp Path Abs Dir
dir SomeException
err) =
Utf8Builder
"Error: [S-720]\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Failed to generate a Cabal file using the Hpack executable:\n"
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
fp
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"in directory: "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
dir)
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\n\n"
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"The error encountered was:\n\n"
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall a. Show a => a -> [Char]
show SomeException
err)
instance Pretty PantryException where
pretty :: PantryException -> StyleDoc
pretty (InvalidTreeFromCasa BlobKey
blobKey ByteString
_bs) =
StyleDoc
"[S-258]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Invalid tree from casa:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay BlobKey
blobKey
]
pretty (PackageIdentifierRevisionParseFail Text
text) =
StyleDoc
"[S-360]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Invalid package identifier (with optional revision):"
, forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
text
]
pretty (InvalidCabalFile Either RawPackageLocationImmutable (Path Abs File)
loc Maybe Version
mversion [PError]
errs [PWarning]
warnings) =
StyleDoc
"[S-242]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Unable to parse Cabal file from package"
, forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Pretty a => a -> StyleDoc
pretty forall a. Pretty a => a -> StyleDoc
pretty Either RawPackageLocationImmutable (Path Abs File)
loc forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList
( forall a b. (a -> b) -> [a] -> [b]
map (\(PError Position
pos [Char]
msg) -> [StyleDoc] -> StyleDoc
fillSep
[ forall a. IsString a => [Char] -> a
fromString (Position -> [Char]
showPos Position
pos) forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
, forall a. IsString a => [Char] -> a
fromString [Char]
msg
])
[PError]
errs
)
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList
( forall a b. (a -> b) -> [a] -> [b]
map (\(PWarning PWarnType
_ Position
pos [Char]
msg) -> [StyleDoc] -> StyleDoc
fillSep
[ forall a. IsString a => [Char] -> a
fromString (Position -> [Char]
showPos Position
pos) forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
, forall a. IsString a => [Char] -> a
fromString [Char]
msg
])
[PWarning]
warnings
)
forall a. Semigroup a => a -> a -> a
<> ( case Maybe Version
mversion of
Just Version
version | Version
version forall a. Ord a => a -> a -> Bool
> Version
cabalSpecLatestVersion ->
StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"The Cabal file uses the Cabal specification version"
, Style -> StyleDoc -> StyleDoc
style Style
Current (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Version -> [Char]
versionString Version
version) forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, [Char] -> StyleDoc
flow [Char]
"but we only support up to version"
, forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
cabalSpecLatestVersion) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
, [Char] -> StyleDoc
flow [Char]
"Recommended action: upgrade your build tool"
, StyleDoc -> StyleDoc
parens ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"e.g."
, Style -> StyleDoc -> StyleDoc
style Style
Shell ([Char] -> StyleDoc
flow [Char]
"stack upgrade")
]) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
Maybe Version
_ -> forall a. Monoid a => a
mempty
)
pretty (TreeWithoutCabalFile RawPackageLocationImmutable
loc) =
StyleDoc
"[S-654]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"No Cabal file found for"
, forall a. Pretty a => a -> StyleDoc
pretty RawPackageLocationImmutable
loc forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
pretty (TreeWithMultipleCabalFiles RawPackageLocationImmutable
loc [SafeFilePath]
sfps) =
StyleDoc
"[S-500]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
( [Char] -> StyleDoc
flow [Char]
"Multiple Cabal files found for"
forall a. a -> [a] -> [a]
: (forall a. Pretty a => a -> StyleDoc
pretty RawPackageLocationImmutable
loc forall a. Semigroup a => a -> a -> a
<> StyleDoc
":")
forall a. a -> [a] -> [a]
: forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList (forall a. a -> Maybe a
Just Style
File) Bool
False
(forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Text
textDisplay) [SafeFilePath]
sfps :: [StyleDoc])
)
pretty (MismatchedCabalName Path Abs File
fp PackageName
name) =
StyleDoc
"[S-910]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"The Cabal file"
, forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
fp
, [Char] -> StyleDoc
flow [Char]
"is not named after the package that it defines. Please rename"
, [Char] -> StyleDoc
flow [Char]
"the file to"
, Style -> StyleDoc -> StyleDoc
style Style
File (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ PackageName -> [Char]
packageNameString PackageName
name forall a. Semigroup a => a -> a -> a
<> [Char]
".cabal") forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
, [Char] -> StyleDoc
flow [Char]
"Hackage rejects packages where the first part of the Cabal"
, [Char] -> StyleDoc
flow [Char]
"file name is not the package name."
]
pretty (NoLocalPackageDirFound Path Abs Dir
dir) =
StyleDoc
"[S-395]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Stack looks for packages in the directories configured in the"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"packages"
, StyleDoc
"and"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"extra-deps"
, [Char] -> StyleDoc
flow [Char]
"fields defined in your"
, Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"stack.yaml" forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
, [Char] -> StyleDoc
flow [Char]
"The current entry points to"
, forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
dir
, [Char] -> StyleDoc
flow [Char]
"but no such directory could be found. If, alternatively, a"
, [Char] -> StyleDoc
flow [Char]
"package in the package index was intended, its name and"
, [Char] -> StyleDoc
flow [Char]
"version must be specified as an extra-dep."
]
pretty (NoCabalFileFound Path Abs Dir
dir) =
StyleDoc
"[S-636]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Stack looks for packages in the directories configured in the"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"packages"
, StyleDoc
"and"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"extra-deps"
, [Char] -> StyleDoc
flow [Char]
"fields defined in your"
, Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"stack.yaml" forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
, [Char] -> StyleDoc
flow [Char]
"The current entry points to"
, forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
dir
, [Char] -> StyleDoc
flow [Char]
"but no Cabal file or"
, Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"package.yaml"
, [Char] -> StyleDoc
flow [Char]
"could be found there."
]
pretty (MultipleCabalFilesFound Path Abs Dir
dir [Path Abs File]
files) =
StyleDoc
"[S-368]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
( [Char] -> StyleDoc
flow [Char]
"Multiple Cabal files found in directory"
forall a. a -> [a] -> [a]
: (forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
dir forall a. Semigroup a => a -> a -> a
<> StyleDoc
":")
forall a. a -> [a] -> [a]
: forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList (forall a. a -> Maybe a
Just Style
File) Bool
False
(forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> StyleDoc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Path b File -> Path Rel File
filename) [Path Abs File]
files)
)
pretty (InvalidWantedCompiler Text
t) =
StyleDoc
"[S-204]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Invalid wanted compiler:"
, Style -> StyleDoc -> StyleDoc
style Style
Current (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
pretty (InvalidSnapshotLocation Path Abs Dir
dir Text
t) =
StyleDoc
"[S-935]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Invalid snapshot location"
, Style -> StyleDoc -> StyleDoc
style Style
Current (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t)
, [Char] -> StyleDoc
flow [Char]
"relative to directory"
, forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
dir forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
pretty (InvalidOverrideCompiler WantedCompiler
x WantedCompiler
y) =
StyleDoc
"[S-287]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Specified compiler for a resolver"
, StyleDoc -> StyleDoc
parens (Style -> StyleDoc -> StyleDoc
style Style
Shell (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay WantedCompiler
x))
, [Char] -> StyleDoc
flow [Char]
"but also specified an override compiler"
, StyleDoc -> StyleDoc
parens (Style -> StyleDoc -> StyleDoc
style Style
Shell (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay WantedCompiler
y)) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
pretty (InvalidFilePathSnapshot Text
t) =
StyleDoc
"[S-617]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Specified snapshot as file path with"
, Style -> StyleDoc -> StyleDoc
style Style
File (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t) forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, [Char] -> StyleDoc
flow [Char]
"but not reading from a local file."
]
pretty (InvalidSnapshot RawSnapshotLocation
loc SomeException
err) =
StyleDoc
"[S-775]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Exception while reading snapshot from"
, forall a. Pretty a => a -> StyleDoc
pretty RawSnapshotLocation
loc forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string (forall e. Exception e => e -> [Char]
displayException SomeException
err)
pretty (MismatchedPackageMetadata RawPackageLocationImmutable
loc RawPackageMetadata
pm Maybe TreeKey
mtreeKey PackageIdentifier
foundIdent) =
StyleDoc
"[S-427]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Mismatched package metadata for"
, forall a. Pretty a => a -> StyleDoc
pretty RawPackageLocationImmutable
loc forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Expected:"
, let t :: Text
t = forall a. Display a => a -> Text
textDisplay RawPackageMetadata
pm
in if Text -> Bool
T.null Text
t
then StyleDoc
"nothing."
else forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t forall a. Semigroup a => a -> a -> a
<> [Char]
"."
])
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Found: "
, forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
foundIdent forall a. Semigroup a => a -> a -> a
<> case Maybe TreeKey
mtreeKey of
Maybe TreeKey
Nothing -> [Char]
"."
Maybe TreeKey
_ -> forall a. Monoid a => a
mempty
, case Maybe TreeKey
mtreeKey of
Maybe TreeKey
Nothing -> forall a. Monoid a => a
mempty
Just TreeKey
treeKey -> [StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"with tree"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay TreeKey
treeKey forall a. Semigroup a => a -> a -> a
<> Text
"."
]
])
pretty (Non200ResponseStatus Status
status) =
StyleDoc
"[S-571]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Unexpected non-200 HTTP status code:"
, (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ Status -> Int
statusCode Status
status) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
pretty (InvalidBlobKey Mismatch{BlobKey
mismatchActual :: BlobKey
mismatchExpected :: BlobKey
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
StyleDoc
"[S-236]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Invalid blob key found, expected:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay BlobKey
mismatchExpected forall a. Semigroup a => a -> a -> a
<> Text
","
, StyleDoc
"actual:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay BlobKey
mismatchActual forall a. Semigroup a => a -> a -> a
<> Text
"."
]
pretty (Couldn'tParseSnapshot RawSnapshotLocation
sl [Char]
err) =
StyleDoc
"[S-645]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Couldn't parse snapshot from"
, forall a. Pretty a => a -> StyleDoc
pretty RawSnapshotLocation
sl forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string [Char]
err
pretty (WrongCabalFileName RawPackageLocationImmutable
loc SafeFilePath
sfp PackageName
name) =
StyleDoc
"[S-575]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Wrong Cabal file name for package"
, forall a. Pretty a => a -> StyleDoc
pretty RawPackageLocationImmutable
loc forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
, [Char] -> StyleDoc
flow [Char]
"The Cabal file is named"
, Style -> StyleDoc -> StyleDoc
style Style
File (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay SafeFilePath
sfp) forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, [Char] -> StyleDoc
flow [Char]
"but package name is"
, forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
packageNameString PackageName
name) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
, [Char] -> StyleDoc
flow [Char]
"For more information, see"
, Style -> StyleDoc -> StyleDoc
style Style
Url StyleDoc
"https://github.com/commercialhaskell/stack/issues/317"
, StyleDoc
"and"
, Style -> StyleDoc -> StyleDoc
style Style
Url StyleDoc
"https://github.com/commercialhaskell/stack/issues/895" forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
pretty (DownloadInvalidSHA256 Text
url Mismatch {SHA256
mismatchActual :: SHA256
mismatchExpected :: SHA256
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
StyleDoc
"[S-394]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Mismatched SHA256 hash from"
, Style -> StyleDoc -> StyleDoc
style Style
Url (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Expected:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay SHA256
mismatchExpected forall a. Semigroup a => a -> a -> a
<> Text
"."
])
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Actual: "
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay SHA256
mismatchActual forall a. Semigroup a => a -> a -> a
<> Text
"."
])
pretty (DownloadInvalidSize Text
url Mismatch {FileSize
mismatchActual :: FileSize
mismatchExpected :: FileSize
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
StyleDoc
"[S-401]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Mismatched download size from"
, Style -> StyleDoc -> StyleDoc
style Style
Url (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Expected:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay FileSize
mismatchExpected forall a. Semigroup a => a -> a -> a
<> Text
"."
])
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Actual: "
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay FileSize
mismatchActual forall a. Semigroup a => a -> a -> a
<> Text
"."
])
pretty (DownloadTooLarge Text
url Mismatch {FileSize
mismatchActual :: FileSize
mismatchExpected :: FileSize
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
StyleDoc
"[S-113]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Download from"
, Style -> StyleDoc -> StyleDoc
style Style
Url (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url)
, [Char] -> StyleDoc
flow [Char]
"was too large. Expected:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay FileSize
mismatchExpected forall a. Semigroup a => a -> a -> a
<> Text
","
, [Char] -> StyleDoc
flow [Char]
"stopped after receiving:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay FileSize
mismatchActual forall a. Semigroup a => a -> a -> a
<> Text
"."
]
pretty (LocalInvalidSHA256 Path Abs File
path Mismatch {SHA256
mismatchActual :: SHA256
mismatchExpected :: SHA256
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
StyleDoc
"[S-834]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Mismatched SHA256 hash from"
, forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
path forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Expected:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay SHA256
mismatchExpected forall a. Semigroup a => a -> a -> a
<> Text
"."
])
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Actual: "
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay SHA256
mismatchActual forall a. Semigroup a => a -> a -> a
<> Text
"."
])
pretty (LocalInvalidSize Path Abs File
path Mismatch {FileSize
mismatchActual :: FileSize
mismatchExpected :: FileSize
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
StyleDoc
"[S-713]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Mismatched file size from"
, forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
path forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Expected:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay FileSize
mismatchExpected forall a. Semigroup a => a -> a -> a
<> Text
"."
])
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Actual: "
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay FileSize
mismatchActual forall a. Semigroup a => a -> a -> a
<> Text
"."
])
pretty (UnknownArchiveType ArchiveLocation
loc) =
StyleDoc
"[S-372]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Unable to determine archive type of:"
, forall a. Pretty a => a -> StyleDoc
pretty ArchiveLocation
loc forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
pretty (InvalidTarFileType ArchiveLocation
loc [Char]
fp FileType
x) =
StyleDoc
"[S-950]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Unsupported tar file type in archive"
, forall a. Pretty a => a -> StyleDoc
pretty ArchiveLocation
loc
, [Char] -> StyleDoc
flow [Char]
"at file"
, Style -> StyleDoc -> StyleDoc
style Style
File (forall a. IsString a => [Char] -> a
fromString [Char]
fp) forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
, forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show FileType
x forall a. Semigroup a => a -> a -> a
<> [Char]
"."
]
pretty (UnsupportedTarball ArchiveLocation
loc Text
err) =
StyleDoc
"[S-760]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Unsupported tarball from"
, forall a. Pretty a => a -> StyleDoc
pretty ArchiveLocation
loc forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string (Text -> [Char]
T.unpack Text
err)
pretty (NoHackageCryptographicHash PackageIdentifier
ident) =
StyleDoc
"[S-922]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"No cryptographic hash found for Hackage package"
, forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
ident) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
pretty (FailedToCloneRepo SimpleRepo
repo) =
StyleDoc
"[S-109]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Failed to clone repository"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay SimpleRepo
repo
]
pretty (TreeReferencesMissingBlob RawPackageLocationImmutable
loc SafeFilePath
sfp BlobKey
key) =
StyleDoc
"[S-237]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"The package"
, forall a. Pretty a => a -> StyleDoc
pretty RawPackageLocationImmutable
loc
, [Char] -> StyleDoc
flow [Char]
"needs blob"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay BlobKey
key
, [Char] -> StyleDoc
flow [Char]
"for file path"
, Style -> StyleDoc -> StyleDoc
style Style
File (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay SafeFilePath
sfp) forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, [Char] -> StyleDoc
flow [Char]
"but the blob is not available."
]
pretty (CompletePackageMetadataMismatch RawPackageLocationImmutable
loc PackageMetadata
pm) =
StyleDoc
"[S-984]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"When completing package metadata for"
, forall a. Pretty a => a -> StyleDoc
pretty RawPackageLocationImmutable
loc forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, [Char] -> StyleDoc
flow [Char]
"some values changed in the new package metadata:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay PackageMetadata
pm forall a. Semigroup a => a -> a -> a
<> Text
"."
]
pretty (CRC32Mismatch ArchiveLocation
loc [Char]
fp Mismatch {Word32
mismatchActual :: Word32
mismatchExpected :: Word32
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
StyleDoc
"[S-607]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"CRC32 mismatch in Zip file from"
, forall a. Pretty a => a -> StyleDoc
pretty ArchiveLocation
loc
, [Char] -> StyleDoc
flow [Char]
"on internal file"
, Style -> StyleDoc -> StyleDoc
style Style
File (forall a. IsString a => [Char] -> a
fromString [Char]
fp)
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Expected:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay Word32
mismatchExpected forall a. Semigroup a => a -> a -> a
<> Text
"."
])
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Actual: "
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay Word32
mismatchActual forall a. Semigroup a => a -> a -> a
<> Text
"."
])
pretty (UnknownHackagePackage PackageIdentifierRevision
pir FuzzyResults
fuzzy) =
StyleDoc
"[S-476]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Could not find"
, Style -> StyleDoc -> StyleDoc
style Style
Error (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay PackageIdentifierRevision
pir)
, [Char] -> StyleDoc
flow [Char]
"on Hackage."
]
forall a. Semigroup a => a -> a -> a
<> FuzzyResults -> StyleDoc
prettyFuzzy FuzzyResults
fuzzy
pretty (CannotCompleteRepoNonSHA1 Repo
repo) =
StyleDoc
"[S-112]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Cannot complete repo information for a non SHA1 commit due to"
, StyleDoc
"non-reproducibility:"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay Repo
repo forall a. Semigroup a => a -> a -> a
<> Text
"."
]
pretty (MutablePackageLocationFromUrl Text
t) =
StyleDoc
"[S-321]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Cannot refer to a mutable package location from a URL:"
, Style -> StyleDoc -> StyleDoc
style Style
Url (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
pretty (MismatchedCabalFileForHackage PackageIdentifierRevision
pir Mismatch{PackageIdentifier
mismatchActual :: PackageIdentifier
mismatchExpected :: PackageIdentifier
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
StyleDoc
"[S-377]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"When processing Cabal file for Hackage package"
, forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay PackageIdentifierRevision
pir forall a. Semigroup a => a -> a -> a
<> Text
","
, [Char] -> StyleDoc
flow [Char]
"mismatched package identifier."
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Expected:"
, forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
mismatchExpected) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
])
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
[ StyleDoc
"Actual: "
, forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
mismatchActual) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
])
pretty (PackageNameParseFail Text
t) =
StyleDoc
"[S-580]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Invalid package name:"
, forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t forall a. Semigroup a => a -> a -> a
<> [Char]
"."
]
pretty (PackageVersionParseFail Text
t) =
StyleDoc
"[S-479]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Invalid version:"
, forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t forall a. Semigroup a => a -> a -> a
<> [Char]
"."
]
pretty (InvalidCabalFilePath Path Abs File
fp) =
StyleDoc
"[S-824]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"File path contains a name which is not a valid package name:"
, forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
fp forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
pretty (DuplicatePackageNames Utf8Builder
source [(PackageName, [RawPackageLocationImmutable])]
pairs') =
StyleDoc
"[S-674]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Duplicate package names"
, StyleDoc -> StyleDoc
parens (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay Utf8Builder
source) forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
( \(PackageName
name, [RawPackageLocationImmutable]
locs) ->
forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
packageNameString PackageName
name) forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> StyleDoc
pretty [RawPackageLocationImmutable]
locs)
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
)
[(PackageName, [RawPackageLocationImmutable])]
pairs'
pretty (MigrationFailure Text
desc Path Abs File
fp SomeException
err) =
StyleDoc
"[S-536]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Encountered error while migrating database"
, forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
desc
, [Char] -> StyleDoc
flow [Char]
"located at"
, forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
fp forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string (forall e. Exception e => e -> [Char]
displayException SomeException
err)
pretty (ParseSnapNameException Text
t) =
StyleDoc
"[S-994]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Invalid snapshot name:"
, forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t forall a. Semigroup a => a -> a -> a
<> [Char]
"."
]
pretty (HpackLibraryException Path Abs File
file [Char]
err) =
StyleDoc
"[S-305]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Failed to generate a Cabal file using the Hpack library on"
, StyleDoc
"file:"
, forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
file forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
, [Char] -> StyleDoc
flow [Char]
"The error encountered was:"
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string [Char]
err
pretty (HpackExeException [Char]
fp Path Abs Dir
dir SomeException
err) =
StyleDoc
"[S-720]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ [Char] -> StyleDoc
flow [Char]
"Failed to generate a Cabal file using the Hpack executable:"
, Style -> StyleDoc -> StyleDoc
style Style
File (forall a. IsString a => [Char] -> a
fromString [Char]
fp)
, [Char] -> StyleDoc
flow [Char]
"in directory:"
, forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
dir forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
, [Char] -> StyleDoc
flow [Char]
"The error encountered was:"
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string (forall e. Exception e => e -> [Char]
displayException SomeException
err)
blankLine :: StyleDoc
blankLine :: StyleDoc
blankLine = StyleDoc
line forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
data FuzzyResults
= FRNameNotFound ![PackageName]
| FRVersionNotFound !(NonEmpty PackageIdentifierRevision)
| FRRevisionNotFound !(NonEmpty PackageIdentifierRevision)
displayFuzzy :: FuzzyResults -> Utf8Builder
displayFuzzy :: FuzzyResults -> Utf8Builder
displayFuzzy (FRNameNotFound [PackageName]
names) =
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [PackageName]
names of
Maybe (NonEmpty PackageName)
Nothing -> Utf8Builder
""
Just NonEmpty PackageName
names' ->
Utf8Builder
"\nPerhaps you meant " forall a. Semigroup a => a -> a -> a
<>
NonEmpty Utf8Builder -> Utf8Builder
orSeparated (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> [Char]
packageNameString) NonEmpty PackageName
names') forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"?"
displayFuzzy (FRVersionNotFound NonEmpty PackageIdentifierRevision
pirs) =
Utf8Builder
"\nPossible candidates: " forall a. Semigroup a => a -> a -> a
<>
NonEmpty Utf8Builder -> Utf8Builder
commaSeparated (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map forall a. Display a => a -> Utf8Builder
display NonEmpty PackageIdentifierRevision
pirs) forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"."
displayFuzzy (FRRevisionNotFound NonEmpty PackageIdentifierRevision
pirs) =
Utf8Builder
"\nThe specified revision was not found.\nPossible candidates: " forall a. Semigroup a => a -> a -> a
<>
NonEmpty Utf8Builder -> Utf8Builder
commaSeparated (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map forall a. Display a => a -> Utf8Builder
display NonEmpty PackageIdentifierRevision
pirs) forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"."
prettyFuzzy :: FuzzyResults -> StyleDoc
prettyFuzzy :: FuzzyResults -> StyleDoc
prettyFuzzy (FRNameNotFound [PackageName]
names) =
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [PackageName]
names of
Maybe (NonEmpty PackageName)
Nothing -> forall a. Monoid a => a
mempty
Just NonEmpty PackageName
names' ->
StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
( [Char] -> StyleDoc
flow [Char]
"Perhaps you meant one of"
forall a. a -> [a] -> [a]
: forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList forall a. Maybe a
Nothing Bool
False
(forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> [Char]
packageNameString) NonEmpty PackageName
names' :: [StyleDoc])
)
prettyFuzzy (FRVersionNotFound NonEmpty PackageIdentifierRevision
pirs) =
StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
( [Char] -> StyleDoc
flow [Char]
"Possible candidates:"
forall a. a -> [a] -> [a]
: forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList forall a. Maybe a
Nothing Bool
False
(forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Text
textDisplay) NonEmpty PackageIdentifierRevision
pirs :: [StyleDoc])
)
prettyFuzzy (FRRevisionNotFound NonEmpty PackageIdentifierRevision
pirs) =
StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
( [Char] -> StyleDoc
flow [Char]
"The specified revision was not found. Possible candidates:"
forall a. a -> [a] -> [a]
: forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList forall a. Maybe a
Nothing Bool
False
(forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Text
textDisplay) NonEmpty PackageIdentifierRevision
pirs :: [StyleDoc])
)
orSeparated :: NonEmpty Utf8Builder -> Utf8Builder
orSeparated :: NonEmpty Utf8Builder -> Utf8Builder
orSeparated NonEmpty Utf8Builder
xs
| forall a. NonEmpty a -> Int
NE.length NonEmpty Utf8Builder
xs forall a. Eq a => a -> a -> Bool
== Int
1 = forall a. NonEmpty a -> a
NE.head NonEmpty Utf8Builder
xs
| forall a. NonEmpty a -> Int
NE.length NonEmpty Utf8Builder
xs forall a. Eq a => a -> a -> Bool
== Int
2 = forall a. NonEmpty a -> a
NE.head NonEmpty Utf8Builder
xs forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" or " forall a. Semigroup a => a -> a -> a
<> forall a. NonEmpty a -> a
NE.last NonEmpty Utf8Builder
xs
| Bool
otherwise = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " (forall a. NonEmpty a -> [a]
NE.init NonEmpty Utf8Builder
xs)) forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", or " forall a. Semigroup a => a -> a -> a
<> forall a. NonEmpty a -> a
NE.last NonEmpty Utf8Builder
xs
commaSeparated :: NonEmpty Utf8Builder -> Utf8Builder
commaSeparated :: NonEmpty Utf8Builder -> Utf8Builder
commaSeparated = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse Utf8Builder
", "
cabalSpecLatestVersion :: Version
cabalSpecLatestVersion :: Version
cabalSpecLatestVersion = [Int] -> Version
mkVersion forall a b. (a -> b) -> a -> b
$ CabalSpecVersion -> [Int]
cabalSpecToVersionDigits CabalSpecVersion
cabalSpecLatest
#if !MIN_VERSION_Cabal(3,4,0)
cabalSpecToVersionDigits :: CabalSpecVersion -> [Int]
cabalSpecToVersionDigits CabalSpecV3_0 = [3,0]
cabalSpecToVersionDigits CabalSpecV2_4 = [2,4]
cabalSpecToVersionDigits CabalSpecV2_2 = [2,2]
cabalSpecToVersionDigits CabalSpecV2_0 = [2,0]
cabalSpecToVersionDigits CabalSpecV1_24 = [1,24]
cabalSpecToVersionDigits CabalSpecV1_22 = [1,22]
cabalSpecToVersionDigits CabalSpecV1_20 = [1,20]
cabalSpecToVersionDigits CabalSpecV1_18 = [1,18]
cabalSpecToVersionDigits CabalSpecV1_12 = [1,12]
cabalSpecToVersionDigits CabalSpecV1_10 = [1,10]
cabalSpecToVersionDigits CabalSpecV1_8 = [1,8]
cabalSpecToVersionDigits CabalSpecV1_6 = [1,6]
cabalSpecToVersionDigits CabalSpecV1_4 = [1,4]
cabalSpecToVersionDigits CabalSpecV1_2 = [1,2]
cabalSpecToVersionDigits CabalSpecV1_0 = [1,0]
#endif
data BuildFile = BFCabal !SafeFilePath !TreeEntry
| BFHpack !TreeEntry
deriving (Int -> BuildFile -> ShowS
[BuildFile] -> ShowS
BuildFile -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BuildFile] -> ShowS
$cshowList :: [BuildFile] -> ShowS
show :: BuildFile -> [Char]
$cshow :: BuildFile -> [Char]
showsPrec :: Int -> BuildFile -> ShowS
$cshowsPrec :: Int -> BuildFile -> ShowS
Show, BuildFile -> BuildFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildFile -> BuildFile -> Bool
$c/= :: BuildFile -> BuildFile -> Bool
== :: BuildFile -> BuildFile -> Bool
$c== :: BuildFile -> BuildFile -> Bool
Eq)
data FileType = FTNormal | FTExecutable
deriving (Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FileType] -> ShowS
$cshowList :: [FileType] -> ShowS
show :: FileType -> [Char]
$cshow :: FileType -> [Char]
showsPrec :: Int -> FileType -> ShowS
$cshowsPrec :: Int -> FileType -> ShowS
Show, FileType -> FileType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c== :: FileType -> FileType -> Bool
Eq, Int -> FileType
FileType -> Int
FileType -> [FileType]
FileType -> FileType
FileType -> FileType -> [FileType]
FileType -> FileType -> FileType -> [FileType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FileType -> FileType -> FileType -> [FileType]
$cenumFromThenTo :: FileType -> FileType -> FileType -> [FileType]
enumFromTo :: FileType -> FileType -> [FileType]
$cenumFromTo :: FileType -> FileType -> [FileType]
enumFromThen :: FileType -> FileType -> [FileType]
$cenumFromThen :: FileType -> FileType -> [FileType]
enumFrom :: FileType -> [FileType]
$cenumFrom :: FileType -> [FileType]
fromEnum :: FileType -> Int
$cfromEnum :: FileType -> Int
toEnum :: Int -> FileType
$ctoEnum :: Int -> FileType
pred :: FileType -> FileType
$cpred :: FileType -> FileType
succ :: FileType -> FileType
$csucc :: FileType -> FileType
Enum, FileType
forall a. a -> a -> Bounded a
maxBound :: FileType
$cmaxBound :: FileType
minBound :: FileType
$cminBound :: FileType
Bounded, Eq FileType
FileType -> FileType -> Bool
FileType -> FileType -> Ordering
FileType -> FileType -> FileType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileType -> FileType -> FileType
$cmin :: FileType -> FileType -> FileType
max :: FileType -> FileType -> FileType
$cmax :: FileType -> FileType -> FileType
>= :: FileType -> FileType -> Bool
$c>= :: FileType -> FileType -> Bool
> :: FileType -> FileType -> Bool
$c> :: FileType -> FileType -> Bool
<= :: FileType -> FileType -> Bool
$c<= :: FileType -> FileType -> Bool
< :: FileType -> FileType -> Bool
$c< :: FileType -> FileType -> Bool
compare :: FileType -> FileType -> Ordering
$ccompare :: FileType -> FileType -> Ordering
Ord)
instance PersistField FileType where
toPersistValue :: FileType -> PersistValue
toPersistValue FileType
FTNormal = Int64 -> PersistValue
PersistInt64 Int64
1
toPersistValue FileType
FTExecutable = Int64 -> PersistValue
PersistInt64 Int64
2
fromPersistValue :: PersistValue -> Either Text FileType
fromPersistValue PersistValue
v = do
Int64
i <- forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
case Int64
i :: Int64 of
Int64
1 -> forall a b. b -> Either a b
Right FileType
FTNormal
Int64
2 -> forall a b. b -> Either a b
Right FileType
FTExecutable
Int64
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Invalid FileType: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int64
i
instance PersistFieldSql FileType where
sqlType :: Proxy FileType -> SqlType
sqlType Proxy FileType
_ = SqlType
SqlInt32
data TreeEntry = TreeEntry
{ TreeEntry -> BlobKey
teBlob :: !BlobKey
, TreeEntry -> FileType
teType :: !FileType
}
deriving (Int -> TreeEntry -> ShowS
[TreeEntry] -> ShowS
TreeEntry -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TreeEntry] -> ShowS
$cshowList :: [TreeEntry] -> ShowS
show :: TreeEntry -> [Char]
$cshow :: TreeEntry -> [Char]
showsPrec :: Int -> TreeEntry -> ShowS
$cshowsPrec :: Int -> TreeEntry -> ShowS
Show, TreeEntry -> TreeEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TreeEntry -> TreeEntry -> Bool
$c/= :: TreeEntry -> TreeEntry -> Bool
== :: TreeEntry -> TreeEntry -> Bool
$c== :: TreeEntry -> TreeEntry -> Bool
Eq, Eq TreeEntry
TreeEntry -> TreeEntry -> Bool
TreeEntry -> TreeEntry -> Ordering
TreeEntry -> TreeEntry -> TreeEntry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TreeEntry -> TreeEntry -> TreeEntry
$cmin :: TreeEntry -> TreeEntry -> TreeEntry
max :: TreeEntry -> TreeEntry -> TreeEntry
$cmax :: TreeEntry -> TreeEntry -> TreeEntry
>= :: TreeEntry -> TreeEntry -> Bool
$c>= :: TreeEntry -> TreeEntry -> Bool
> :: TreeEntry -> TreeEntry -> Bool
$c> :: TreeEntry -> TreeEntry -> Bool
<= :: TreeEntry -> TreeEntry -> Bool
$c<= :: TreeEntry -> TreeEntry -> Bool
< :: TreeEntry -> TreeEntry -> Bool
$c< :: TreeEntry -> TreeEntry -> Bool
compare :: TreeEntry -> TreeEntry -> Ordering
$ccompare :: TreeEntry -> TreeEntry -> Ordering
Ord)
newtype SafeFilePath = SafeFilePath Text
deriving (Int -> SafeFilePath -> ShowS
[SafeFilePath] -> ShowS
SafeFilePath -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SafeFilePath] -> ShowS
$cshowList :: [SafeFilePath] -> ShowS
show :: SafeFilePath -> [Char]
$cshow :: SafeFilePath -> [Char]
showsPrec :: Int -> SafeFilePath -> ShowS
$cshowsPrec :: Int -> SafeFilePath -> ShowS
Show, SafeFilePath -> SafeFilePath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SafeFilePath -> SafeFilePath -> Bool
$c/= :: SafeFilePath -> SafeFilePath -> Bool
== :: SafeFilePath -> SafeFilePath -> Bool
$c== :: SafeFilePath -> SafeFilePath -> Bool
Eq, Eq SafeFilePath
SafeFilePath -> SafeFilePath -> Bool
SafeFilePath -> SafeFilePath -> Ordering
SafeFilePath -> SafeFilePath -> SafeFilePath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SafeFilePath -> SafeFilePath -> SafeFilePath
$cmin :: SafeFilePath -> SafeFilePath -> SafeFilePath
max :: SafeFilePath -> SafeFilePath -> SafeFilePath
$cmax :: SafeFilePath -> SafeFilePath -> SafeFilePath
>= :: SafeFilePath -> SafeFilePath -> Bool
$c>= :: SafeFilePath -> SafeFilePath -> Bool
> :: SafeFilePath -> SafeFilePath -> Bool
$c> :: SafeFilePath -> SafeFilePath -> Bool
<= :: SafeFilePath -> SafeFilePath -> Bool
$c<= :: SafeFilePath -> SafeFilePath -> Bool
< :: SafeFilePath -> SafeFilePath -> Bool
$c< :: SafeFilePath -> SafeFilePath -> Bool
compare :: SafeFilePath -> SafeFilePath -> Ordering
$ccompare :: SafeFilePath -> SafeFilePath -> Ordering
Ord, SafeFilePath -> Text
SafeFilePath -> Utf8Builder
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
textDisplay :: SafeFilePath -> Text
$ctextDisplay :: SafeFilePath -> Text
display :: SafeFilePath -> Utf8Builder
$cdisplay :: SafeFilePath -> Utf8Builder
Display)
instance PersistField SafeFilePath where
toPersistValue :: SafeFilePath -> PersistValue
toPersistValue = forall a. PersistField a => a -> PersistValue
toPersistValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeFilePath -> Text
unSafeFilePath
fromPersistValue :: PersistValue -> Either Text SafeFilePath
fromPersistValue PersistValue
v = do
Text
t <- forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Invalid SafeFilePath: " forall a. Semigroup a => a -> a -> a
<> Text
t) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> Maybe SafeFilePath
mkSafeFilePath Text
t
instance PersistFieldSql SafeFilePath where
sqlType :: Proxy SafeFilePath -> SqlType
sqlType Proxy SafeFilePath
_ = SqlType
SqlString
unSafeFilePath :: SafeFilePath -> Text
unSafeFilePath :: SafeFilePath -> Text
unSafeFilePath (SafeFilePath Text
t) = Text
t
safeFilePathToPath :: (MonadThrow m) => Path Abs Dir -> SafeFilePath -> m (Path Abs File)
safeFilePathToPath :: forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir -> SafeFilePath -> m (Path Abs File)
safeFilePathToPath Path Abs Dir
dir (SafeFilePath Text
path) = do
Path Rel File
fpath <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile (Text -> [Char]
T.unpack Text
path)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
fpath
mkSafeFilePath :: Text -> Maybe SafeFilePath
mkSafeFilePath :: Text -> Maybe SafeFilePath
mkSafeFilePath Text
t = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
"\\" Text -> Text -> Bool
`T.isInfixOf` Text
t
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
"//" Text -> Text -> Bool
`T.isInfixOf` Text
t
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
"\n" Text -> Text -> Bool
`T.isInfixOf` Text
t
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
"\0" Text -> Text -> Bool
`T.isInfixOf` Text
t
(Char
c, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
t
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Char
c forall a. Eq a => a -> a -> Bool
/= Char
'/'
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Bool
T.all (forall a. Eq a => a -> a -> Bool
== Char
'.')) forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'/') Text
t
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> SafeFilePath
SafeFilePath Text
t
hpackSafeFilePath :: SafeFilePath
hpackSafeFilePath :: SafeFilePath
hpackSafeFilePath =
let fpath :: Maybe SafeFilePath
fpath = Text -> Maybe SafeFilePath
mkSafeFilePath ([Char] -> Text
T.pack [Char]
Hpack.packageConfig)
in case Maybe SafeFilePath
fpath of
Maybe SafeFilePath
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"hpackSafeFilePath: Not able to encode " forall a. Semigroup a => a -> a -> a
<> ([Char]
Hpack.packageConfig)
Just SafeFilePath
sfp -> SafeFilePath
sfp
newtype TreeKey = TreeKey BlobKey
deriving (Int -> TreeKey -> ShowS
[TreeKey] -> ShowS
TreeKey -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TreeKey] -> ShowS
$cshowList :: [TreeKey] -> ShowS
show :: TreeKey -> [Char]
$cshow :: TreeKey -> [Char]
showsPrec :: Int -> TreeKey -> ShowS
$cshowsPrec :: Int -> TreeKey -> ShowS
Show, TreeKey -> TreeKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TreeKey -> TreeKey -> Bool
$c/= :: TreeKey -> TreeKey -> Bool
== :: TreeKey -> TreeKey -> Bool
$c== :: TreeKey -> TreeKey -> Bool
Eq, Eq TreeKey
TreeKey -> TreeKey -> Bool
TreeKey -> TreeKey -> Ordering
TreeKey -> TreeKey -> TreeKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TreeKey -> TreeKey -> TreeKey
$cmin :: TreeKey -> TreeKey -> TreeKey
max :: TreeKey -> TreeKey -> TreeKey
$cmax :: TreeKey -> TreeKey -> TreeKey
>= :: TreeKey -> TreeKey -> Bool
$c>= :: TreeKey -> TreeKey -> Bool
> :: TreeKey -> TreeKey -> Bool
$c> :: TreeKey -> TreeKey -> Bool
<= :: TreeKey -> TreeKey -> Bool
$c<= :: TreeKey -> TreeKey -> Bool
< :: TreeKey -> TreeKey -> Bool
$c< :: TreeKey -> TreeKey -> Bool
compare :: TreeKey -> TreeKey -> Ordering
$ccompare :: TreeKey -> TreeKey -> Ordering
Ord, forall x. Rep TreeKey x -> TreeKey
forall x. TreeKey -> Rep TreeKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TreeKey x -> TreeKey
$cfrom :: forall x. TreeKey -> Rep TreeKey x
Generic, Typeable, [TreeKey] -> Encoding
[TreeKey] -> Value
TreeKey -> Encoding
TreeKey -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TreeKey] -> Encoding
$ctoEncodingList :: [TreeKey] -> Encoding
toJSONList :: [TreeKey] -> Value
$ctoJSONList :: [TreeKey] -> Value
toEncoding :: TreeKey -> Encoding
$ctoEncoding :: TreeKey -> Encoding
toJSON :: TreeKey -> Value
$ctoJSON :: TreeKey -> Value
ToJSON, Value -> Parser [TreeKey]
Value -> Parser TreeKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TreeKey]
$cparseJSONList :: Value -> Parser [TreeKey]
parseJSON :: Value -> Parser TreeKey
$cparseJSON :: Value -> Parser TreeKey
FromJSON, TreeKey -> ()
forall a. (a -> ()) -> NFData a
rnf :: TreeKey -> ()
$crnf :: TreeKey -> ()
NFData, TreeKey -> Text
TreeKey -> Utf8Builder
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
textDisplay :: TreeKey -> Text
$ctextDisplay :: TreeKey -> Text
display :: TreeKey -> Utf8Builder
$cdisplay :: TreeKey -> Utf8Builder
Display)
newtype Tree
= TreeMap (Map SafeFilePath TreeEntry)
deriving (Int -> Tree -> ShowS
[Tree] -> ShowS
Tree -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Tree] -> ShowS
$cshowList :: [Tree] -> ShowS
show :: Tree -> [Char]
$cshow :: Tree -> [Char]
showsPrec :: Int -> Tree -> ShowS
$cshowsPrec :: Int -> Tree -> ShowS
Show, Tree -> Tree -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree -> Tree -> Bool
$c/= :: Tree -> Tree -> Bool
== :: Tree -> Tree -> Bool
$c== :: Tree -> Tree -> Bool
Eq, Eq Tree
Tree -> Tree -> Bool
Tree -> Tree -> Ordering
Tree -> Tree -> Tree
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tree -> Tree -> Tree
$cmin :: Tree -> Tree -> Tree
max :: Tree -> Tree -> Tree
$cmax :: Tree -> Tree -> Tree
>= :: Tree -> Tree -> Bool
$c>= :: Tree -> Tree -> Bool
> :: Tree -> Tree -> Bool
$c> :: Tree -> Tree -> Bool
<= :: Tree -> Tree -> Bool
$c<= :: Tree -> Tree -> Bool
< :: Tree -> Tree -> Bool
$c< :: Tree -> Tree -> Bool
compare :: Tree -> Tree -> Ordering
$ccompare :: Tree -> Tree -> Ordering
Ord)
renderTree :: Tree -> ByteString
renderTree :: Tree -> ByteString
renderTree = ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree -> Builder
go
where
go :: Tree -> Builder
go :: Tree -> Builder
go (TreeMap Map SafeFilePath TreeEntry
m) = Builder
"map:" forall a. Semigroup a => a -> a -> a
<> forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey SafeFilePath -> TreeEntry -> Builder
goEntry Map SafeFilePath TreeEntry
m
goEntry :: SafeFilePath -> TreeEntry -> Builder
goEntry SafeFilePath
sfp (TreeEntry (BlobKey SHA256
sha (FileSize Word
size')) FileType
ft) =
Text -> Builder
netstring (SafeFilePath -> Text
unSafeFilePath SafeFilePath
sfp) forall a. Semigroup a => a -> a -> a
<>
ByteString -> Builder
byteString (SHA256 -> ByteString
SHA256.toRaw SHA256
sha) forall a. Semigroup a => a -> a -> a
<>
Word -> Builder
netword Word
size' forall a. Semigroup a => a -> a -> a
<>
(case FileType
ft of
FileType
FTNormal -> Builder
"N"
FileType
FTExecutable -> Builder
"X")
netstring :: Text -> Builder
netstring :: Text -> Builder
netstring Text
t =
let bs :: ByteString
bs = Text -> ByteString
encodeUtf8 Text
t
in Word -> Builder
netword (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)) forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
bs
netword :: Word -> Builder
netword :: Word -> Builder
netword Word
w = Word -> Builder
wordDec Word
w forall a. Semigroup a => a -> a -> a
<> Builder
":"
parseTreeM :: MonadThrow m => (BlobKey, ByteString) -> m (TreeKey, Tree)
parseTreeM :: forall (m :: * -> *).
MonadThrow m =>
(BlobKey, ByteString) -> m (TreeKey, Tree)
parseTreeM (BlobKey
blobKey, ByteString
blob) =
case ByteString -> Maybe Tree
parseTree ByteString
blob of
Maybe Tree
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (BlobKey -> ByteString -> PantryException
InvalidTreeFromCasa BlobKey
blobKey ByteString
blob)
Just Tree
tree -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (BlobKey -> TreeKey
TreeKey BlobKey
blobKey, Tree
tree)
parseTree :: ByteString -> Maybe Tree
parseTree :: ByteString -> Maybe Tree
parseTree ByteString
bs1 = do
Tree
tree <- ByteString -> Maybe Tree
parseTree' ByteString
bs1
let bs2 :: ByteString
bs2 = Tree -> ByteString
renderTree Tree
tree
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ ByteString
bs1 forall a. Eq a => a -> a -> Bool
== ByteString
bs2
forall a. a -> Maybe a
Just Tree
tree
parseTree' :: ByteString -> Maybe Tree
parseTree' :: ByteString -> Maybe Tree
parseTree' ByteString
bs0 = do
ByteString
entriesBS <- ByteString -> ByteString -> Maybe ByteString
B.stripPrefix ByteString
"map:" ByteString
bs0
Map SafeFilePath TreeEntry -> Tree
TreeMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map SafeFilePath TreeEntry
-> ByteString -> Maybe (Map SafeFilePath TreeEntry)
loop forall k a. Map k a
Map.empty ByteString
entriesBS
where
loop :: Map SafeFilePath TreeEntry
-> ByteString -> Maybe (Map SafeFilePath TreeEntry)
loop !Map SafeFilePath TreeEntry
m ByteString
bs1
| ByteString -> Bool
B.null ByteString
bs1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Map SafeFilePath TreeEntry
m
| Bool
otherwise = do
(ByteString
sfpBS, ByteString
bs2) <- ByteString -> Maybe (ByteString, ByteString)
takeNetstring ByteString
bs1
SafeFilePath
sfp <-
case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
sfpBS of
Left UnicodeException
_ -> forall a. Maybe a
Nothing
Right Text
sfpT -> Text -> Maybe SafeFilePath
mkSafeFilePath Text
sfpT
(SHA256
sha, ByteString
bs3) <- ByteString -> Maybe (SHA256, ByteString)
takeSha ByteString
bs2
(Int
size', ByteString
bs4) <- ByteString -> Maybe (Int, ByteString)
takeNetword ByteString
bs3
(Word8
typeW, ByteString
bs5) <- ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs4
FileType
ft <-
case Word8
typeW of
Word8
78 -> forall a. a -> Maybe a
Just FileType
FTNormal
Word8
88 -> forall a. a -> Maybe a
Just FileType
FTExecutable
Word8
_ -> forall a. Maybe a
Nothing
let entry :: TreeEntry
entry = BlobKey -> FileType -> TreeEntry
TreeEntry (SHA256 -> FileSize -> BlobKey
BlobKey SHA256
sha (Word -> FileSize
FileSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size'))) FileType
ft
Map SafeFilePath TreeEntry
-> ByteString -> Maybe (Map SafeFilePath TreeEntry)
loop (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SafeFilePath
sfp TreeEntry
entry Map SafeFilePath TreeEntry
m) ByteString
bs5
takeNetstring :: ByteString -> Maybe (ByteString, ByteString)
takeNetstring ByteString
bs1 = do
(Int
size', ByteString
bs2) <- ByteString -> Maybe (Int, ByteString)
takeNetword ByteString
bs1
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs2 forall a. Ord a => a -> a -> Bool
>= Int
size'
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
size' ByteString
bs2
takeSha :: ByteString -> Maybe (SHA256, ByteString)
takeSha ByteString
bs = do
let (ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
32 ByteString
bs
SHA256
x' <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just (ByteString -> Either SHA256Exception SHA256
SHA256.fromRaw ByteString
x)
forall a. a -> Maybe a
Just (SHA256
x', ByteString
y)
takeNetword :: ByteString -> Maybe (Int, ByteString)
takeNetword =
forall {t}. Num t => t -> ByteString -> Maybe (t, ByteString)
go Int
0
where
go :: t -> ByteString -> Maybe (t, ByteString)
go !t
accum ByteString
bs = do
(Word8
next, ByteString
rest) <- ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs
if
| Word8
next forall a. Eq a => a -> a -> Bool
== Word8
58 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (t
accum, ByteString
rest)
| Word8
next forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
next forall a. Ord a => a -> a -> Bool
<= Word8
57 ->
t -> ByteString -> Maybe (t, ByteString)
go
(t
accum forall a. Num a => a -> a -> a
* t
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
next forall a. Num a => a -> a -> a
- Word8
48))
ByteString
rest
| Bool
otherwise -> forall a. Maybe a
Nothing
parsePackageIdentifier :: String -> Maybe PackageIdentifier
parsePackageIdentifier :: [Char] -> Maybe PackageIdentifier
parsePackageIdentifier = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParsecParser a -> [Char] -> Either [Char] a
explicitEitherParsec (ParsecParser PackageIdentifier
packageIdentifierParsec forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). Parsing m => m ()
Parse.eof)
packageIdentifierParsec :: ParsecParser PackageIdentifier
packageIdentifierParsec :: ParsecParser PackageIdentifier
packageIdentifierParsec = do
ident :: PackageIdentifier
ident@(PackageIdentifier PackageName
_ Version
v) <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Version
v forall a. Eq a => a -> a -> Bool
/= Version
nullVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageIdentifier
ident
parsePackageName :: String -> Maybe PackageName
parsePackageName :: [Char] -> Maybe PackageName
parsePackageName = forall a. Parsec a => [Char] -> Maybe a
Distribution.Text.simpleParse
parsePackageNameThrowing :: MonadThrow m => String -> m PackageName
parsePackageNameThrowing :: forall (m :: * -> *). MonadThrow m => [Char] -> m PackageName
parsePackageNameThrowing [Char]
str =
case [Char] -> Maybe PackageName
parsePackageName [Char]
str of
Maybe PackageName
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> PantryException
PackageNameParseFail forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
str
Just PackageName
pn -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageName
pn
parseVersion :: String -> Maybe Version
parseVersion :: [Char] -> Maybe Version
parseVersion = forall a. Parsec a => [Char] -> Maybe a
Distribution.Text.simpleParse
parseVersionThrowing :: MonadThrow m => String -> m Version
parseVersionThrowing :: forall (m :: * -> *). MonadThrow m => [Char] -> m Version
parseVersionThrowing [Char]
str =
case [Char] -> Maybe Version
parseVersion [Char]
str of
Maybe Version
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> PantryException
PackageVersionParseFail forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
str
Just Version
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v
parseVersionRange :: String -> Maybe VersionRange
parseVersionRange :: [Char] -> Maybe VersionRange
parseVersionRange = forall a. Parsec a => [Char] -> Maybe a
Distribution.Text.simpleParse
parseModuleName :: String -> Maybe ModuleName
parseModuleName :: [Char] -> Maybe ModuleName
parseModuleName = forall a. Parsec a => [Char] -> Maybe a
Distribution.Text.simpleParse
parseFlagName :: String -> Maybe FlagName
parseFlagName :: [Char] -> Maybe FlagName
parseFlagName = forall a. Parsec a => [Char] -> Maybe a
Distribution.Text.simpleParse
packageNameString :: PackageName -> String
packageNameString :: PackageName -> [Char]
packageNameString = PackageName -> [Char]
unPackageName
packageIdentifierString :: PackageIdentifier -> String
packageIdentifierString :: PackageIdentifier -> [Char]
packageIdentifierString = forall a. Pretty a => a -> [Char]
Distribution.Text.display
versionString :: Version -> String
versionString :: Version -> [Char]
versionString = forall a. Pretty a => a -> [Char]
Distribution.Text.display
flagNameString :: FlagName -> String
flagNameString :: FlagName -> [Char]
flagNameString = FlagName -> [Char]
unFlagName
moduleNameString :: ModuleName -> String
moduleNameString :: ModuleName -> [Char]
moduleNameString = forall a. Pretty a => a -> [Char]
Distribution.Text.display
data OptionalSubdirs
= OSSubdirs !(NonEmpty Text)
| OSPackageMetadata !Text !RawPackageMetadata
deriving (Int -> OptionalSubdirs -> ShowS
[OptionalSubdirs] -> ShowS
OptionalSubdirs -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OptionalSubdirs] -> ShowS
$cshowList :: [OptionalSubdirs] -> ShowS
show :: OptionalSubdirs -> [Char]
$cshow :: OptionalSubdirs -> [Char]
showsPrec :: Int -> OptionalSubdirs -> ShowS
$cshowsPrec :: Int -> OptionalSubdirs -> ShowS
Show, OptionalSubdirs -> OptionalSubdirs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionalSubdirs -> OptionalSubdirs -> Bool
$c/= :: OptionalSubdirs -> OptionalSubdirs -> Bool
== :: OptionalSubdirs -> OptionalSubdirs -> Bool
$c== :: OptionalSubdirs -> OptionalSubdirs -> Bool
Eq, forall x. Rep OptionalSubdirs x -> OptionalSubdirs
forall x. OptionalSubdirs -> Rep OptionalSubdirs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OptionalSubdirs x -> OptionalSubdirs
$cfrom :: forall x. OptionalSubdirs -> Rep OptionalSubdirs x
Generic)
instance NFData OptionalSubdirs
data RawPackageMetadata = RawPackageMetadata
{ RawPackageMetadata -> Maybe PackageName
rpmName :: !(Maybe PackageName)
, RawPackageMetadata -> Maybe Version
rpmVersion :: !(Maybe Version)
, RawPackageMetadata -> Maybe TreeKey
rpmTreeKey :: !(Maybe TreeKey)
}
deriving (Int -> RawPackageMetadata -> ShowS
[RawPackageMetadata] -> ShowS
RawPackageMetadata -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RawPackageMetadata] -> ShowS
$cshowList :: [RawPackageMetadata] -> ShowS
show :: RawPackageMetadata -> [Char]
$cshow :: RawPackageMetadata -> [Char]
showsPrec :: Int -> RawPackageMetadata -> ShowS
$cshowsPrec :: Int -> RawPackageMetadata -> ShowS
Show, RawPackageMetadata -> RawPackageMetadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawPackageMetadata -> RawPackageMetadata -> Bool
$c/= :: RawPackageMetadata -> RawPackageMetadata -> Bool
== :: RawPackageMetadata -> RawPackageMetadata -> Bool
$c== :: RawPackageMetadata -> RawPackageMetadata -> Bool
Eq, Eq RawPackageMetadata
RawPackageMetadata -> RawPackageMetadata -> Bool
RawPackageMetadata -> RawPackageMetadata -> Ordering
RawPackageMetadata -> RawPackageMetadata -> RawPackageMetadata
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RawPackageMetadata -> RawPackageMetadata -> RawPackageMetadata
$cmin :: RawPackageMetadata -> RawPackageMetadata -> RawPackageMetadata
max :: RawPackageMetadata -> RawPackageMetadata -> RawPackageMetadata
$cmax :: RawPackageMetadata -> RawPackageMetadata -> RawPackageMetadata
>= :: RawPackageMetadata -> RawPackageMetadata -> Bool
$c>= :: RawPackageMetadata -> RawPackageMetadata -> Bool
> :: RawPackageMetadata -> RawPackageMetadata -> Bool
$c> :: RawPackageMetadata -> RawPackageMetadata -> Bool
<= :: RawPackageMetadata -> RawPackageMetadata -> Bool
$c<= :: RawPackageMetadata -> RawPackageMetadata -> Bool
< :: RawPackageMetadata -> RawPackageMetadata -> Bool
$c< :: RawPackageMetadata -> RawPackageMetadata -> Bool
compare :: RawPackageMetadata -> RawPackageMetadata -> Ordering
$ccompare :: RawPackageMetadata -> RawPackageMetadata -> Ordering
Ord, forall x. Rep RawPackageMetadata x -> RawPackageMetadata
forall x. RawPackageMetadata -> Rep RawPackageMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RawPackageMetadata x -> RawPackageMetadata
$cfrom :: forall x. RawPackageMetadata -> Rep RawPackageMetadata x
Generic, Typeable)
instance NFData RawPackageMetadata
instance Display RawPackageMetadata where
display :: RawPackageMetadata -> Utf8Builder
display RawPackageMetadata
rpm = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
[ (\PackageName
name -> Utf8Builder
"name == " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
packageNameString PackageName
name)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPackageMetadata -> Maybe PackageName
rpmName RawPackageMetadata
rpm
, (\Version
version -> Utf8Builder
"version == " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
version)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPackageMetadata -> Maybe Version
rpmVersion RawPackageMetadata
rpm
, (\TreeKey
tree -> Utf8Builder
"tree == " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display TreeKey
tree) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPackageMetadata -> Maybe TreeKey
rpmTreeKey RawPackageMetadata
rpm
]
data PackageMetadata = PackageMetadata
{ PackageMetadata -> PackageIdentifier
pmIdent :: !PackageIdentifier
, PackageMetadata -> TreeKey
pmTreeKey :: !TreeKey
}
deriving (Int -> PackageMetadata -> ShowS
[PackageMetadata] -> ShowS
PackageMetadata -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PackageMetadata] -> ShowS
$cshowList :: [PackageMetadata] -> ShowS
show :: PackageMetadata -> [Char]
$cshow :: PackageMetadata -> [Char]
showsPrec :: Int -> PackageMetadata -> ShowS
$cshowsPrec :: Int -> PackageMetadata -> ShowS
Show, PackageMetadata -> PackageMetadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageMetadata -> PackageMetadata -> Bool
$c/= :: PackageMetadata -> PackageMetadata -> Bool
== :: PackageMetadata -> PackageMetadata -> Bool
$c== :: PackageMetadata -> PackageMetadata -> Bool
Eq, Eq PackageMetadata
PackageMetadata -> PackageMetadata -> Bool
PackageMetadata -> PackageMetadata -> Ordering
PackageMetadata -> PackageMetadata -> PackageMetadata
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageMetadata -> PackageMetadata -> PackageMetadata
$cmin :: PackageMetadata -> PackageMetadata -> PackageMetadata
max :: PackageMetadata -> PackageMetadata -> PackageMetadata
$cmax :: PackageMetadata -> PackageMetadata -> PackageMetadata
>= :: PackageMetadata -> PackageMetadata -> Bool
$c>= :: PackageMetadata -> PackageMetadata -> Bool
> :: PackageMetadata -> PackageMetadata -> Bool
$c> :: PackageMetadata -> PackageMetadata -> Bool
<= :: PackageMetadata -> PackageMetadata -> Bool
$c<= :: PackageMetadata -> PackageMetadata -> Bool
< :: PackageMetadata -> PackageMetadata -> Bool
$c< :: PackageMetadata -> PackageMetadata -> Bool
compare :: PackageMetadata -> PackageMetadata -> Ordering
$ccompare :: PackageMetadata -> PackageMetadata -> Ordering
Ord, forall x. Rep PackageMetadata x -> PackageMetadata
forall x. PackageMetadata -> Rep PackageMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageMetadata x -> PackageMetadata
$cfrom :: forall x. PackageMetadata -> Rep PackageMetadata x
Generic, Typeable)
instance NFData PackageMetadata
instance Display PackageMetadata where
display :: PackageMetadata -> Utf8Builder
display PackageMetadata
pm = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " forall a b. (a -> b) -> a -> b
$
[ Utf8Builder
"ident == " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString forall a b. (a -> b) -> a -> b
$ PackageMetadata -> PackageIdentifier
pmIdent PackageMetadata
pm)
, Utf8Builder
"tree == " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (PackageMetadata -> TreeKey
pmTreeKey PackageMetadata
pm)
]
parsePackageMetadata :: Object -> WarningParser PackageMetadata
parsePackageMetadata :: Object -> WarningParser PackageMetadata
parsePackageMetadata Object
o = do
Maybe BlobKey
_oldCabalFile :: Maybe BlobKey <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"cabal-file"
BlobKey
pantryTree :: BlobKey <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"pantry-tree"
CabalString PackageName
pkgName <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"name"
CabalString Version
pkgVersion <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"version"
let pmTreeKey :: TreeKey
pmTreeKey = BlobKey -> TreeKey
TreeKey BlobKey
pantryTree
pmIdent :: PackageIdentifier
pmIdent = PackageIdentifier {PackageName
Version
pkgVersion :: Version
pkgVersion :: Version
pkgName :: PackageName
pkgName :: PackageName
..}
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageMetadata {PackageIdentifier
TreeKey
pmIdent :: PackageIdentifier
pmTreeKey :: TreeKey
pmTreeKey :: TreeKey
pmIdent :: PackageIdentifier
..}
toRawPM :: PackageMetadata -> RawPackageMetadata
toRawPM :: PackageMetadata -> RawPackageMetadata
toRawPM PackageMetadata
pm = Maybe PackageName
-> Maybe Version -> Maybe TreeKey -> RawPackageMetadata
RawPackageMetadata (forall a. a -> Maybe a
Just PackageName
name) (forall a. a -> Maybe a
Just Version
version) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PackageMetadata -> TreeKey
pmTreeKey PackageMetadata
pm)
where
PackageIdentifier PackageName
name Version
version = PackageMetadata -> PackageIdentifier
pmIdent PackageMetadata
pm
newtype RelFilePath = RelFilePath Text
deriving (Int -> RelFilePath -> ShowS
[RelFilePath] -> ShowS
RelFilePath -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RelFilePath] -> ShowS
$cshowList :: [RelFilePath] -> ShowS
show :: RelFilePath -> [Char]
$cshow :: RelFilePath -> [Char]
showsPrec :: Int -> RelFilePath -> ShowS
$cshowsPrec :: Int -> RelFilePath -> ShowS
Show, [RelFilePath] -> Encoding
[RelFilePath] -> Value
RelFilePath -> Encoding
RelFilePath -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RelFilePath] -> Encoding
$ctoEncodingList :: [RelFilePath] -> Encoding
toJSONList :: [RelFilePath] -> Value
$ctoJSONList :: [RelFilePath] -> Value
toEncoding :: RelFilePath -> Encoding
$ctoEncoding :: RelFilePath -> Encoding
toJSON :: RelFilePath -> Value
$ctoJSON :: RelFilePath -> Value
ToJSON, Value -> Parser [RelFilePath]
Value -> Parser RelFilePath
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RelFilePath]
$cparseJSONList :: Value -> Parser [RelFilePath]
parseJSON :: Value -> Parser RelFilePath
$cparseJSON :: Value -> Parser RelFilePath
FromJSON, RelFilePath -> RelFilePath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelFilePath -> RelFilePath -> Bool
$c/= :: RelFilePath -> RelFilePath -> Bool
== :: RelFilePath -> RelFilePath -> Bool
$c== :: RelFilePath -> RelFilePath -> Bool
Eq, Eq RelFilePath
RelFilePath -> RelFilePath -> Bool
RelFilePath -> RelFilePath -> Ordering
RelFilePath -> RelFilePath -> RelFilePath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RelFilePath -> RelFilePath -> RelFilePath
$cmin :: RelFilePath -> RelFilePath -> RelFilePath
max :: RelFilePath -> RelFilePath -> RelFilePath
$cmax :: RelFilePath -> RelFilePath -> RelFilePath
>= :: RelFilePath -> RelFilePath -> Bool
$c>= :: RelFilePath -> RelFilePath -> Bool
> :: RelFilePath -> RelFilePath -> Bool
$c> :: RelFilePath -> RelFilePath -> Bool
<= :: RelFilePath -> RelFilePath -> Bool
$c<= :: RelFilePath -> RelFilePath -> Bool
< :: RelFilePath -> RelFilePath -> Bool
$c< :: RelFilePath -> RelFilePath -> Bool
compare :: RelFilePath -> RelFilePath -> Ordering
$ccompare :: RelFilePath -> RelFilePath -> Ordering
Ord, forall x. Rep RelFilePath x -> RelFilePath
forall x. RelFilePath -> Rep RelFilePath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelFilePath x -> RelFilePath
$cfrom :: forall x. RelFilePath -> Rep RelFilePath x
Generic, Typeable, RelFilePath -> ()
forall a. (a -> ()) -> NFData a
rnf :: RelFilePath -> ()
$crnf :: RelFilePath -> ()
NFData, RelFilePath -> Text
RelFilePath -> Utf8Builder
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
textDisplay :: RelFilePath -> Text
$ctextDisplay :: RelFilePath -> Text
display :: RelFilePath -> Utf8Builder
$cdisplay :: RelFilePath -> Utf8Builder
Display)
data ArchiveLocation
= ALUrl !Text
| ALFilePath !(ResolvedPath File)
deriving (Int -> ArchiveLocation -> ShowS
[ArchiveLocation] -> ShowS
ArchiveLocation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ArchiveLocation] -> ShowS
$cshowList :: [ArchiveLocation] -> ShowS
show :: ArchiveLocation -> [Char]
$cshow :: ArchiveLocation -> [Char]
showsPrec :: Int -> ArchiveLocation -> ShowS
$cshowsPrec :: Int -> ArchiveLocation -> ShowS
Show, ArchiveLocation -> ArchiveLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArchiveLocation -> ArchiveLocation -> Bool
$c/= :: ArchiveLocation -> ArchiveLocation -> Bool
== :: ArchiveLocation -> ArchiveLocation -> Bool
$c== :: ArchiveLocation -> ArchiveLocation -> Bool
Eq, Eq ArchiveLocation
ArchiveLocation -> ArchiveLocation -> Bool
ArchiveLocation -> ArchiveLocation -> Ordering
ArchiveLocation -> ArchiveLocation -> ArchiveLocation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArchiveLocation -> ArchiveLocation -> ArchiveLocation
$cmin :: ArchiveLocation -> ArchiveLocation -> ArchiveLocation
max :: ArchiveLocation -> ArchiveLocation -> ArchiveLocation
$cmax :: ArchiveLocation -> ArchiveLocation -> ArchiveLocation
>= :: ArchiveLocation -> ArchiveLocation -> Bool
$c>= :: ArchiveLocation -> ArchiveLocation -> Bool
> :: ArchiveLocation -> ArchiveLocation -> Bool
$c> :: ArchiveLocation -> ArchiveLocation -> Bool
<= :: ArchiveLocation -> ArchiveLocation -> Bool
$c<= :: ArchiveLocation -> ArchiveLocation -> Bool
< :: ArchiveLocation -> ArchiveLocation -> Bool
$c< :: ArchiveLocation -> ArchiveLocation -> Bool
compare :: ArchiveLocation -> ArchiveLocation -> Ordering
$ccompare :: ArchiveLocation -> ArchiveLocation -> Ordering
Ord, forall x. Rep ArchiveLocation x -> ArchiveLocation
forall x. ArchiveLocation -> Rep ArchiveLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArchiveLocation x -> ArchiveLocation
$cfrom :: forall x. ArchiveLocation -> Rep ArchiveLocation x
Generic, Typeable)
instance NFData ArchiveLocation
instance Display ArchiveLocation where
display :: ArchiveLocation -> Utf8Builder
display (ALUrl Text
url) = forall a. Display a => a -> Utf8Builder
display Text
url
display (ALFilePath ResolvedPath File
resolved) = forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> [Char]
toFilePath forall a b. (a -> b) -> a -> b
$ forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute ResolvedPath File
resolved
instance Pretty ArchiveLocation where
pretty :: ArchiveLocation -> StyleDoc
pretty (ALUrl Text
url) = Style -> StyleDoc -> StyleDoc
style Style
Url (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url)
pretty (ALFilePath ResolvedPath File
resolved) = forall a. Pretty a => a -> StyleDoc
pretty forall a b. (a -> b) -> a -> b
$ forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute ResolvedPath File
resolved
parseArchiveLocationObject :: Object -> WarningParser (Unresolved ArchiveLocation)
parseArchiveLocationObject :: Object -> WarningParser (Unresolved ArchiveLocation)
parseArchiveLocationObject Object
o =
((Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"url") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Unresolved ArchiveLocation)
validateUrl) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"filepath") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Unresolved ArchiveLocation)
validateFilePath) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"archive") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Unresolved ArchiveLocation)
parseArchiveLocationText) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"location") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Unresolved ArchiveLocation)
parseArchiveLocationText)
parseArchiveLocationText :: Text -> Either Text (Unresolved ArchiveLocation)
parseArchiveLocationText :: Text -> Either Text (Unresolved ArchiveLocation)
parseArchiveLocationText Text
t =
case Text -> Either Text (Unresolved ArchiveLocation)
validateUrl Text
t of
Left Text
e1 ->
case Text -> Either Text (Unresolved ArchiveLocation)
validateFilePath Text
t of
Left Text
e2 -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
[ Text
"Invalid archive location, neither a URL nor a file path"
, Text
" URL error: " forall a. Semigroup a => a -> a -> a
<> Text
e1
, Text
" File path error: " forall a. Semigroup a => a -> a -> a
<> Text
e2
]
Right Unresolved ArchiveLocation
x -> forall a b. b -> Either a b
Right Unresolved ArchiveLocation
x
Right Unresolved ArchiveLocation
x -> forall a b. b -> Either a b
Right Unresolved ArchiveLocation
x
validateUrl :: Text -> Either Text (Unresolved ArchiveLocation)
validateUrl :: Text -> Either Text (Unresolved ArchiveLocation)
validateUrl Text
t =
case forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t of
Left SomeException
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Could not parse URL: " forall a. Semigroup a => a -> a -> a
<> Text
t
Right Request
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ArchiveLocation
ALUrl Text
t
validateFilePath :: Text -> Either Text (Unresolved ArchiveLocation)
validateFilePath :: Text -> Either Text (Unresolved ArchiveLocation)
validateFilePath Text
t =
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
ext -> Text
ext Text -> Text -> Bool
`T.isSuffixOf` Text
t) (Text -> [Text]
T.words Text
".zip .tar .tar.gz")
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir ->
case Maybe (Path Abs Dir)
mdir of
Maybe (Path Abs Dir)
Nothing -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> PantryException
InvalidFilePathSnapshot Text
t
Just Path Abs Dir
dir -> do
Path Abs File
abs' <- forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> [Char] -> m (Path Abs File)
resolveFile Path Abs Dir
dir forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> ArchiveLocation
ALFilePath forall a b. (a -> b) -> a -> b
$ forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath Text
t) Path Abs File
abs'
else forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Does not have an archive file extension: " forall a. Semigroup a => a -> a -> a
<> Text
t
instance ToJSON RawPackageLocation where
toJSON :: RawPackageLocation -> Value
toJSON (RPLImmutable RawPackageLocationImmutable
rpli) = forall a. ToJSON a => a -> Value
toJSON RawPackageLocationImmutable
rpli
toJSON (RPLMutable ResolvedPath Dir
resolved) = forall a. ToJSON a => a -> Value
toJSON (forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath Dir
resolved)
instance FromJSON (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))) where
parseJSON :: Value
-> Parser
(WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
parseJSON Value
v =
((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) RawPackageLocationImmutable -> RawPackageLocation
RPLImmutable (forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((forall a. a -> WithJSONWarnings a
noJSONWarnings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Unresolved (NonEmpty RawPackageLocation)
mkMutable) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
where
mkMutable :: Text -> Unresolved (NonEmpty RawPackageLocation)
mkMutable :: Text -> Unresolved (NonEmpty RawPackageLocation)
mkMutable Text
t = forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir -> do
case Maybe (Path Abs Dir)
mdir of
Maybe (Path Abs Dir)
Nothing -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> PantryException
MutablePackageLocationFromUrl Text
t
Just Path Abs Dir
dir -> do
Path Abs Dir
abs' <- forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> [Char] -> m (Path Abs Dir)
resolveDir Path Abs Dir
dir forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ResolvedPath Dir -> RawPackageLocation
RPLMutable forall a b. (a -> b) -> a -> b
$ forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath Text
t) Path Abs Dir
abs'
instance ToJSON RawPackageLocationImmutable where
toJSON :: RawPackageLocationImmutable -> Value
toJSON (RPLIHackage PackageIdentifierRevision
pir Maybe TreeKey
mtree) = [(AesonKey, Value)] -> Value
object forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [AesonKey
"hackage" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= PackageIdentifierRevision
pir]
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\TreeKey
tree -> [AesonKey
"pantry-tree" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= TreeKey
tree]) Maybe TreeKey
mtree
]
toJSON (RPLIArchive (RawArchive ArchiveLocation
loc Maybe SHA256
msha Maybe FileSize
msize Text
subdir) RawPackageMetadata
rpm) = [(AesonKey, Value)] -> Value
object forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ case ArchiveLocation
loc of
ALUrl Text
url -> [AesonKey
"url" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= Text
url]
ALFilePath ResolvedPath File
resolved -> [AesonKey
"filepath" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved]
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\SHA256
sha -> [AesonKey
"sha256" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= SHA256
sha]) Maybe SHA256
msha
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FileSize
size' -> [AesonKey
"size" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= FileSize
size']) Maybe FileSize
msize
, if Text -> Bool
T.null Text
subdir then [] else [AesonKey
"subdir" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= Text
subdir]
, RawPackageMetadata -> [(AesonKey, Value)]
rpmToPairs RawPackageMetadata
rpm
]
toJSON (RPLIRepo (Repo Text
url Text
commit RepoType
typ Text
subdir) RawPackageMetadata
rpm) = [(AesonKey, Value)] -> Value
object forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ AesonKey
urlKey forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= Text
url
, AesonKey
"commit" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= Text
commit
]
, if Text -> Bool
T.null Text
subdir then [] else [AesonKey
"subdir" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= Text
subdir]
, RawPackageMetadata -> [(AesonKey, Value)]
rpmToPairs RawPackageMetadata
rpm
]
where
urlKey :: AesonKey
urlKey =
case RepoType
typ of
RepoType
RepoGit -> AesonKey
"git"
RepoType
RepoHg -> AesonKey
"hg"
rpmToPairs :: RawPackageMetadata -> [(AesonKey, Value)]
rpmToPairs :: RawPackageMetadata -> [(AesonKey, Value)]
rpmToPairs (RawPackageMetadata Maybe PackageName
mname Maybe Version
mversion Maybe TreeKey
mtree) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PackageName
name -> [AesonKey
"name" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= forall a. a -> CabalString a
CabalString PackageName
name]) Maybe PackageName
mname
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Version
version -> [AesonKey
"version" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= forall a. a -> CabalString a
CabalString Version
version]) Maybe Version
mversion
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\TreeKey
tree -> [AesonKey
"pantry-tree" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= TreeKey
tree]) Maybe TreeKey
mtree
]
instance FromJSON (WithJSONWarnings (Unresolved PackageLocationImmutable)) where
parseJSON :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
parseJSON Value
v = Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
repoObject Value
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
archiveObject Value
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
hackageObject Value
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {f :: * -> *}.
Applicative f =>
Value -> Parser (WithJSONWarnings (f PackageLocationImmutable))
github Value
v
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Could not parse a UnresolvedPackageLocationImmutable from: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Value
v)
where
repoObject :: Value -> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
repoObject :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
repoObject = forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"UnresolvedPackageLocationImmutable.PLIRepo" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
PackageMetadata
pm <- Object -> WarningParser PackageMetadata
parsePackageMetadata Object
o
Text
repoSubdir <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"subdir" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Text
""
Text
repoCommit <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"commit"
(RepoType
repoType, Text
repoUrl) <-
(Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"git" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
url -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (RepoType
RepoGit, Text
url)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hg" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
url -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (RepoType
RepoHg, Text
url))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Repo -> PackageMetadata -> PackageLocationImmutable
PLIRepo Repo {Text
RepoType
repoUrl :: Text
repoType :: RepoType
repoCommit :: Text
repoSubdir :: Text
repoType :: RepoType
repoSubdir :: Text
repoCommit :: Text
repoUrl :: Text
..} PackageMetadata
pm
archiveObject :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
archiveObject =
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"UnresolvedPackageLocationImmutable.PLIArchive" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
PackageMetadata
pm <- Object -> WarningParser PackageMetadata
parsePackageMetadata Object
o
Unresolved Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation <- Object -> WarningParser (Unresolved ArchiveLocation)
parseArchiveLocationObject Object
o
SHA256
archiveHash <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"sha256"
FileSize
archiveSize <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"size"
Text
archiveSubdir <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"subdir" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Text
""
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir -> do
ArchiveLocation
archiveLocation <- Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation Maybe (Path Abs Dir)
mdir
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Archive -> PackageMetadata -> PackageLocationImmutable
PLIArchive Archive {Text
SHA256
ArchiveLocation
FileSize
archiveLocation :: ArchiveLocation
archiveSubdir :: Text
archiveSize :: FileSize
archiveHash :: SHA256
archiveSize :: FileSize
archiveHash :: SHA256
archiveSubdir :: Text
archiveLocation :: ArchiveLocation
..} PackageMetadata
pm
hackageObject :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
hackageObject =
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"UnresolvedPackagelocationimmutable.PLIHackage (Object)" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
BlobKey
treeKey <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"pantry-tree"
Text
htxt <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hackage"
case Text -> Either PantryException (PackageIdentifier, BlobKey)
parseHackageText Text
htxt of
Left PantryException
e -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show PantryException
e
Right (PackageIdentifier
pkgIdentifier, BlobKey
blobKey) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> BlobKey -> TreeKey -> PackageLocationImmutable
PLIHackage PackageIdentifier
pkgIdentifier BlobKey
blobKey (BlobKey -> TreeKey
TreeKey BlobKey
treeKey)
github :: Value -> Parser (WithJSONWarnings (f PackageLocationImmutable))
github Value
value =
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"UnresolvedPackagelocationimmutable.PLIArchive:github" (\Object
o -> do
PackageMetadata
pm <- Object -> WarningParser PackageMetadata
parsePackageMetadata Object
o
GitHubRepo Text
ghRepo <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"github"
Text
commit <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"commit"
let archiveLocation :: ArchiveLocation
archiveLocation = Text -> ArchiveLocation
ALUrl forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ Text
"https://github.com/"
, Text
ghRepo
, Text
"/archive/"
, Text
commit
, Text
".tar.gz"
]
SHA256
archiveHash <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"sha256"
FileSize
archiveSize <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"size"
Text
archiveSubdir <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"subdir" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Text
""
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Archive -> PackageMetadata -> PackageLocationImmutable
PLIArchive Archive {Text
SHA256
ArchiveLocation
FileSize
archiveSubdir :: Text
archiveSize :: FileSize
archiveHash :: SHA256
archiveLocation :: ArchiveLocation
archiveSize :: FileSize
archiveHash :: SHA256
archiveSubdir :: Text
archiveLocation :: ArchiveLocation
..} PackageMetadata
pm) Value
value
instance FromJSON (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable))) where
parseJSON :: Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
parseJSON Value
v
= Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
http Value
v
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
hackageText Value
v
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
hackageObject Value
v
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
repo Value
v
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
archiveObject Value
v
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
github Value
v
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Could not parse a UnresolvedRawPackageLocationImmutable from: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Value
v)
where
http :: Value -> Parser (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable)))
http :: Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
http = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"UnresolvedPackageLocationImmutable.RPLIArchive (Text)" forall a b. (a -> b) -> a -> b
$ \Text
t ->
case Text -> Either Text (Unresolved ArchiveLocation)
parseArchiveLocationText Text
t of
Left Text
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid archive location: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t
Right (Unresolved Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> WithJSONWarnings a
noJSONWarnings forall a b. (a -> b) -> a -> b
$ forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir -> do
ArchiveLocation
raLocation <- Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation Maybe (Path Abs Dir)
mdir
let raHash :: Maybe a
raHash = forall a. Maybe a
Nothing
raSize :: Maybe a
raSize = forall a. Maybe a
Nothing
raSubdir :: Text
raSubdir = Text
T.empty
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RawArchive -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIArchive RawArchive {Text
ArchiveLocation
forall a. Maybe a
raSubdir :: Text
raSize :: forall a. Maybe a
raHash :: forall a. Maybe a
raLocation :: ArchiveLocation
raSize :: Maybe FileSize
raHash :: Maybe SHA256
raSubdir :: Text
raLocation :: ArchiveLocation
..} RawPackageMetadata
rpmEmpty
hackageText :: Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
hackageText = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"UnresolvedPackageLocationImmutable.UPLIHackage (Text)" forall a b. (a -> b) -> a -> b
$ \Text
t ->
case Text -> Either PantryException PackageIdentifierRevision
parsePackageIdentifierRevision Text
t of
Left PantryException
e -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show PantryException
e
Right PackageIdentifierRevision
pir -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> WithJSONWarnings a
noJSONWarnings forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PackageIdentifierRevision
-> Maybe TreeKey -> RawPackageLocationImmutable
RPLIHackage PackageIdentifierRevision
pir forall a. Maybe a
Nothing
hackageObject :: Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
hackageObject = forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"UnresolvedPackageLocationImmutable.UPLIHackage" forall a b. (a -> b) -> a -> b
$ \Object
o -> (forall (f :: * -> *) a. Applicative f => a -> f a
pureforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PackageIdentifierRevision
-> Maybe TreeKey -> RawPackageLocationImmutable
RPLIHackage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hackage"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"pantry-tree")
optionalSubdirs :: Object -> WarningParser OptionalSubdirs
optionalSubdirs :: Object -> WarningParser OptionalSubdirs
optionalSubdirs Object
o =
case forall v. AesonKey -> KeyMap v -> Maybe v
HM.lookup AesonKey
"subdirs" Object
o of
Just Value
v' -> do
Text -> WarningParser ()
tellJSONField Text
"subdirs"
[Text]
subdirs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> Parser a
parseJSON Value
v'
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Text]
subdirs of
Maybe (NonEmpty Text)
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid empty subdirs"
Just NonEmpty Text
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> OptionalSubdirs
OSSubdirs NonEmpty Text
x
Maybe Value
Nothing -> Text -> RawPackageMetadata -> OptionalSubdirs
OSPackageMetadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"subdir" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Text
T.empty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe PackageName
-> Maybe Version
-> Maybe TreeKey
-> Maybe BlobKey
-> RawPackageMetadata
rawPackageMetadataHelper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. CabalString a -> a
unCabalString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"name"))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. CabalString a -> a
unCabalString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"version"))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"pantry-tree"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"cabal-file")
rawPackageMetadataHelper
:: Maybe PackageName
-> Maybe Version
-> Maybe TreeKey
-> Maybe BlobKey
-> RawPackageMetadata
rawPackageMetadataHelper :: Maybe PackageName
-> Maybe Version
-> Maybe TreeKey
-> Maybe BlobKey
-> RawPackageMetadata
rawPackageMetadataHelper Maybe PackageName
name Maybe Version
version Maybe TreeKey
pantryTree Maybe BlobKey
_ignoredCabalFile =
Maybe PackageName
-> Maybe Version -> Maybe TreeKey -> RawPackageMetadata
RawPackageMetadata Maybe PackageName
name Maybe Version
version Maybe TreeKey
pantryTree
repo :: Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
repo = forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"UnresolvedPackageLocationImmutable.UPLIRepo" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
(RepoType
repoType, Text
repoUrl) <-
((RepoType
RepoGit, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"git") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((RepoType
RepoHg, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hg")
Text
repoCommit <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"commit"
OptionalSubdirs
os <- Object -> WarningParser OptionalSubdirs
optionalSubdirs Object
o
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\(Text
repoSubdir, RawPackageMetadata
pm) -> Repo -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIRepo Repo {Text
RepoType
repoSubdir :: Text
repoCommit :: Text
repoUrl :: Text
repoType :: RepoType
repoType :: RepoType
repoSubdir :: Text
repoCommit :: Text
repoUrl :: Text
..} RawPackageMetadata
pm) (OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
osToRpms OptionalSubdirs
os)
archiveObject :: Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
archiveObject = forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"UnresolvedPackageLocationImmutable.RPLIArchive" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Unresolved Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation <- Object -> WarningParser (Unresolved ArchiveLocation)
parseArchiveLocationObject Object
o
Maybe SHA256
raHash <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha256"
Maybe FileSize
raSize <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"size"
OptionalSubdirs
os <- Object -> WarningParser OptionalSubdirs
optionalSubdirs Object
o
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir -> do
ArchiveLocation
raLocation <- Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation Maybe (Path Abs Dir)
mdir
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\(Text
raSubdir, RawPackageMetadata
pm) -> RawArchive -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIArchive RawArchive {Maybe SHA256
Maybe FileSize
Text
ArchiveLocation
raSubdir :: Text
raLocation :: ArchiveLocation
raSize :: Maybe FileSize
raHash :: Maybe SHA256
raSize :: Maybe FileSize
raHash :: Maybe SHA256
raSubdir :: Text
raLocation :: ArchiveLocation
..} RawPackageMetadata
pm) (OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
osToRpms OptionalSubdirs
os)
github :: Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
github = forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"PLArchive:github" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
GitHubRepo Text
ghRepo <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"github"
Text
commit <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"commit"
let raLocation :: ArchiveLocation
raLocation = Text -> ArchiveLocation
ALUrl forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ Text
"https://github.com/"
, Text
ghRepo
, Text
"/archive/"
, Text
commit
, Text
".tar.gz"
]
Maybe SHA256
raHash <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha256"
Maybe FileSize
raSize <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"size"
OptionalSubdirs
os <- Object -> WarningParser OptionalSubdirs
optionalSubdirs Object
o
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\(Text
raSubdir, RawPackageMetadata
pm) -> RawArchive -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIArchive RawArchive {Maybe SHA256
Maybe FileSize
Text
ArchiveLocation
raSubdir :: Text
raSize :: Maybe FileSize
raHash :: Maybe SHA256
raLocation :: ArchiveLocation
raSize :: Maybe FileSize
raHash :: Maybe SHA256
raSubdir :: Text
raLocation :: ArchiveLocation
..} RawPackageMetadata
pm) (OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
osToRpms OptionalSubdirs
os)
osToRpms :: OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
osToRpms :: OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
osToRpms (OSSubdirs NonEmpty Text
subdirs) = forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (, RawPackageMetadata
rpmEmpty) NonEmpty Text
subdirs
osToRpms (OSPackageMetadata Text
subdir RawPackageMetadata
rpm) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
subdir, RawPackageMetadata
rpm)
rpmEmpty :: RawPackageMetadata
rpmEmpty :: RawPackageMetadata
rpmEmpty = Maybe PackageName
-> Maybe Version -> Maybe TreeKey -> RawPackageMetadata
RawPackageMetadata forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
newtype CabalString a = CabalString { forall a. CabalString a -> a
unCabalString :: a }
deriving (Int -> CabalString a -> ShowS
forall a. Show a => Int -> CabalString a -> ShowS
forall a. Show a => [CabalString a] -> ShowS
forall a. Show a => CabalString a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CabalString a] -> ShowS
$cshowList :: forall a. Show a => [CabalString a] -> ShowS
show :: CabalString a -> [Char]
$cshow :: forall a. Show a => CabalString a -> [Char]
showsPrec :: Int -> CabalString a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CabalString a -> ShowS
Show, CabalString a -> CabalString a -> Bool
forall a. Eq a => CabalString a -> CabalString a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CabalString a -> CabalString a -> Bool
$c/= :: forall a. Eq a => CabalString a -> CabalString a -> Bool
== :: CabalString a -> CabalString a -> Bool
$c== :: forall a. Eq a => CabalString a -> CabalString a -> Bool
Eq, CabalString a -> CabalString a -> Bool
CabalString a -> CabalString a -> Ordering
CabalString a -> CabalString a -> CabalString a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (CabalString a)
forall a. Ord a => CabalString a -> CabalString a -> Bool
forall a. Ord a => CabalString a -> CabalString a -> Ordering
forall a. Ord a => CabalString a -> CabalString a -> CabalString a
min :: CabalString a -> CabalString a -> CabalString a
$cmin :: forall a. Ord a => CabalString a -> CabalString a -> CabalString a
max :: CabalString a -> CabalString a -> CabalString a
$cmax :: forall a. Ord a => CabalString a -> CabalString a -> CabalString a
>= :: CabalString a -> CabalString a -> Bool
$c>= :: forall a. Ord a => CabalString a -> CabalString a -> Bool
> :: CabalString a -> CabalString a -> Bool
$c> :: forall a. Ord a => CabalString a -> CabalString a -> Bool
<= :: CabalString a -> CabalString a -> Bool
$c<= :: forall a. Ord a => CabalString a -> CabalString a -> Bool
< :: CabalString a -> CabalString a -> Bool
$c< :: forall a. Ord a => CabalString a -> CabalString a -> Bool
compare :: CabalString a -> CabalString a -> Ordering
$ccompare :: forall a. Ord a => CabalString a -> CabalString a -> Ordering
Ord, Typeable)
toCabalStringMap :: Map a v -> Map (CabalString a) v
toCabalStringMap :: forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap = forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic forall a. a -> CabalString a
CabalString
unCabalStringMap :: Map (CabalString a) v -> Map a v
unCabalStringMap :: forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap = forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic forall a. CabalString a -> a
unCabalString
instance Distribution.Pretty.Pretty a => ToJSON (CabalString a) where
toJSON :: CabalString a -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> [Char]
Distribution.Text.display forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CabalString a -> a
unCabalString
instance Distribution.Pretty.Pretty a => ToJSONKey (CabalString a) where
toJSONKey :: ToJSONKeyFunction (CabalString a)
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> [Char]
Distribution.Text.display forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CabalString a -> a
unCabalString
instance forall a. IsCabalString a => FromJSON (CabalString a) where
parseJSON :: Value -> Parser (CabalString a)
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
name forall a b. (a -> b) -> a -> b
$ \Text
t ->
case forall a. IsCabalString a => [Char] -> Maybe a
cabalStringParser forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t of
Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid " forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t
Just a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> CabalString a
CabalString a
x
where
name :: [Char]
name = forall a (proxy :: * -> *). IsCabalString a => proxy a -> [Char]
cabalStringName (forall a. Maybe a
Nothing :: Maybe a)
instance forall a. IsCabalString a => FromJSONKey (CabalString a) where
fromJSONKey :: FromJSONKeyFunction (CabalString a)
fromJSONKey =
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser forall a b. (a -> b) -> a -> b
$ \Text
t ->
case forall a. IsCabalString a => [Char] -> Maybe a
cabalStringParser forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t of
Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid " forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t
Just a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> CabalString a
CabalString a
x
where
name :: [Char]
name = forall a (proxy :: * -> *). IsCabalString a => proxy a -> [Char]
cabalStringName (forall a. Maybe a
Nothing :: Maybe a)
class IsCabalString a where
cabalStringName :: proxy a -> String
cabalStringParser :: String -> Maybe a
instance IsCabalString PackageName where
cabalStringName :: forall (proxy :: * -> *). proxy PackageName -> [Char]
cabalStringName proxy PackageName
_ = [Char]
"package name"
cabalStringParser :: [Char] -> Maybe PackageName
cabalStringParser = [Char] -> Maybe PackageName
parsePackageName
instance IsCabalString Version where
cabalStringName :: forall (proxy :: * -> *). proxy Version -> [Char]
cabalStringName proxy Version
_ = [Char]
"version"
cabalStringParser :: [Char] -> Maybe Version
cabalStringParser = [Char] -> Maybe Version
parseVersion
instance IsCabalString VersionRange where
cabalStringName :: forall (proxy :: * -> *). proxy VersionRange -> [Char]
cabalStringName proxy VersionRange
_ = [Char]
"version range"
cabalStringParser :: [Char] -> Maybe VersionRange
cabalStringParser = [Char] -> Maybe VersionRange
parseVersionRange
instance IsCabalString PackageIdentifier where
cabalStringName :: forall (proxy :: * -> *). proxy PackageIdentifier -> [Char]
cabalStringName proxy PackageIdentifier
_ = [Char]
"package identifier"
cabalStringParser :: [Char] -> Maybe PackageIdentifier
cabalStringParser = [Char] -> Maybe PackageIdentifier
parsePackageIdentifier
instance IsCabalString FlagName where
cabalStringName :: forall (proxy :: * -> *). proxy FlagName -> [Char]
cabalStringName proxy FlagName
_ = [Char]
"flag name"
cabalStringParser :: [Char] -> Maybe FlagName
cabalStringParser = [Char] -> Maybe FlagName
parseFlagName
data HpackExecutable
= HpackBundled
| HpackCommand !FilePath
deriving (Int -> HpackExecutable -> ShowS
[HpackExecutable] -> ShowS
HpackExecutable -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HpackExecutable] -> ShowS
$cshowList :: [HpackExecutable] -> ShowS
show :: HpackExecutable -> [Char]
$cshow :: HpackExecutable -> [Char]
showsPrec :: Int -> HpackExecutable -> ShowS
$cshowsPrec :: Int -> HpackExecutable -> ShowS
Show, ReadPrec [HpackExecutable]
ReadPrec HpackExecutable
Int -> ReadS HpackExecutable
ReadS [HpackExecutable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HpackExecutable]
$creadListPrec :: ReadPrec [HpackExecutable]
readPrec :: ReadPrec HpackExecutable
$creadPrec :: ReadPrec HpackExecutable
readList :: ReadS [HpackExecutable]
$creadList :: ReadS [HpackExecutable]
readsPrec :: Int -> ReadS HpackExecutable
$creadsPrec :: Int -> ReadS HpackExecutable
Read, HpackExecutable -> HpackExecutable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HpackExecutable -> HpackExecutable -> Bool
$c/= :: HpackExecutable -> HpackExecutable -> Bool
== :: HpackExecutable -> HpackExecutable -> Bool
$c== :: HpackExecutable -> HpackExecutable -> Bool
Eq, Eq HpackExecutable
HpackExecutable -> HpackExecutable -> Bool
HpackExecutable -> HpackExecutable -> Ordering
HpackExecutable -> HpackExecutable -> HpackExecutable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HpackExecutable -> HpackExecutable -> HpackExecutable
$cmin :: HpackExecutable -> HpackExecutable -> HpackExecutable
max :: HpackExecutable -> HpackExecutable -> HpackExecutable
$cmax :: HpackExecutable -> HpackExecutable -> HpackExecutable
>= :: HpackExecutable -> HpackExecutable -> Bool
$c>= :: HpackExecutable -> HpackExecutable -> Bool
> :: HpackExecutable -> HpackExecutable -> Bool
$c> :: HpackExecutable -> HpackExecutable -> Bool
<= :: HpackExecutable -> HpackExecutable -> Bool
$c<= :: HpackExecutable -> HpackExecutable -> Bool
< :: HpackExecutable -> HpackExecutable -> Bool
$c< :: HpackExecutable -> HpackExecutable -> Bool
compare :: HpackExecutable -> HpackExecutable -> Ordering
$ccompare :: HpackExecutable -> HpackExecutable -> Ordering
Ord)
data WantedCompiler
= WCGhc !Version
| WCGhcGit !Text !Text
| WCGhcjs
!Version
!Version
deriving (Int -> WantedCompiler -> ShowS
[WantedCompiler] -> ShowS
WantedCompiler -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [WantedCompiler] -> ShowS
$cshowList :: [WantedCompiler] -> ShowS
show :: WantedCompiler -> [Char]
$cshow :: WantedCompiler -> [Char]
showsPrec :: Int -> WantedCompiler -> ShowS
$cshowsPrec :: Int -> WantedCompiler -> ShowS
Show, WantedCompiler -> WantedCompiler -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WantedCompiler -> WantedCompiler -> Bool
$c/= :: WantedCompiler -> WantedCompiler -> Bool
== :: WantedCompiler -> WantedCompiler -> Bool
$c== :: WantedCompiler -> WantedCompiler -> Bool
Eq, Eq WantedCompiler
WantedCompiler -> WantedCompiler -> Bool
WantedCompiler -> WantedCompiler -> Ordering
WantedCompiler -> WantedCompiler -> WantedCompiler
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WantedCompiler -> WantedCompiler -> WantedCompiler
$cmin :: WantedCompiler -> WantedCompiler -> WantedCompiler
max :: WantedCompiler -> WantedCompiler -> WantedCompiler
$cmax :: WantedCompiler -> WantedCompiler -> WantedCompiler
>= :: WantedCompiler -> WantedCompiler -> Bool
$c>= :: WantedCompiler -> WantedCompiler -> Bool
> :: WantedCompiler -> WantedCompiler -> Bool
$c> :: WantedCompiler -> WantedCompiler -> Bool
<= :: WantedCompiler -> WantedCompiler -> Bool
$c<= :: WantedCompiler -> WantedCompiler -> Bool
< :: WantedCompiler -> WantedCompiler -> Bool
$c< :: WantedCompiler -> WantedCompiler -> Bool
compare :: WantedCompiler -> WantedCompiler -> Ordering
$ccompare :: WantedCompiler -> WantedCompiler -> Ordering
Ord, forall x. Rep WantedCompiler x -> WantedCompiler
forall x. WantedCompiler -> Rep WantedCompiler x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WantedCompiler x -> WantedCompiler
$cfrom :: forall x. WantedCompiler -> Rep WantedCompiler x
Generic)
instance NFData WantedCompiler
instance Display WantedCompiler where
display :: WantedCompiler -> Utf8Builder
display (WCGhc Version
vghc) = Utf8Builder
"ghc-" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
vghc)
display (WCGhcjs Version
vghcjs Version
vghc) =
Utf8Builder
"ghcjs-" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
vghcjs) forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"_ghc-" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
vghc)
display (WCGhcGit Text
commit Text
flavour) =
Utf8Builder
"ghc-git-" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
commit forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"-" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
flavour
instance ToJSON WantedCompiler where
toJSON :: WantedCompiler -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display
instance FromJSON WantedCompiler where
parseJSON :: Value -> Parser WantedCompiler
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"WantedCompiler" forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either PantryException WantedCompiler
parseWantedCompiler
instance FromJSONKey WantedCompiler where
fromJSONKey :: FromJSONKeyFunction WantedCompiler
fromJSONKey =
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser forall a b. (a -> b) -> a -> b
$ \Text
t ->
case Text -> Either PantryException WantedCompiler
parseWantedCompiler Text
t of
Left PantryException
e -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid WantedCompiler " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
t forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PantryException
e
Right WantedCompiler
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure WantedCompiler
x
parseWantedCompiler :: Text -> Either PantryException WantedCompiler
parseWantedCompiler :: Text -> Either PantryException WantedCompiler
parseWantedCompiler Text
t0 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> PantryException
InvalidWantedCompiler Text
t0) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
case Text -> Text -> Maybe Text
T.stripPrefix Text
"ghcjs-" Text
t0 of
Just Text
t1 -> Text -> Maybe WantedCompiler
parseGhcjs Text
t1
Maybe Text
Nothing -> case Text -> Text -> Maybe Text
T.stripPrefix Text
"ghc-git-" Text
t0 of
Just Text
t1 -> forall {f :: * -> *}. Applicative f => Text -> f WantedCompiler
parseGhcGit Text
t1
Maybe Text
Nothing -> Text -> Text -> Maybe Text
T.stripPrefix Text
"ghc-" Text
t0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe WantedCompiler
parseGhc
where
parseGhcjs :: Text -> Maybe WantedCompiler
parseGhcjs Text
t1 = do
let (Text
ghcjsVT, Text
t2) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
'_') Text
t1
Version
ghcjsV <- [Char] -> Maybe Version
parseVersion forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
ghcjsVT
Text
ghcVT <- Text -> Text -> Maybe Text
T.stripPrefix Text
"_ghc-" Text
t2
Version
ghcV <- [Char] -> Maybe Version
parseVersion forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
ghcVT
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Version -> Version -> WantedCompiler
WCGhcjs Version
ghcjsV Version
ghcV
parseGhcGit :: Text -> f WantedCompiler
parseGhcGit Text
t1 = do
let (Text
commit, Text
flavour) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
'-') Text
t1
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> WantedCompiler
WCGhcGit Text
commit (Int -> Text -> Text
T.drop Int
1 Text
flavour)
parseGhc :: Text -> Maybe WantedCompiler
parseGhc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> WantedCompiler
WCGhc forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe Version
parseVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
instance FromJSON (WithJSONWarnings (Unresolved RawSnapshotLocation)) where
parseJSON :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
parseJSON Value
v = Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
text Value
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
obj Value
v
where
text :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
text :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
text = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"UnresolvedSnapshotLocation (Text)" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> WithJSONWarnings a
noJSONWarnings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocation
obj :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
obj :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
obj = forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"UnresolvedSnapshotLocation (Object)" forall a b. (a -> b) -> a -> b
$ \Object
o ->
((forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. WantedCompiler -> RawSnapshotLocation
RSLCompiler) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"compiler") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((\Text
x Maybe BlobKey
y -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Maybe BlobKey -> RawSnapshotLocation
RSLUrl Text
x Maybe BlobKey
y) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"url" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> WarningParser (Maybe BlobKey)
blobKey Object
o) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"filepath")
blobKey :: Object -> WarningParser (Maybe BlobKey)
blobKey Object
o = do
Maybe SHA256
msha <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha256"
Maybe FileSize
msize <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"size"
case (Maybe SHA256
msha, Maybe FileSize
msize) of
(Maybe SHA256
Nothing, Maybe FileSize
Nothing) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
(Just SHA256
sha, Just FileSize
size') -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SHA256 -> FileSize -> BlobKey
BlobKey SHA256
sha FileSize
size'
(Just SHA256
_sha, Maybe FileSize
Nothing) -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"You must also specify the file size"
(Maybe SHA256
Nothing, Just FileSize
_) -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"You must also specify the file's SHA256"
instance Display SnapshotLocation where
display :: SnapshotLocation -> Utf8Builder
display (SLCompiler WantedCompiler
compiler) = forall a. Display a => a -> Utf8Builder
display WantedCompiler
compiler
display (SLUrl Text
url BlobKey
blob) = forall a. Display a => a -> Utf8Builder
display Text
url forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" (" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display BlobKey
blob forall a. Semigroup a => a -> a -> a
<> Utf8Builder
")"
display (SLFilePath ResolvedPath File
resolved) = forall a. Display a => a -> Utf8Builder
display (forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved)
parseRawSnapshotLocation :: Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocation :: Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocation Text
t0 = forall a. a -> Maybe a -> a
fromMaybe (Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath Text
t0) forall a b. (a -> b) -> a -> b
$
(forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. WantedCompiler -> RawSnapshotLocation
RSLCompiler) (Text -> Either PantryException WantedCompiler
parseWantedCompiler Text
t0)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapName -> RawSnapshotLocation
RSLSynonym forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => Text -> m SnapName
parseSnapName Text
t0) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Maybe (Unresolved RawSnapshotLocation)
parseGitHub forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Maybe (Unresolved RawSnapshotLocation)
parseUrl
where
parseGitHub :: Maybe (Unresolved RawSnapshotLocation)
parseGitHub = do
Text
t1 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"github:" Text
t0
let (Text
user, Text
t2) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
'/') Text
t1
Text
t3 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"/" Text
t2
let (Text
repo, Text
t4) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
':') Text
t3
Text
path <- Text -> Text -> Maybe Text
T.stripPrefix Text
":" Text
t4
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RawSnapshotLocation
githubSnapshotLocation Text
user Text
repo Text
path
parseUrl :: Maybe (Unresolved RawSnapshotLocation)
parseUrl = forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest (Text -> [Char]
T.unpack Text
t0) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe BlobKey -> RawSnapshotLocation
RSLUrl Text
t0 forall a. Maybe a
Nothing)
parseRawSnapshotLocationPath :: Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath :: Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath Text
t =
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir ->
case Maybe (Path Abs Dir)
mdir of
Maybe (Path Abs Dir)
Nothing -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> PantryException
InvalidFilePathSnapshot Text
t
Just Path Abs Dir
dir -> do
Path Abs File
abs' <- forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> [Char] -> m (Path Abs File)
resolveFile Path Abs Dir
dir (Text -> [Char]
T.unpack Text
t) forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
_ -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Path Abs Dir -> Text -> PantryException
InvalidSnapshotLocation Path Abs Dir
dir Text
t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> RawSnapshotLocation
RSLFilePath forall a b. (a -> b) -> a -> b
$ forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath Text
t) Path Abs File
abs'
githubSnapshotLocation :: Text -> Text -> Text -> RawSnapshotLocation
githubSnapshotLocation :: Text -> Text -> Text -> RawSnapshotLocation
githubSnapshotLocation Text
user Text
repo Text
path =
let url :: Text
url = [Text] -> Text
T.concat
[ Text
"https://raw.githubusercontent.com/"
, Text
user
, Text
"/"
, Text
repo
, Text
"/master/"
, Text
path
]
in Text -> Maybe BlobKey -> RawSnapshotLocation
RSLUrl Text
url forall a. Maybe a
Nothing
defUser :: Text
defUser :: Text
defUser = Text
"commercialhaskell"
defRepo :: Text
defRepo :: Text
defRepo = Text
"stackage-snapshots"
defaultSnapshotLocation
:: SnapName
-> RawSnapshotLocation
defaultSnapshotLocation :: SnapName -> RawSnapshotLocation
defaultSnapshotLocation (LTS Int
x Int
y) =
Text -> Text -> Text -> RawSnapshotLocation
githubSnapshotLocation Text
defUser Text
defRepo forall a b. (a -> b) -> a -> b
$
Utf8Builder -> Text
utf8BuilderToText forall a b. (a -> b) -> a -> b
$
Utf8Builder
"lts/" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Int
x forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"/" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Int
y forall a. Semigroup a => a -> a -> a
<> Utf8Builder
".yaml"
defaultSnapshotLocation (Nightly Day
date) =
Text -> Text -> Text -> RawSnapshotLocation
githubSnapshotLocation Text
defUser Text
defRepo forall a b. (a -> b) -> a -> b
$
Utf8Builder -> Text
utf8BuilderToText forall a b. (a -> b) -> a -> b
$
Utf8Builder
"nightly/" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Year
year forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"/" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Int
month forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"/" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Int
day forall a. Semigroup a => a -> a -> a
<> Utf8Builder
".yaml"
where
(Year
year, Int
month, Int
day) = Day -> (Year, Int, Int)
toGregorian Day
date
data SnapName
= LTS
!Int
!Int
| Nightly !Day
deriving (SnapName -> SnapName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapName -> SnapName -> Bool
$c/= :: SnapName -> SnapName -> Bool
== :: SnapName -> SnapName -> Bool
$c== :: SnapName -> SnapName -> Bool
Eq, Eq SnapName
SnapName -> SnapName -> Bool
SnapName -> SnapName -> Ordering
SnapName -> SnapName -> SnapName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SnapName -> SnapName -> SnapName
$cmin :: SnapName -> SnapName -> SnapName
max :: SnapName -> SnapName -> SnapName
$cmax :: SnapName -> SnapName -> SnapName
>= :: SnapName -> SnapName -> Bool
$c>= :: SnapName -> SnapName -> Bool
> :: SnapName -> SnapName -> Bool
$c> :: SnapName -> SnapName -> Bool
<= :: SnapName -> SnapName -> Bool
$c<= :: SnapName -> SnapName -> Bool
< :: SnapName -> SnapName -> Bool
$c< :: SnapName -> SnapName -> Bool
compare :: SnapName -> SnapName -> Ordering
$ccompare :: SnapName -> SnapName -> Ordering
Ord, forall x. Rep SnapName x -> SnapName
forall x. SnapName -> Rep SnapName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SnapName x -> SnapName
$cfrom :: forall x. SnapName -> Rep SnapName x
Generic)
instance NFData SnapName
instance Display SnapName where
display :: SnapName -> Utf8Builder
display (LTS Int
x Int
y) = Utf8Builder
"lts-" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Int
x forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"." forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Int
y
display (Nightly Day
date) = Utf8Builder
"nightly-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow Day
date
instance Show SnapName where
show :: SnapName -> [Char]
show = Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display
instance ToJSON SnapName where
toJSON :: SnapName -> Value
toJSON SnapName
syn = Text -> Value
String forall a b. (a -> b) -> a -> b
$ Utf8Builder -> Text
utf8BuilderToText forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Utf8Builder
display SnapName
syn
parseSnapName :: MonadThrow m => Text -> m SnapName
parseSnapName :: forall (m :: * -> *). MonadThrow m => Text -> m SnapName
parseSnapName Text
t0 =
case Maybe SnapName
lts forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SnapName
nightly of
Maybe SnapName
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> PantryException
ParseSnapNameException Text
t0
Just SnapName
sn -> forall (m :: * -> *) a. Monad m => a -> m a
return SnapName
sn
where
lts :: Maybe SnapName
lts = do
Text
t1 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"lts-" Text
t0
Right (Int
x, Text
t2) <- forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Reader a
decimal Text
t1
Text
t3 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"." Text
t2
Right (Int
y, Text
"") <- forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Reader a
decimal Text
t3
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> SnapName
LTS Int
x Int
y
nightly :: Maybe SnapName
nightly = do
Text
t1 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"nightly-" Text
t0
Day -> SnapName
Nightly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
t1)
data RawSnapshotLocation
= RSLCompiler !WantedCompiler
| RSLUrl !Text !(Maybe BlobKey)
| RSLFilePath !(ResolvedPath File)
| RSLSynonym !SnapName
deriving (Int -> RawSnapshotLocation -> ShowS
[RawSnapshotLocation] -> ShowS
RawSnapshotLocation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RawSnapshotLocation] -> ShowS
$cshowList :: [RawSnapshotLocation] -> ShowS
show :: RawSnapshotLocation -> [Char]
$cshow :: RawSnapshotLocation -> [Char]
showsPrec :: Int -> RawSnapshotLocation -> ShowS
$cshowsPrec :: Int -> RawSnapshotLocation -> ShowS
Show, RawSnapshotLocation -> RawSnapshotLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
$c/= :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
== :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
$c== :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
Eq, Eq RawSnapshotLocation
RawSnapshotLocation -> RawSnapshotLocation -> Bool
RawSnapshotLocation -> RawSnapshotLocation -> Ordering
RawSnapshotLocation -> RawSnapshotLocation -> RawSnapshotLocation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RawSnapshotLocation -> RawSnapshotLocation -> RawSnapshotLocation
$cmin :: RawSnapshotLocation -> RawSnapshotLocation -> RawSnapshotLocation
max :: RawSnapshotLocation -> RawSnapshotLocation -> RawSnapshotLocation
$cmax :: RawSnapshotLocation -> RawSnapshotLocation -> RawSnapshotLocation
>= :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
$c>= :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
> :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
$c> :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
<= :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
$c<= :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
< :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
$c< :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
compare :: RawSnapshotLocation -> RawSnapshotLocation -> Ordering
$ccompare :: RawSnapshotLocation -> RawSnapshotLocation -> Ordering
Ord, forall x. Rep RawSnapshotLocation x -> RawSnapshotLocation
forall x. RawSnapshotLocation -> Rep RawSnapshotLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RawSnapshotLocation x -> RawSnapshotLocation
$cfrom :: forall x. RawSnapshotLocation -> Rep RawSnapshotLocation x
Generic)
instance NFData RawSnapshotLocation
instance Display RawSnapshotLocation where
display :: RawSnapshotLocation -> Utf8Builder
display (RSLCompiler WantedCompiler
compiler) = forall a. Display a => a -> Utf8Builder
display WantedCompiler
compiler
display (RSLUrl Text
url Maybe BlobKey
Nothing) = forall a. Display a => a -> Utf8Builder
display Text
url
display (RSLUrl Text
url (Just BlobKey
blob)) = forall a. Display a => a -> Utf8Builder
display Text
url forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" (" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display BlobKey
blob forall a. Semigroup a => a -> a -> a
<> Utf8Builder
")"
display (RSLFilePath ResolvedPath File
resolved) = forall a. Display a => a -> Utf8Builder
display (forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved)
display (RSLSynonym SnapName
syn) = forall a. Display a => a -> Utf8Builder
display SnapName
syn
instance Pretty RawSnapshotLocation where
pretty :: RawSnapshotLocation -> StyleDoc
pretty (RSLCompiler WantedCompiler
compiler) = forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay WantedCompiler
compiler
pretty (RSLUrl Text
url Maybe BlobKey
Nothing) = Style -> StyleDoc -> StyleDoc
style Style
Url (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url)
pretty (RSLUrl Text
url (Just BlobKey
blob)) = [StyleDoc] -> StyleDoc
fillSep
[ Style -> StyleDoc -> StyleDoc
style Style
Url (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url)
, StyleDoc -> StyleDoc
parens (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay BlobKey
blob)
]
pretty (RSLFilePath ResolvedPath File
resolved) =
Style -> StyleDoc -> StyleDoc
style Style
File (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay (forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved))
pretty (RSLSynonym SnapName
syn) =
Style -> StyleDoc -> StyleDoc
style Style
Shell (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Text
textDisplay SnapName
syn)
instance ToJSON RawSnapshotLocation where
toJSON :: RawSnapshotLocation -> Value
toJSON (RSLCompiler WantedCompiler
compiler) = [(AesonKey, Value)] -> Value
object [AesonKey
"compiler" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= WantedCompiler
compiler]
toJSON (RSLUrl Text
url Maybe BlobKey
mblob) = [(AesonKey, Value)] -> Value
object
forall a b. (a -> b) -> a -> b
$ AesonKey
"url" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= Text
url
forall a. a -> [a] -> [a]
: forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] BlobKey -> [(AesonKey, Value)]
blobKeyPairs Maybe BlobKey
mblob
toJSON (RSLFilePath ResolvedPath File
resolved) = [(AesonKey, Value)] -> Value
object [AesonKey
"filepath" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved]
toJSON (RSLSynonym SnapName
syn) = forall a. ToJSON a => a -> Value
toJSON SnapName
syn
data SnapshotLocation
= SLCompiler !WantedCompiler
| SLUrl !Text !BlobKey
| SLFilePath !(ResolvedPath File)
deriving (Int -> SnapshotLocation -> ShowS
[SnapshotLocation] -> ShowS
SnapshotLocation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotLocation] -> ShowS
$cshowList :: [SnapshotLocation] -> ShowS
show :: SnapshotLocation -> [Char]
$cshow :: SnapshotLocation -> [Char]
showsPrec :: Int -> SnapshotLocation -> ShowS
$cshowsPrec :: Int -> SnapshotLocation -> ShowS
Show, SnapshotLocation -> SnapshotLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotLocation -> SnapshotLocation -> Bool
$c/= :: SnapshotLocation -> SnapshotLocation -> Bool
== :: SnapshotLocation -> SnapshotLocation -> Bool
$c== :: SnapshotLocation -> SnapshotLocation -> Bool
Eq, Eq SnapshotLocation
SnapshotLocation -> SnapshotLocation -> Bool
SnapshotLocation -> SnapshotLocation -> Ordering
SnapshotLocation -> SnapshotLocation -> SnapshotLocation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SnapshotLocation -> SnapshotLocation -> SnapshotLocation
$cmin :: SnapshotLocation -> SnapshotLocation -> SnapshotLocation
max :: SnapshotLocation -> SnapshotLocation -> SnapshotLocation
$cmax :: SnapshotLocation -> SnapshotLocation -> SnapshotLocation
>= :: SnapshotLocation -> SnapshotLocation -> Bool
$c>= :: SnapshotLocation -> SnapshotLocation -> Bool
> :: SnapshotLocation -> SnapshotLocation -> Bool
$c> :: SnapshotLocation -> SnapshotLocation -> Bool
<= :: SnapshotLocation -> SnapshotLocation -> Bool
$c<= :: SnapshotLocation -> SnapshotLocation -> Bool
< :: SnapshotLocation -> SnapshotLocation -> Bool
$c< :: SnapshotLocation -> SnapshotLocation -> Bool
compare :: SnapshotLocation -> SnapshotLocation -> Ordering
$ccompare :: SnapshotLocation -> SnapshotLocation -> Ordering
Ord, forall x. Rep SnapshotLocation x -> SnapshotLocation
forall x. SnapshotLocation -> Rep SnapshotLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SnapshotLocation x -> SnapshotLocation
$cfrom :: forall x. SnapshotLocation -> Rep SnapshotLocation x
Generic)
instance NFData SnapshotLocation
instance ToJSON SnapshotLocation where
toJSON :: SnapshotLocation -> Value
toJSON SnapshotLocation
sl = forall a. ToJSON a => a -> Value
toJSON (SnapshotLocation -> RawSnapshotLocation
toRawSL SnapshotLocation
sl)
instance FromJSON (WithJSONWarnings (Unresolved SnapshotLocation)) where
parseJSON :: Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
parseJSON Value
v = Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
file Value
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
url Value
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
compiler Value
v
where
file :: Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
file = forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"SLFilepath" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Text
ufp <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"filepath"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir ->
case Maybe (Path Abs Dir)
mdir of
Maybe (Path Abs Dir)
Nothing -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> PantryException
InvalidFilePathSnapshot Text
ufp
Just Path Abs Dir
dir -> do
Path Abs File
absolute <- forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> [Char] -> m (Path Abs File)
resolveFile Path Abs Dir
dir (Text -> [Char]
T.unpack Text
ufp)
let fp :: ResolvedPath File
fp = forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath Text
ufp) Path Abs File
absolute
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> SnapshotLocation
SLFilePath ResolvedPath File
fp
url :: Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
url = forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"SLUrl" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Text
url' <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"url"
SHA256
sha <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"sha256"
FileSize
size <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"size"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> BlobKey -> SnapshotLocation
SLUrl Text
url' (SHA256 -> FileSize -> BlobKey
BlobKey SHA256
sha FileSize
size)
compiler :: Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
compiler = forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"SLCompiler" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
WantedCompiler
c <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"compiler"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ WantedCompiler -> SnapshotLocation
SLCompiler WantedCompiler
c
toRawSL :: SnapshotLocation -> RawSnapshotLocation
toRawSL :: SnapshotLocation -> RawSnapshotLocation
toRawSL (SLCompiler WantedCompiler
c) = WantedCompiler -> RawSnapshotLocation
RSLCompiler WantedCompiler
c
toRawSL (SLUrl Text
url BlobKey
blob) = Text -> Maybe BlobKey -> RawSnapshotLocation
RSLUrl Text
url (forall a. a -> Maybe a
Just BlobKey
blob)
toRawSL (SLFilePath ResolvedPath File
fp) = ResolvedPath File -> RawSnapshotLocation
RSLFilePath ResolvedPath File
fp
data RawSnapshot = RawSnapshot
{ RawSnapshot -> WantedCompiler
rsCompiler :: !WantedCompiler
, RawSnapshot -> Map PackageName RawSnapshotPackage
rsPackages :: !(Map PackageName RawSnapshotPackage)
, RawSnapshot -> Set PackageName
rsDrop :: !(Set PackageName)
}
data Snapshot = Snapshot
{ Snapshot -> WantedCompiler
snapshotCompiler :: !WantedCompiler
, Snapshot -> Map PackageName SnapshotPackage
snapshotPackages :: !(Map PackageName SnapshotPackage)
, Snapshot -> Set PackageName
snapshotDrop :: !(Set PackageName)
}
data RawSnapshotPackage = RawSnapshotPackage
{ RawSnapshotPackage -> RawPackageLocationImmutable
rspLocation :: !RawPackageLocationImmutable
, RawSnapshotPackage -> Map FlagName Bool
rspFlags :: !(Map FlagName Bool)
, RawSnapshotPackage -> Bool
rspHidden :: !Bool
, RawSnapshotPackage -> [Text]
rspGhcOptions :: ![Text]
}
data SnapshotPackage = SnapshotPackage
{ SnapshotPackage -> PackageLocationImmutable
spLocation :: !PackageLocationImmutable
, SnapshotPackage -> Map FlagName Bool
spFlags :: !(Map FlagName Bool)
, SnapshotPackage -> Bool
spHidden :: !Bool
, SnapshotPackage -> [Text]
spGhcOptions :: ![Text]
}
deriving Int -> SnapshotPackage -> ShowS
[SnapshotPackage] -> ShowS
SnapshotPackage -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotPackage] -> ShowS
$cshowList :: [SnapshotPackage] -> ShowS
show :: SnapshotPackage -> [Char]
$cshow :: SnapshotPackage -> [Char]
showsPrec :: Int -> SnapshotPackage -> ShowS
$cshowsPrec :: Int -> SnapshotPackage -> ShowS
Show
data RawSnapshotLayer = RawSnapshotLayer
{ RawSnapshotLayer -> RawSnapshotLocation
rslParent :: !RawSnapshotLocation
, RawSnapshotLayer -> Maybe WantedCompiler
rslCompiler :: !(Maybe WantedCompiler)
, RawSnapshotLayer -> [RawPackageLocationImmutable]
rslLocations :: ![RawPackageLocationImmutable]
, RawSnapshotLayer -> Set PackageName
rslDropPackages :: !(Set PackageName)
, RawSnapshotLayer -> Map PackageName (Map FlagName Bool)
rslFlags :: !(Map PackageName (Map FlagName Bool))
, RawSnapshotLayer -> Map PackageName Bool
rslHidden :: !(Map PackageName Bool)
, RawSnapshotLayer -> Map PackageName [Text]
rslGhcOptions :: !(Map PackageName [Text])
, RawSnapshotLayer -> Maybe UTCTime
rslPublishTime :: !(Maybe UTCTime)
}
deriving (Int -> RawSnapshotLayer -> ShowS
[RawSnapshotLayer] -> ShowS
RawSnapshotLayer -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RawSnapshotLayer] -> ShowS
$cshowList :: [RawSnapshotLayer] -> ShowS
show :: RawSnapshotLayer -> [Char]
$cshow :: RawSnapshotLayer -> [Char]
showsPrec :: Int -> RawSnapshotLayer -> ShowS
$cshowsPrec :: Int -> RawSnapshotLayer -> ShowS
Show, RawSnapshotLayer -> RawSnapshotLayer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawSnapshotLayer -> RawSnapshotLayer -> Bool
$c/= :: RawSnapshotLayer -> RawSnapshotLayer -> Bool
== :: RawSnapshotLayer -> RawSnapshotLayer -> Bool
$c== :: RawSnapshotLayer -> RawSnapshotLayer -> Bool
Eq, forall x. Rep RawSnapshotLayer x -> RawSnapshotLayer
forall x. RawSnapshotLayer -> Rep RawSnapshotLayer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RawSnapshotLayer x -> RawSnapshotLayer
$cfrom :: forall x. RawSnapshotLayer -> Rep RawSnapshotLayer x
Generic)
instance NFData RawSnapshotLayer
instance ToJSON RawSnapshotLayer where
toJSON :: RawSnapshotLayer -> Value
toJSON RawSnapshotLayer
rsnap = [(AesonKey, Value)] -> Value
object forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [AesonKey
"resolver" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= RawSnapshotLayer -> RawSnapshotLocation
rslParent RawSnapshotLayer
rsnap]
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\WantedCompiler
compiler -> [AesonKey
"compiler" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= WantedCompiler
compiler]) (RawSnapshotLayer -> Maybe WantedCompiler
rslCompiler RawSnapshotLayer
rsnap)
, [AesonKey
"packages" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= RawSnapshotLayer -> [RawPackageLocationImmutable]
rslLocations RawSnapshotLayer
rsnap]
, if forall a. Set a -> Bool
Set.null (RawSnapshotLayer -> Set PackageName
rslDropPackages RawSnapshotLayer
rsnap)
then []
else [AesonKey
"drop-packages" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall a. a -> CabalString a
CabalString (RawSnapshotLayer -> Set PackageName
rslDropPackages RawSnapshotLayer
rsnap)]
, if forall k a. Map k a -> Bool
Map.null (RawSnapshotLayer -> Map PackageName (Map FlagName Bool)
rslFlags RawSnapshotLayer
rsnap)
then []
else [AesonKey
"flags" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (RawSnapshotLayer -> Map PackageName (Map FlagName Bool)
rslFlags RawSnapshotLayer
rsnap))]
, if forall k a. Map k a -> Bool
Map.null (RawSnapshotLayer -> Map PackageName Bool
rslHidden RawSnapshotLayer
rsnap)
then []
else [AesonKey
"hidden" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (RawSnapshotLayer -> Map PackageName Bool
rslHidden RawSnapshotLayer
rsnap)]
, if forall k a. Map k a -> Bool
Map.null (RawSnapshotLayer -> Map PackageName [Text]
rslGhcOptions RawSnapshotLayer
rsnap)
then []
else [AesonKey
"ghc-options" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (RawSnapshotLayer -> Map PackageName [Text]
rslGhcOptions RawSnapshotLayer
rsnap)]
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\UTCTime
time -> [AesonKey
"publish-time" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= UTCTime
time]) (RawSnapshotLayer -> Maybe UTCTime
rslPublishTime RawSnapshotLayer
rsnap)
]
instance FromJSON (WithJSONWarnings (Unresolved RawSnapshotLayer)) where
parseJSON :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
parseJSON = forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"Snapshot" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Maybe Text
_ :: Maybe Text <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"name"
Maybe WantedCompiler
mcompiler <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"compiler"
Maybe (Unresolved RawSnapshotLocation)
mresolver <- forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT forall a b. (a -> b) -> a -> b
$ Object
o forall a. FromJSON a => Object -> [Text] -> WarningParser (Maybe a)
...:? [Text
"snapshot", Text
"resolver"]
Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
unresolvedSnapshotParent <-
case (Maybe WantedCompiler
mcompiler, Maybe (Unresolved RawSnapshotLocation)
mresolver) of
(Maybe WantedCompiler
Nothing, Maybe (Unresolved RawSnapshotLocation)
Nothing) -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Snapshot must have either resolver or compiler"
(Just WantedCompiler
compiler, Maybe (Unresolved RawSnapshotLocation)
Nothing) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (WantedCompiler -> RawSnapshotLocation
RSLCompiler WantedCompiler
compiler, forall a. Maybe a
Nothing)
(Maybe WantedCompiler
_, Just (Unresolved Maybe (Path Abs Dir) -> IO RawSnapshotLocation
usl)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir -> do
RawSnapshotLocation
sl <- Maybe (Path Abs Dir) -> IO RawSnapshotLocation
usl Maybe (Path Abs Dir)
mdir
case (RawSnapshotLocation
sl, Maybe WantedCompiler
mcompiler) of
(RSLCompiler WantedCompiler
c1, Just WantedCompiler
c2) -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ WantedCompiler -> WantedCompiler -> PantryException
InvalidOverrideCompiler WantedCompiler
c1 WantedCompiler
c2
(RawSnapshotLocation, Maybe WantedCompiler)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation
sl, Maybe WantedCompiler
mcompiler)
[Unresolved (NonEmpty RawPackageLocationImmutable)]
unresolvedLocs <- forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT (Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"packages" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= [])
Set PackageName
rslDropPackages <- forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall a. CabalString a -> a
unCabalString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"drop-packages" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= forall a. Set a
Set.empty)
Map PackageName (Map FlagName Bool)
rslFlags <- (forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"flags" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= forall k a. Map k a
Map.empty)
Map PackageName Bool
rslHidden <- forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"hidden" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= forall k a. Map k a
Map.empty)
Map PackageName [Text]
rslGhcOptions <- forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"ghc-options" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= forall k a. Map k a
Map.empty)
Maybe UTCTime
rslPublishTime <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"publish-time"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (\[RawPackageLocationImmutable]
rslLocations (RawSnapshotLocation
rslParent, Maybe WantedCompiler
rslCompiler) -> RawSnapshotLayer {[RawPackageLocationImmutable]
Maybe UTCTime
Maybe WantedCompiler
Set PackageName
Map PackageName Bool
Map PackageName [Text]
Map PackageName (Map FlagName Bool)
RawSnapshotLocation
rslCompiler :: Maybe WantedCompiler
rslParent :: RawSnapshotLocation
rslLocations :: [RawPackageLocationImmutable]
rslPublishTime :: Maybe UTCTime
rslGhcOptions :: Map PackageName [Text]
rslHidden :: Map PackageName Bool
rslFlags :: Map PackageName (Map FlagName Bool)
rslDropPackages :: Set PackageName
rslPublishTime :: Maybe UTCTime
rslGhcOptions :: Map PackageName [Text]
rslHidden :: Map PackageName Bool
rslFlags :: Map PackageName (Map FlagName Bool)
rslDropPackages :: Set PackageName
rslLocations :: [RawPackageLocationImmutable]
rslCompiler :: Maybe WantedCompiler
rslParent :: RawSnapshotLocation
..})
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. NonEmpty a -> [a]
NE.toList) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Unresolved (NonEmpty RawPackageLocationImmutable)]
unresolvedLocs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
unresolvedSnapshotParent
data SnapshotLayer = SnapshotLayer
{ SnapshotLayer -> SnapshotLocation
slParent :: !SnapshotLocation
, SnapshotLayer -> Maybe WantedCompiler
slCompiler :: !(Maybe WantedCompiler)
, SnapshotLayer -> [PackageLocationImmutable]
slLocations :: ![PackageLocationImmutable]
, SnapshotLayer -> Set PackageName
slDropPackages :: !(Set PackageName)
, SnapshotLayer -> Map PackageName (Map FlagName Bool)
slFlags :: !(Map PackageName (Map FlagName Bool))
, SnapshotLayer -> Map PackageName Bool
slHidden :: !(Map PackageName Bool)
, SnapshotLayer -> Map PackageName [Text]
slGhcOptions :: !(Map PackageName [Text])
, SnapshotLayer -> Maybe UTCTime
slPublishTime :: !(Maybe UTCTime)
}
deriving (Int -> SnapshotLayer -> ShowS
[SnapshotLayer] -> ShowS
SnapshotLayer -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotLayer] -> ShowS
$cshowList :: [SnapshotLayer] -> ShowS
show :: SnapshotLayer -> [Char]
$cshow :: SnapshotLayer -> [Char]
showsPrec :: Int -> SnapshotLayer -> ShowS
$cshowsPrec :: Int -> SnapshotLayer -> ShowS
Show, SnapshotLayer -> SnapshotLayer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotLayer -> SnapshotLayer -> Bool
$c/= :: SnapshotLayer -> SnapshotLayer -> Bool
== :: SnapshotLayer -> SnapshotLayer -> Bool
$c== :: SnapshotLayer -> SnapshotLayer -> Bool
Eq, forall x. Rep SnapshotLayer x -> SnapshotLayer
forall x. SnapshotLayer -> Rep SnapshotLayer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SnapshotLayer x -> SnapshotLayer
$cfrom :: forall x. SnapshotLayer -> Rep SnapshotLayer x
Generic)
instance ToJSON SnapshotLayer where
toJSON :: SnapshotLayer -> Value
toJSON SnapshotLayer
snap = [(AesonKey, Value)] -> Value
object forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [AesonKey
"resolver" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= SnapshotLayer -> SnapshotLocation
slParent SnapshotLayer
snap]
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\WantedCompiler
compiler -> [AesonKey
"compiler" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= WantedCompiler
compiler]) (SnapshotLayer -> Maybe WantedCompiler
slCompiler SnapshotLayer
snap)
, [AesonKey
"packages" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= SnapshotLayer -> [PackageLocationImmutable]
slLocations SnapshotLayer
snap]
, if forall a. Set a -> Bool
Set.null (SnapshotLayer -> Set PackageName
slDropPackages SnapshotLayer
snap) then [] else [AesonKey
"drop-packages" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall a. a -> CabalString a
CabalString (SnapshotLayer -> Set PackageName
slDropPackages SnapshotLayer
snap)]
, if forall k a. Map k a -> Bool
Map.null (SnapshotLayer -> Map PackageName (Map FlagName Bool)
slFlags SnapshotLayer
snap) then [] else [AesonKey
"flags" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (SnapshotLayer -> Map PackageName (Map FlagName Bool)
slFlags SnapshotLayer
snap))]
, if forall k a. Map k a -> Bool
Map.null (SnapshotLayer -> Map PackageName Bool
slHidden SnapshotLayer
snap) then [] else [AesonKey
"hidden" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (SnapshotLayer -> Map PackageName Bool
slHidden SnapshotLayer
snap)]
, if forall k a. Map k a -> Bool
Map.null (SnapshotLayer -> Map PackageName [Text]
slGhcOptions SnapshotLayer
snap) then [] else [AesonKey
"ghc-options" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (SnapshotLayer -> Map PackageName [Text]
slGhcOptions SnapshotLayer
snap)]
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\UTCTime
time -> [AesonKey
"publish-time" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= UTCTime
time]) (SnapshotLayer -> Maybe UTCTime
slPublishTime SnapshotLayer
snap)
]
toRawSnapshotLayer :: SnapshotLayer -> RawSnapshotLayer
toRawSnapshotLayer :: SnapshotLayer -> RawSnapshotLayer
toRawSnapshotLayer SnapshotLayer
sl = RawSnapshotLayer
{ rslParent :: RawSnapshotLocation
rslParent = SnapshotLocation -> RawSnapshotLocation
toRawSL (SnapshotLayer -> SnapshotLocation
slParent SnapshotLayer
sl)
, rslCompiler :: Maybe WantedCompiler
rslCompiler = SnapshotLayer -> Maybe WantedCompiler
slCompiler SnapshotLayer
sl
, rslLocations :: [RawPackageLocationImmutable]
rslLocations = forall a b. (a -> b) -> [a] -> [b]
map PackageLocationImmutable -> RawPackageLocationImmutable
toRawPLI (SnapshotLayer -> [PackageLocationImmutable]
slLocations SnapshotLayer
sl)
, rslDropPackages :: Set PackageName
rslDropPackages = SnapshotLayer -> Set PackageName
slDropPackages SnapshotLayer
sl
, rslFlags :: Map PackageName (Map FlagName Bool)
rslFlags = SnapshotLayer -> Map PackageName (Map FlagName Bool)
slFlags SnapshotLayer
sl
, rslHidden :: Map PackageName Bool
rslHidden = SnapshotLayer -> Map PackageName Bool
slHidden SnapshotLayer
sl
, rslGhcOptions :: Map PackageName [Text]
rslGhcOptions = SnapshotLayer -> Map PackageName [Text]
slGhcOptions SnapshotLayer
sl
, rslPublishTime :: Maybe UTCTime
rslPublishTime = SnapshotLayer -> Maybe UTCTime
slPublishTime SnapshotLayer
sl
}
newtype SnapshotCacheHash = SnapshotCacheHash { SnapshotCacheHash -> SHA256
unSnapshotCacheHash :: SHA256}
deriving (Int -> SnapshotCacheHash -> ShowS
[SnapshotCacheHash] -> ShowS
SnapshotCacheHash -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotCacheHash] -> ShowS
$cshowList :: [SnapshotCacheHash] -> ShowS
show :: SnapshotCacheHash -> [Char]
$cshow :: SnapshotCacheHash -> [Char]
showsPrec :: Int -> SnapshotCacheHash -> ShowS
$cshowsPrec :: Int -> SnapshotCacheHash -> ShowS
Show)
getGlobalHintsFile :: HasPantryConfig env => RIO env (Path Abs File)
getGlobalHintsFile :: forall env. HasPantryConfig env => RIO env (Path Abs File)
getGlobalHintsFile = do
Path Abs Dir
root <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to PantryConfig -> Path Abs Dir
pcRootDir
Path Rel File
globalHintsRelFile <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile [Char]
"global-hints-cache.yaml"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
globalHintsRelFile
bsToBlobKey :: ByteString -> BlobKey
bsToBlobKey :: ByteString -> BlobKey
bsToBlobKey ByteString
bs =
SHA256 -> FileSize -> BlobKey
BlobKey (ByteString -> SHA256
SHA256.hashBytes ByteString
bs) (Word -> FileSize
FileSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)))
warnMissingCabalFile :: HasLogFunc env => RawPackageLocationImmutable -> RIO env ()
warnMissingCabalFile :: forall env.
HasLogFunc env =>
RawPackageLocationImmutable -> RIO env ()
warnMissingCabalFile RawPackageLocationImmutable
loc =
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$
Utf8Builder
"DEPRECATED: The package at " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" does not include a cabal file.\n" forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"Instead, it includes an hpack package.yaml file for generating a cabal file.\n" forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"This usage is deprecated; please see https://github.com/commercialhaskell/stack/issues/5210.\n" forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"Support for this workflow will be removed in the future.\n"