{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-}
module Pantry.Types
( PantryConfig (..)
, HackageSecurityConfig (..)
, 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 (..)
, 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
) 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)
import RIO.Time (toGregorian, Day, UTCTime)
import qualified RIO.Map as Map
import qualified RIO.HashMap as HM
import qualified Data.Map.Strict as Map (mapKeysMonotonic)
import qualified RIO.Set as Set
import Data.Aeson.Types (toJSONKeyText, Parser)
import Pantry.Internal.AesonExtended
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 (CabalSpecVersion (..), cabalSpecLatest)
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 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)
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 -> String
(Int -> Package -> ShowS)
-> (Package -> String) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Package] -> ShowS
$cshowList :: [Package] -> ShowS
show :: Package -> String
$cshow :: Package -> String
showsPrec :: Int -> Package -> ShowS
$cshowsPrec :: Int -> Package -> ShowS
Show, Package -> Package -> Bool
(Package -> Package -> Bool)
-> (Package -> Package -> Bool) -> Eq Package
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)
data PHpack = PHpack
{
PHpack -> TreeEntry
phOriginal :: !TreeEntry,
PHpack -> TreeEntry
phGenerated :: !TreeEntry,
PHpack -> Version
phVersion :: !Version
} deriving (Int -> PHpack -> ShowS
[PHpack] -> ShowS
PHpack -> String
(Int -> PHpack -> ShowS)
-> (PHpack -> String) -> ([PHpack] -> ShowS) -> Show PHpack
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PHpack] -> ShowS
$cshowList :: [PHpack] -> ShowS
show :: PHpack -> String
$cshow :: PHpack -> String
showsPrec :: Int -> PHpack -> ShowS
$cshowsPrec :: Int -> PHpack -> ShowS
Show, PHpack -> PHpack -> Bool
(PHpack -> PHpack -> Bool)
-> (PHpack -> PHpack -> Bool) -> Eq PHpack
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)
data PackageCabal = PCCabalFile !TreeEntry
| PCHpack !PHpack
deriving (Int -> PackageCabal -> ShowS
[PackageCabal] -> ShowS
PackageCabal -> String
(Int -> PackageCabal -> ShowS)
-> (PackageCabal -> String)
-> ([PackageCabal] -> ShowS)
-> Show PackageCabal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageCabal] -> ShowS
$cshowList :: [PackageCabal] -> ShowS
show :: PackageCabal -> String
$cshow :: PackageCabal -> String
showsPrec :: Int -> PackageCabal -> ShowS
$cshowsPrec :: Int -> PackageCabal -> ShowS
Show, PackageCabal -> PackageCabal -> Bool
(PackageCabal -> PackageCabal -> Bool)
-> (PackageCabal -> PackageCabal -> Bool) -> Eq PackageCabal
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)
cabalFileName :: PackageName -> SafeFilePath
cabalFileName :: PackageName -> SafeFilePath
cabalFileName PackageName
name =
case Text -> Maybe SafeFilePath
mkSafeFilePath (Text -> Maybe SafeFilePath) -> Text -> Maybe SafeFilePath
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (PackageName -> String
packageNameString PackageName
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".cabal" of
Maybe SafeFilePath
Nothing -> String -> SafeFilePath
forall a. HasCallStack => String -> a
error (String -> SafeFilePath) -> String -> SafeFilePath
forall a b. (a -> b) -> a -> b
$ String
"cabalFileName: failed for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Show a => a -> String
show PackageName
name
Just SafeFilePath
sfp -> SafeFilePath
sfp
newtype Revision = Revision Word
deriving ((forall x. Revision -> Rep Revision x)
-> (forall x. Rep Revision x -> Revision) -> Generic Revision
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 -> String
(Int -> Revision -> ShowS)
-> (Revision -> String) -> ([Revision] -> ShowS) -> Show Revision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Revision] -> ShowS
$cshowList :: [Revision] -> ShowS
show :: Revision -> String
$cshow :: Revision -> String
showsPrec :: Int -> Revision -> ShowS
$cshowsPrec :: Int -> Revision -> ShowS
Show, Revision -> Revision -> Bool
(Revision -> Revision -> Bool)
-> (Revision -> Revision -> Bool) -> Eq Revision
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 -> ()
(Revision -> ()) -> NFData Revision
forall a. (a -> ()) -> NFData a
rnf :: Revision -> ()
$crnf :: Revision -> ()
NFData, Typeable Revision
DataType
Constr
Typeable Revision
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Revision -> c Revision)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Revision)
-> (Revision -> Constr)
-> (Revision -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Revision -> Revision)
-> (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 u. (forall d. Data d => d -> u) -> Revision -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Revision -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision)
-> Data Revision
Revision -> DataType
Revision -> Constr
(forall b. Data b => b -> b) -> Revision -> Revision
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Revision -> c Revision
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cRevision :: Constr
$tRevision :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Revision -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Revision -> u
gmapQ :: (forall d. Data d => d -> u) -> Revision -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Revision -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Revision
Data, Typeable, Eq Revision
Eq Revision
-> (Revision -> Revision -> Ordering)
-> (Revision -> Revision -> Bool)
-> (Revision -> Revision -> Bool)
-> (Revision -> Revision -> Bool)
-> (Revision -> Revision -> Bool)
-> (Revision -> Revision -> Revision)
-> (Revision -> Revision -> Revision)
-> Ord 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
$cp1Ord :: Eq Revision
Ord, Int -> Revision -> Int
Revision -> Int
(Int -> Revision -> Int) -> (Revision -> Int) -> Hashable Revision
forall 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
(Revision -> Utf8Builder) -> (Revision -> Text) -> Display Revision
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
(Revision -> PersistValue)
-> (PersistValue -> Either Text Revision) -> PersistField Revision
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
PersistField Revision
-> (Proxy Revision -> SqlType) -> PersistFieldSql Revision
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
sqlType :: Proxy Revision -> SqlType
$csqlType :: Proxy Revision -> SqlType
$cp1PersistFieldSql :: PersistField Revision
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 -> HackageSecurityConfig
pcHackageSecurity :: !HackageSecurityConfig
, 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 :: SnapName -> RIO env RawSnapshotLocation
snapshotLocation SnapName
name = do
SnapName -> RawSnapshotLocation
loc <- Getting
(SnapName -> RawSnapshotLocation)
env
(SnapName -> RawSnapshotLocation)
-> RIO env (SnapName -> RawSnapshotLocation)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting
(SnapName -> RawSnapshotLocation)
env
(SnapName -> RawSnapshotLocation)
-> RIO env (SnapName -> RawSnapshotLocation))
-> Getting
(SnapName -> RawSnapshotLocation)
env
(SnapName -> RawSnapshotLocation)
-> RIO env (SnapName -> RawSnapshotLocation)
forall a b. (a -> b) -> a -> b
$ (PantryConfig
-> Const (SnapName -> RawSnapshotLocation) PantryConfig)
-> env -> Const (SnapName -> RawSnapshotLocation) env
forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigL((PantryConfig
-> Const (SnapName -> RawSnapshotLocation) PantryConfig)
-> env -> Const (SnapName -> RawSnapshotLocation) env)
-> (((SnapName -> RawSnapshotLocation)
-> Const
(SnapName -> RawSnapshotLocation)
(SnapName -> RawSnapshotLocation))
-> PantryConfig
-> Const (SnapName -> RawSnapshotLocation) PantryConfig)
-> Getting
(SnapName -> RawSnapshotLocation)
env
(SnapName -> RawSnapshotLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PantryConfig -> SnapName -> RawSnapshotLocation)
-> SimpleGetter PantryConfig (SnapName -> RawSnapshotLocation)
forall s a. (s -> a) -> SimpleGetter s a
to PantryConfig -> SnapName -> RawSnapshotLocation
pcSnapshotLocation
RawSnapshotLocation -> RIO env RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> RIO env RawSnapshotLocation)
-> RawSnapshotLocation -> RIO env RawSnapshotLocation
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 a -> Unresolved b -> Unresolved a
(a -> b) -> Unresolved a -> Unresolved b
(forall a b. (a -> b) -> Unresolved a -> Unresolved b)
-> (forall a b. a -> Unresolved b -> Unresolved a)
-> Functor Unresolved
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
<$ :: a -> Unresolved b -> Unresolved a
$c<$ :: forall a b. a -> Unresolved b -> Unresolved a
fmap :: (a -> b) -> Unresolved a -> Unresolved b
$cfmap :: forall a b. (a -> b) -> Unresolved a -> Unresolved b
Functor
instance Applicative Unresolved where
pure :: a -> Unresolved a
pure = (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO a) -> Unresolved a)
-> (a -> Maybe (Path Abs Dir) -> IO a) -> a -> Unresolved a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Maybe (Path Abs Dir) -> IO a
forall a b. a -> b -> a
const (IO a -> Maybe (Path Abs Dir) -> IO a)
-> (a -> IO a) -> a -> Maybe (Path Abs Dir) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Unresolved Maybe (Path Abs Dir) -> IO (a -> b)
f <*> :: Unresolved (a -> b) -> Unresolved a -> Unresolved b
<*> Unresolved Maybe (Path Abs Dir) -> IO a
x = (Maybe (Path Abs Dir) -> IO b) -> Unresolved b
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO b) -> Unresolved b)
-> (Maybe (Path Abs Dir) -> IO b) -> Unresolved b
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 IO (a -> b) -> IO a -> IO b
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 :: Maybe (Path Abs Dir) -> Unresolved a -> m a
resolvePaths Maybe (Path Abs Dir)
mdir (Unresolved Maybe (Path Abs Dir) -> IO a
f) = IO a -> m a
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
{ ResolvedPath t -> RelFilePath
resolvedRelative :: !RelFilePath
, ResolvedPath t -> Path Abs t
resolvedAbsolute :: !(Path Abs t)
}
deriving (Int -> ResolvedPath t -> ShowS
[ResolvedPath t] -> ShowS
ResolvedPath t -> String
(Int -> ResolvedPath t -> ShowS)
-> (ResolvedPath t -> String)
-> ([ResolvedPath t] -> ShowS)
-> Show (ResolvedPath t)
forall t. Int -> ResolvedPath t -> ShowS
forall t. [ResolvedPath t] -> ShowS
forall t. ResolvedPath t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedPath t] -> ShowS
$cshowList :: forall t. [ResolvedPath t] -> ShowS
show :: ResolvedPath t -> String
$cshow :: forall t. ResolvedPath t -> String
showsPrec :: Int -> ResolvedPath t -> ShowS
$cshowsPrec :: forall t. Int -> ResolvedPath t -> ShowS
Show, ResolvedPath t -> ResolvedPath t -> Bool
(ResolvedPath t -> ResolvedPath t -> Bool)
-> (ResolvedPath t -> ResolvedPath t -> Bool)
-> Eq (ResolvedPath t)
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 x. ResolvedPath t -> Rep (ResolvedPath t) x)
-> (forall x. Rep (ResolvedPath t) x -> ResolvedPath t)
-> Generic (ResolvedPath t)
forall x. Rep (ResolvedPath t) x -> ResolvedPath t
forall x. ResolvedPath t -> Rep (ResolvedPath t) x
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, Eq (ResolvedPath t)
Eq (ResolvedPath t)
-> (ResolvedPath t -> ResolvedPath t -> Ordering)
-> (ResolvedPath t -> ResolvedPath t -> Bool)
-> (ResolvedPath t -> ResolvedPath t -> Bool)
-> (ResolvedPath t -> ResolvedPath t -> Bool)
-> (ResolvedPath t -> ResolvedPath t -> Bool)
-> (ResolvedPath t -> ResolvedPath t -> ResolvedPath t)
-> (ResolvedPath t -> ResolvedPath t -> ResolvedPath t)
-> Ord (ResolvedPath t)
ResolvedPath t -> ResolvedPath t -> Bool
ResolvedPath t -> ResolvedPath t -> Ordering
ResolvedPath t -> ResolvedPath t -> ResolvedPath t
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
$cp1Ord :: forall t. Eq (ResolvedPath t)
Ord)
instance NFData (ResolvedPath t)
data RawPackageLocation
= RPLImmutable !RawPackageLocationImmutable
| RPLMutable !(ResolvedPath Dir)
deriving (Int -> RawPackageLocation -> ShowS
[RawPackageLocation] -> ShowS
RawPackageLocation -> String
(Int -> RawPackageLocation -> ShowS)
-> (RawPackageLocation -> String)
-> ([RawPackageLocation] -> ShowS)
-> Show RawPackageLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawPackageLocation] -> ShowS
$cshowList :: [RawPackageLocation] -> ShowS
show :: RawPackageLocation -> String
$cshow :: RawPackageLocation -> String
showsPrec :: Int -> RawPackageLocation -> ShowS
$cshowsPrec :: Int -> RawPackageLocation -> ShowS
Show, RawPackageLocation -> RawPackageLocation -> Bool
(RawPackageLocation -> RawPackageLocation -> Bool)
-> (RawPackageLocation -> RawPackageLocation -> Bool)
-> Eq RawPackageLocation
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. RawPackageLocation -> Rep RawPackageLocation x)
-> (forall x. Rep RawPackageLocation x -> RawPackageLocation)
-> Generic RawPackageLocation
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 -> String
(Int -> PackageLocation -> ShowS)
-> (PackageLocation -> String)
-> ([PackageLocation] -> ShowS)
-> Show PackageLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageLocation] -> ShowS
$cshowList :: [PackageLocation] -> ShowS
show :: PackageLocation -> String
$cshow :: PackageLocation -> String
showsPrec :: Int -> PackageLocation -> ShowS
$cshowsPrec :: Int -> PackageLocation -> ShowS
Show, PackageLocation -> PackageLocation -> Bool
(PackageLocation -> PackageLocation -> Bool)
-> (PackageLocation -> PackageLocation -> Bool)
-> Eq PackageLocation
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. PackageLocation -> Rep PackageLocation x)
-> (forall x. Rep PackageLocation x -> PackageLocation)
-> Generic PackageLocation
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) = PackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display PackageLocationImmutable
loc
display (PLMutable ResolvedPath Dir
fp) = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder) -> String -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath (Path Abs Dir -> String) -> Path Abs Dir -> String
forall a b. (a -> b) -> a -> b
$ ResolvedPath Dir -> Path Abs Dir
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 -> String
(Int -> RawPackageLocationImmutable -> ShowS)
-> (RawPackageLocationImmutable -> String)
-> ([RawPackageLocationImmutable] -> ShowS)
-> Show RawPackageLocationImmutable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawPackageLocationImmutable] -> ShowS
$cshowList :: [RawPackageLocationImmutable] -> ShowS
show :: RawPackageLocationImmutable -> String
$cshow :: RawPackageLocationImmutable -> String
showsPrec :: Int -> RawPackageLocationImmutable -> ShowS
$cshowsPrec :: Int -> RawPackageLocationImmutable -> ShowS
Show, RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
(RawPackageLocationImmutable
-> RawPackageLocationImmutable -> Bool)
-> (RawPackageLocationImmutable
-> RawPackageLocationImmutable -> Bool)
-> Eq RawPackageLocationImmutable
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
Eq RawPackageLocationImmutable
-> (RawPackageLocationImmutable
-> RawPackageLocationImmutable -> Ordering)
-> (RawPackageLocationImmutable
-> RawPackageLocationImmutable -> Bool)
-> (RawPackageLocationImmutable
-> RawPackageLocationImmutable -> Bool)
-> (RawPackageLocationImmutable
-> RawPackageLocationImmutable -> Bool)
-> (RawPackageLocationImmutable
-> RawPackageLocationImmutable -> Bool)
-> (RawPackageLocationImmutable
-> RawPackageLocationImmutable -> RawPackageLocationImmutable)
-> (RawPackageLocationImmutable
-> RawPackageLocationImmutable -> RawPackageLocationImmutable)
-> Ord 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
$cp1Ord :: Eq RawPackageLocationImmutable
Ord, (forall x.
RawPackageLocationImmutable -> Rep RawPackageLocationImmutable x)
-> (forall x.
Rep RawPackageLocationImmutable x -> RawPackageLocationImmutable)
-> Generic RawPackageLocationImmutable
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) = PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" (from Hackage)"
display (RPLIArchive RawArchive
archive RawPackageMetadata
_pm) =
Utf8Builder
"Archive from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ArchiveLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (RawArchive -> ArchiveLocation
raLocation RawArchive
archive) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ RawArchive -> Text
raSubdir RawArchive
archive
then Utf8Builder
forall a. Monoid a => a
mempty
else Utf8Builder
" in subdir " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (RawArchive -> Text
raSubdir RawArchive
archive))
display (RPLIRepo Repo
repo RawPackageMetadata
_pm) =
Utf8Builder
"Repo from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoUrl Repo
repo) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", commit " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoCommit Repo
repo) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Repo -> Text
repoSubdir Repo
repo
then Utf8Builder
forall a. Monoid a => a
mempty
else Utf8Builder
" in subdir " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoSubdir Repo
repo))
data PackageLocationImmutable
= PLIHackage !PackageIdentifier !BlobKey !TreeKey
| PLIArchive !Archive !PackageMetadata
| PLIRepo !Repo !PackageMetadata
deriving ((forall x.
PackageLocationImmutable -> Rep PackageLocationImmutable x)
-> (forall x.
Rep PackageLocationImmutable x -> PackageLocationImmutable)
-> Generic PackageLocationImmutable
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 -> String
(Int -> PackageLocationImmutable -> ShowS)
-> (PackageLocationImmutable -> String)
-> ([PackageLocationImmutable] -> ShowS)
-> Show PackageLocationImmutable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageLocationImmutable] -> ShowS
$cshowList :: [PackageLocationImmutable] -> ShowS
show :: PackageLocationImmutable -> String
$cshow :: PackageLocationImmutable -> String
showsPrec :: Int -> PackageLocationImmutable -> ShowS
$cshowsPrec :: Int -> PackageLocationImmutable -> ShowS
Show, PackageLocationImmutable -> PackageLocationImmutable -> Bool
(PackageLocationImmutable -> PackageLocationImmutable -> Bool)
-> (PackageLocationImmutable -> PackageLocationImmutable -> Bool)
-> Eq PackageLocationImmutable
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
Eq PackageLocationImmutable
-> (PackageLocationImmutable
-> PackageLocationImmutable -> Ordering)
-> (PackageLocationImmutable -> PackageLocationImmutable -> Bool)
-> (PackageLocationImmutable -> PackageLocationImmutable -> Bool)
-> (PackageLocationImmutable -> PackageLocationImmutable -> Bool)
-> (PackageLocationImmutable -> PackageLocationImmutable -> Bool)
-> (PackageLocationImmutable
-> PackageLocationImmutable -> PackageLocationImmutable)
-> (PackageLocationImmutable
-> PackageLocationImmutable -> PackageLocationImmutable)
-> Ord 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
$cp1Ord :: Eq PackageLocationImmutable
Ord, Typeable)
instance NFData PackageLocationImmutable
instance Display PackageLocationImmutable where
display :: PackageLocationImmutable -> Utf8Builder
display (PLIHackage PackageIdentifier
ident BlobKey
_cabalHash TreeKey
_tree) =
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString (PackageName -> String) -> PackageName -> String
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> PackageName
pkgName PackageIdentifier
ident) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" (from Hackage)"
display (PLIArchive Archive
archive PackageMetadata
_pm) =
Utf8Builder
"Archive from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ArchiveLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Archive -> ArchiveLocation
archiveLocation Archive
archive) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Archive -> Text
archiveSubdir Archive
archive
then Utf8Builder
forall a. Monoid a => a
mempty
else Utf8Builder
" in subdir " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Archive -> Text
archiveSubdir Archive
archive))
display (PLIRepo Repo
repo PackageMetadata
_pm) =
Utf8Builder
"Repo from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoUrl Repo
repo) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", commit " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoCommit Repo
repo) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Repo -> Text
repoSubdir Repo
repo
then Utf8Builder
forall a. Monoid a => a
mempty
else Utf8Builder
" in subdir " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoSubdir Repo
repo))
instance ToJSON PackageLocationImmutable where
toJSON :: PackageLocationImmutable -> Value
toJSON = RawPackageLocationImmutable -> Value
forall a. ToJSON a => a -> Value
toJSON (RawPackageLocationImmutable -> Value)
-> (PackageLocationImmutable -> RawPackageLocationImmutable)
-> PackageLocationImmutable
-> Value
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 (FileSize -> Maybe FileSize
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) (TreeKey -> Maybe TreeKey
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. RawArchive -> Rep RawArchive x)
-> (forall x. Rep RawArchive x -> RawArchive) -> Generic RawArchive
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 -> String
(Int -> RawArchive -> ShowS)
-> (RawArchive -> String)
-> ([RawArchive] -> ShowS)
-> Show RawArchive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawArchive] -> ShowS
$cshowList :: [RawArchive] -> ShowS
show :: RawArchive -> String
$cshow :: RawArchive -> String
showsPrec :: Int -> RawArchive -> ShowS
$cshowsPrec :: Int -> RawArchive -> ShowS
Show, RawArchive -> RawArchive -> Bool
(RawArchive -> RawArchive -> Bool)
-> (RawArchive -> RawArchive -> Bool) -> Eq RawArchive
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
Eq RawArchive
-> (RawArchive -> RawArchive -> Ordering)
-> (RawArchive -> RawArchive -> Bool)
-> (RawArchive -> RawArchive -> Bool)
-> (RawArchive -> RawArchive -> Bool)
-> (RawArchive -> RawArchive -> Bool)
-> (RawArchive -> RawArchive -> RawArchive)
-> (RawArchive -> RawArchive -> RawArchive)
-> Ord 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
$cp1Ord :: Eq RawArchive
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. Archive -> Rep Archive x)
-> (forall x. Rep Archive x -> Archive) -> Generic Archive
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 -> String
(Int -> Archive -> ShowS)
-> (Archive -> String) -> ([Archive] -> ShowS) -> Show Archive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Archive] -> ShowS
$cshowList :: [Archive] -> ShowS
show :: Archive -> String
$cshow :: Archive -> String
showsPrec :: Int -> Archive -> ShowS
$cshowsPrec :: Int -> Archive -> ShowS
Show, Archive -> Archive -> Bool
(Archive -> Archive -> Bool)
-> (Archive -> Archive -> Bool) -> Eq Archive
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
Eq Archive
-> (Archive -> Archive -> Ordering)
-> (Archive -> Archive -> Bool)
-> (Archive -> Archive -> Bool)
-> (Archive -> Archive -> Bool)
-> (Archive -> Archive -> Bool)
-> (Archive -> Archive -> Archive)
-> (Archive -> Archive -> Archive)
-> Ord 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
$cp1Ord :: Eq Archive
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) (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just (SHA256 -> Maybe SHA256) -> SHA256 -> Maybe SHA256
forall a b. (a -> b) -> a -> b
$ Archive -> SHA256
archiveHash Archive
archive)
(FileSize -> Maybe FileSize
forall a. a -> Maybe a
Just (FileSize -> Maybe FileSize) -> FileSize -> Maybe FileSize
forall a b. (a -> b) -> a -> b
$ Archive -> FileSize
archiveSize Archive
archive) (Archive -> Text
archiveSubdir Archive
archive)
data RepoType = RepoGit | RepoHg
deriving ((forall x. RepoType -> Rep RepoType x)
-> (forall x. Rep RepoType x -> RepoType) -> Generic RepoType
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 -> String
(Int -> RepoType -> ShowS)
-> (RepoType -> String) -> ([RepoType] -> ShowS) -> Show RepoType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoType] -> ShowS
$cshowList :: [RepoType] -> ShowS
show :: RepoType -> String
$cshow :: RepoType -> String
showsPrec :: Int -> RepoType -> ShowS
$cshowsPrec :: Int -> RepoType -> ShowS
Show, RepoType -> RepoType -> Bool
(RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool) -> Eq RepoType
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
Eq RepoType
-> (RepoType -> RepoType -> Ordering)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> RepoType)
-> (RepoType -> RepoType -> RepoType)
-> Ord 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
$cp1Ord :: Eq RepoType
Ord, Typeable)
instance NFData RepoType
instance PersistField RepoType where
toPersistValue :: RepoType -> PersistValue
toPersistValue RepoType
RepoGit = Int32 -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Int32
1 :: Int32)
toPersistValue RepoType
RepoHg = Int32 -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Int32
2 :: Int32)
fromPersistValue :: PersistValue -> Either Text RepoType
fromPersistValue PersistValue
v = do
Int32
i <- PersistValue -> Either Text Int32
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
case Int32
i :: Int32 of
Int32
1 -> RepoType -> Either Text RepoType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoType
RepoGit
Int32
2 -> RepoType -> Either Text RepoType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoType
RepoHg
Int32
_ -> Text -> Either Text RepoType
forall a b. a -> Either a b
Left (Text -> Either Text RepoType) -> Text -> Either Text RepoType
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Invalid RepoType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
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. Repo -> Rep Repo x)
-> (forall x. Rep Repo x -> Repo) -> Generic Repo
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
(Repo -> Repo -> Bool) -> (Repo -> Repo -> Bool) -> Eq Repo
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
Eq Repo
-> (Repo -> Repo -> Ordering)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Repo)
-> (Repo -> Repo -> Repo)
-> Ord 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
$cp1Ord :: Eq Repo
Ord, Typeable)
instance NFData Repo
instance Show Repo where
show :: Repo -> String
show = Text -> String
T.unpack (Text -> String) -> (Repo -> Text) -> Repo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> (Repo -> Utf8Builder) -> Repo -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repo -> Utf8Builder
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") Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" repo at " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", commit " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
commit Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null Text
subdir
then Utf8Builder
forall a. Monoid a => a
mempty
else Utf8Builder
" in subdirectory " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
subdir)
newtype GitHubRepo = GitHubRepo Text
instance FromJSON GitHubRepo where
parseJSON :: Value -> Parser GitHubRepo
parseJSON = String -> (Text -> Parser GitHubRepo) -> Value -> Parser GitHubRepo
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"GitHubRepo" ((Text -> Parser GitHubRepo) -> Value -> Parser GitHubRepo)
-> (Text -> Parser GitHubRepo) -> Value -> Parser GitHubRepo
forall a b. (a -> b) -> a -> b
$ \Text
s -> do
case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
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) -> GitHubRepo -> Parser GitHubRepo
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> GitHubRepo
GitHubRepo Text
s)
[Text]
_ -> String -> Parser GitHubRepo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting \"user/repo\""
data HackageSecurityConfig = HackageSecurityConfig
{ HackageSecurityConfig -> [Text]
hscKeyIds :: ![Text]
, HackageSecurityConfig -> Int
hscKeyThreshold :: !Int
, HackageSecurityConfig -> Text
hscDownloadPrefix :: !Text
, HackageSecurityConfig -> Bool
hscIgnoreExpiry :: !Bool
}
deriving Int -> HackageSecurityConfig -> ShowS
[HackageSecurityConfig] -> ShowS
HackageSecurityConfig -> String
(Int -> HackageSecurityConfig -> ShowS)
-> (HackageSecurityConfig -> String)
-> ([HackageSecurityConfig] -> ShowS)
-> Show HackageSecurityConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HackageSecurityConfig] -> ShowS
$cshowList :: [HackageSecurityConfig] -> ShowS
show :: HackageSecurityConfig -> String
$cshow :: HackageSecurityConfig -> String
showsPrec :: Int -> HackageSecurityConfig -> ShowS
$cshowsPrec :: Int -> HackageSecurityConfig -> ShowS
Show
instance FromJSON (WithJSONWarnings HackageSecurityConfig) where
parseJSON :: Value -> Parser (WithJSONWarnings HackageSecurityConfig)
parseJSON = String
-> (Object -> WarningParser HackageSecurityConfig)
-> Value
-> Parser (WithJSONWarnings HackageSecurityConfig)
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"HackageSecurityConfig" ((Object -> WarningParser HackageSecurityConfig)
-> Value -> Parser (WithJSONWarnings HackageSecurityConfig))
-> (Object -> WarningParser HackageSecurityConfig)
-> Value
-> Parser (WithJSONWarnings HackageSecurityConfig)
forall a b. (a -> b) -> a -> b
$ \Object
o' -> do
Text
hscDownloadPrefix <- Object
o' Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"download-prefix"
Object Object
o <- Object
o' Object -> Text -> WarningParser Value
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hackage-security"
[Text]
hscKeyIds <- Object
o Object -> Text -> WarningParser [Text]
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"keyids"
Int
hscKeyThreshold <- Object
o Object -> Text -> WarningParser Int
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"key-threshold"
Bool
hscIgnoreExpiry <- Object
o Object -> Text -> WarningParser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"ignore-expiry" WarningParser (Maybe Bool) -> Bool -> WarningParser Bool
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Bool
True
HackageSecurityConfig -> WarningParser HackageSecurityConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure HackageSecurityConfig :: [Text] -> Int -> Text -> Bool -> HackageSecurityConfig
HackageSecurityConfig {Bool
Int
[Text]
Text
hscIgnoreExpiry :: Bool
hscKeyThreshold :: Int
hscKeyIds :: [Text]
hscDownloadPrefix :: Text
hscIgnoreExpiry :: Bool
hscDownloadPrefix :: Text
hscKeyThreshold :: Int
hscKeyIds :: [Text]
..}
class HasPantryConfig env where
pantryConfigL :: Lens' env PantryConfig
newtype FileSize = FileSize Word
deriving (Int -> FileSize -> ShowS
[FileSize] -> ShowS
FileSize -> String
(Int -> FileSize -> ShowS)
-> (FileSize -> String) -> ([FileSize] -> ShowS) -> Show FileSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileSize] -> ShowS
$cshowList :: [FileSize] -> ShowS
show :: FileSize -> String
$cshow :: FileSize -> String
showsPrec :: Int -> FileSize -> ShowS
$cshowsPrec :: Int -> FileSize -> ShowS
Show, FileSize -> FileSize -> Bool
(FileSize -> FileSize -> Bool)
-> (FileSize -> FileSize -> Bool) -> Eq FileSize
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
Eq FileSize
-> (FileSize -> FileSize -> Ordering)
-> (FileSize -> FileSize -> Bool)
-> (FileSize -> FileSize -> Bool)
-> (FileSize -> FileSize -> Bool)
-> (FileSize -> FileSize -> Bool)
-> (FileSize -> FileSize -> FileSize)
-> (FileSize -> FileSize -> FileSize)
-> Ord 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
$cp1Ord :: Eq FileSize
Ord, Typeable, (forall x. FileSize -> Rep FileSize x)
-> (forall x. Rep FileSize x -> FileSize) -> Generic FileSize
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
(FileSize -> Utf8Builder) -> (FileSize -> Text) -> Display FileSize
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
textDisplay :: FileSize -> Text
$ctextDisplay :: FileSize -> Text
display :: FileSize -> Utf8Builder
$cdisplay :: FileSize -> Utf8Builder
Display, Int -> FileSize -> Int
FileSize -> Int
(Int -> FileSize -> Int) -> (FileSize -> Int) -> Hashable FileSize
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: FileSize -> Int
$chash :: FileSize -> Int
hashWithSalt :: Int -> FileSize -> Int
$chashWithSalt :: Int -> FileSize -> Int
Hashable, FileSize -> ()
(FileSize -> ()) -> NFData FileSize
forall a. (a -> ()) -> NFData a
rnf :: FileSize -> ()
$crnf :: FileSize -> ()
NFData, PersistValue -> Either Text FileSize
FileSize -> PersistValue
(FileSize -> PersistValue)
-> (PersistValue -> Either Text FileSize) -> PersistField FileSize
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
PersistField FileSize
-> (Proxy FileSize -> SqlType) -> PersistFieldSql FileSize
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
sqlType :: Proxy FileSize -> SqlType
$csqlType :: Proxy FileSize -> SqlType
$cp1PersistFieldSql :: PersistField FileSize
PersistFieldSql, [FileSize] -> Encoding
[FileSize] -> Value
FileSize -> Encoding
FileSize -> Value
(FileSize -> Value)
-> (FileSize -> Encoding)
-> ([FileSize] -> Value)
-> ([FileSize] -> Encoding)
-> ToJSON FileSize
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
(Value -> Parser FileSize)
-> (Value -> Parser [FileSize]) -> FromJSON 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
(BlobKey -> BlobKey -> Bool)
-> (BlobKey -> BlobKey -> Bool) -> Eq BlobKey
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
Eq BlobKey
-> (BlobKey -> BlobKey -> Ordering)
-> (BlobKey -> BlobKey -> Bool)
-> (BlobKey -> BlobKey -> Bool)
-> (BlobKey -> BlobKey -> Bool)
-> (BlobKey -> BlobKey -> Bool)
-> (BlobKey -> BlobKey -> BlobKey)
-> (BlobKey -> BlobKey -> BlobKey)
-> Ord 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
$cp1Ord :: Eq BlobKey
Ord, Typeable, (forall x. BlobKey -> Rep BlobKey x)
-> (forall x. Rep BlobKey x -> BlobKey) -> Generic BlobKey
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 -> String
show = Text -> String
T.unpack (Text -> String) -> (BlobKey -> Text) -> BlobKey -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (BlobKey -> Utf8Builder) -> BlobKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance Display BlobKey where
display :: BlobKey -> Utf8Builder
display (BlobKey SHA256
sha FileSize
size') = SHA256 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SHA256
sha Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"," Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
size'
blobKeyPairs :: BlobKey -> [(Text, Value)]
blobKeyPairs :: BlobKey -> [(Text, Value)]
blobKeyPairs (BlobKey SHA256
sha FileSize
size') =
[ Text
"sha256" Text -> SHA256 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SHA256
sha
, Text
"size" Text -> FileSize -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FileSize
size'
]
instance ToJSON BlobKey where
toJSON :: BlobKey -> Value
toJSON = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value)
-> (BlobKey -> [(Text, Value)]) -> BlobKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlobKey -> [(Text, Value)]
blobKeyPairs
instance FromJSON BlobKey where
parseJSON :: Value -> Parser BlobKey
parseJSON = String -> (Object -> Parser BlobKey) -> Value -> Parser BlobKey
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BlobKey" ((Object -> Parser BlobKey) -> Value -> Parser BlobKey)
-> (Object -> Parser BlobKey) -> Value -> Parser BlobKey
forall a b. (a -> b) -> a -> b
$ \Object
o -> SHA256 -> FileSize -> BlobKey
BlobKey
(SHA256 -> FileSize -> BlobKey)
-> Parser SHA256 -> Parser (FileSize -> BlobKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser SHA256
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"sha256"
Parser (FileSize -> BlobKey) -> Parser FileSize -> Parser BlobKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser FileSize
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"size"
newtype PackageNameP = PackageNameP { PackageNameP -> PackageName
unPackageNameP :: PackageName }
deriving (PackageNameP -> PackageNameP -> Bool
(PackageNameP -> PackageNameP -> Bool)
-> (PackageNameP -> PackageNameP -> Bool) -> Eq PackageNameP
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
Eq PackageNameP
-> (PackageNameP -> PackageNameP -> Ordering)
-> (PackageNameP -> PackageNameP -> Bool)
-> (PackageNameP -> PackageNameP -> Bool)
-> (PackageNameP -> PackageNameP -> Bool)
-> (PackageNameP -> PackageNameP -> Bool)
-> (PackageNameP -> PackageNameP -> PackageNameP)
-> (PackageNameP -> PackageNameP -> PackageNameP)
-> Ord 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
$cp1Ord :: Eq PackageNameP
Ord, Int -> PackageNameP -> ShowS
[PackageNameP] -> ShowS
PackageNameP -> String
(Int -> PackageNameP -> ShowS)
-> (PackageNameP -> String)
-> ([PackageNameP] -> ShowS)
-> Show PackageNameP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageNameP] -> ShowS
$cshowList :: [PackageNameP] -> ShowS
show :: PackageNameP -> String
$cshow :: PackageNameP -> String
showsPrec :: Int -> PackageNameP -> ShowS
$cshowsPrec :: Int -> PackageNameP -> ShowS
Show, ReadPrec [PackageNameP]
ReadPrec PackageNameP
Int -> ReadS PackageNameP
ReadS [PackageNameP]
(Int -> ReadS PackageNameP)
-> ReadS [PackageNameP]
-> ReadPrec PackageNameP
-> ReadPrec [PackageNameP]
-> Read 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 -> ()
(PackageNameP -> ()) -> NFData PackageNameP
forall a. (a -> ()) -> NFData a
rnf :: PackageNameP -> ()
$crnf :: PackageNameP -> ()
NFData)
instance Display PackageNameP where
display :: PackageNameP -> Utf8Builder
display = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder)
-> (PackageNameP -> String) -> PackageNameP -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
packageNameString (PackageName -> String)
-> (PackageNameP -> PackageName) -> PackageNameP -> String
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 (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PackageName -> String
packageNameString PackageName
pn
fromPersistValue :: PersistValue -> Either Text PackageNameP
fromPersistValue PersistValue
v = do
String
str <- PersistValue -> Either Text String
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
case String -> Maybe PackageName
parsePackageName String
str of
Maybe PackageName
Nothing -> Text -> Either Text PackageNameP
forall a b. a -> Either a b
Left (Text -> Either Text PackageNameP)
-> Text -> Either Text PackageNameP
forall a b. (a -> b) -> a -> b
$ Text
"Invalid package name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
str
Just PackageName
pn -> PackageNameP -> Either Text PackageNameP
forall a b. b -> Either a b
Right (PackageNameP -> Either Text PackageNameP)
-> PackageNameP -> Either Text PackageNameP
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 (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PackageName -> String
packageNameString PackageName
pn
instance FromJSON PackageNameP where
parseJSON :: Value -> Parser PackageNameP
parseJSON = String
-> (Text -> Parser PackageNameP) -> Value -> Parser PackageNameP
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PackageNameP" ((Text -> Parser PackageNameP) -> Value -> Parser PackageNameP)
-> (Text -> Parser PackageNameP) -> Value -> Parser PackageNameP
forall a b. (a -> b) -> a -> b
$ PackageNameP -> Parser PackageNameP
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageNameP -> Parser PackageNameP)
-> (Text -> PackageNameP) -> Text -> Parser PackageNameP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> PackageNameP
PackageNameP (PackageName -> PackageNameP)
-> (Text -> PackageName) -> Text -> PackageNameP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PackageName
mkPackageName (String -> PackageName) -> (Text -> String) -> Text -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
instance ToJSONKey PackageNameP where
toJSONKey :: ToJSONKeyFunction PackageNameP
toJSONKey =
(PackageNameP -> Text)
-> (PackageNameP -> Encoding' Text)
-> ToJSONKeyFunction PackageNameP
forall a.
(a -> Text) -> (a -> Encoding' Text) -> ToJSONKeyFunction a
ToJSONKeyText
(String -> Text
T.pack (String -> Text)
-> (PackageNameP -> String) -> PackageNameP -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
packageNameString (PackageName -> String)
-> (PackageNameP -> PackageName) -> PackageNameP -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageNameP -> PackageName
unPackageNameP)
(Builder -> Encoding' Text
forall a. Builder -> Encoding' a
unsafeToEncoding (Builder -> Encoding' Text)
-> (PackageNameP -> Builder) -> PackageNameP -> Encoding' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Builder
getUtf8Builder (Utf8Builder -> Builder)
-> (PackageNameP -> Utf8Builder) -> PackageNameP -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageNameP -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display)
instance FromJSONKey PackageNameP where
fromJSONKey :: FromJSONKeyFunction PackageNameP
fromJSONKey = (Text -> PackageNameP) -> FromJSONKeyFunction PackageNameP
forall a. (Text -> a) -> FromJSONKeyFunction a
FromJSONKeyText ((Text -> PackageNameP) -> FromJSONKeyFunction PackageNameP)
-> (Text -> PackageNameP) -> FromJSONKeyFunction PackageNameP
forall a b. (a -> b) -> a -> b
$ PackageName -> PackageNameP
PackageNameP (PackageName -> PackageNameP)
-> (Text -> PackageName) -> Text -> PackageNameP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PackageName
mkPackageName (String -> PackageName) -> (Text -> String) -> Text -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
newtype VersionP = VersionP { VersionP -> Version
unVersionP :: Version }
deriving (VersionP -> VersionP -> Bool
(VersionP -> VersionP -> Bool)
-> (VersionP -> VersionP -> Bool) -> Eq VersionP
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
Eq VersionP
-> (VersionP -> VersionP -> Ordering)
-> (VersionP -> VersionP -> Bool)
-> (VersionP -> VersionP -> Bool)
-> (VersionP -> VersionP -> Bool)
-> (VersionP -> VersionP -> Bool)
-> (VersionP -> VersionP -> VersionP)
-> (VersionP -> VersionP -> VersionP)
-> Ord 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
$cp1Ord :: Eq VersionP
Ord, Int -> VersionP -> ShowS
[VersionP] -> ShowS
VersionP -> String
(Int -> VersionP -> ShowS)
-> (VersionP -> String) -> ([VersionP] -> ShowS) -> Show VersionP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionP] -> ShowS
$cshowList :: [VersionP] -> ShowS
show :: VersionP -> String
$cshow :: VersionP -> String
showsPrec :: Int -> VersionP -> ShowS
$cshowsPrec :: Int -> VersionP -> ShowS
Show, ReadPrec [VersionP]
ReadPrec VersionP
Int -> ReadS VersionP
ReadS [VersionP]
(Int -> ReadS VersionP)
-> ReadS [VersionP]
-> ReadPrec VersionP
-> ReadPrec [VersionP]
-> Read 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 -> ()
(VersionP -> ()) -> NFData 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 (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
versionString Version
v
fromPersistValue :: PersistValue -> Either Text VersionP
fromPersistValue PersistValue
v = do
String
str <- PersistValue -> Either Text String
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
case String -> Maybe Version
parseVersion String
str of
Maybe Version
Nothing -> Text -> Either Text VersionP
forall a b. a -> Either a b
Left (Text -> Either Text VersionP) -> Text -> Either Text VersionP
forall a b. (a -> b) -> a -> b
$ Text
"Invalid version number: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
str
Just Version
ver -> VersionP -> Either Text VersionP
forall a b. b -> Either a b
Right (VersionP -> Either Text VersionP)
-> VersionP -> Either Text VersionP
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) = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder) -> String -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Version -> String
versionString Version
v
instance ToJSON VersionP where
toJSON :: VersionP -> Value
toJSON (VersionP Version
v) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
versionString Version
v
instance FromJSON VersionP where
parseJSON :: Value -> Parser VersionP
parseJSON =
String -> (Text -> Parser VersionP) -> Value -> Parser VersionP
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"VersionP" ((Text -> Parser VersionP) -> Value -> Parser VersionP)
-> (Text -> Parser VersionP) -> Value -> Parser VersionP
forall a b. (a -> b) -> a -> b
$
(SomeException -> Parser VersionP)
-> (Version -> Parser VersionP)
-> Either SomeException Version
-> Parser VersionP
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser VersionP
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser VersionP)
-> (SomeException -> String) -> SomeException -> Parser VersionP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException) (VersionP -> Parser VersionP
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VersionP -> Parser VersionP)
-> (Version -> VersionP) -> Version -> Parser VersionP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> VersionP
VersionP) (Either SomeException Version -> Parser VersionP)
-> (Text -> Either SomeException Version)
-> Text
-> Parser VersionP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either SomeException Version
forall (m :: * -> *). MonadThrow m => String -> m Version
parseVersionThrowing (String -> Either SomeException Version)
-> (Text -> String) -> Text -> Either SomeException Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
newtype ModuleNameP = ModuleNameP
{ ModuleNameP -> ModuleName
unModuleNameP :: ModuleName
} deriving (ModuleNameP -> ModuleNameP -> Bool
(ModuleNameP -> ModuleNameP -> Bool)
-> (ModuleNameP -> ModuleNameP -> Bool) -> Eq ModuleNameP
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
Eq ModuleNameP
-> (ModuleNameP -> ModuleNameP -> Ordering)
-> (ModuleNameP -> ModuleNameP -> Bool)
-> (ModuleNameP -> ModuleNameP -> Bool)
-> (ModuleNameP -> ModuleNameP -> Bool)
-> (ModuleNameP -> ModuleNameP -> Bool)
-> (ModuleNameP -> ModuleNameP -> ModuleNameP)
-> (ModuleNameP -> ModuleNameP -> ModuleNameP)
-> Ord 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
$cp1Ord :: Eq ModuleNameP
Ord, Int -> ModuleNameP -> ShowS
[ModuleNameP] -> ShowS
ModuleNameP -> String
(Int -> ModuleNameP -> ShowS)
-> (ModuleNameP -> String)
-> ([ModuleNameP] -> ShowS)
-> Show ModuleNameP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleNameP] -> ShowS
$cshowList :: [ModuleNameP] -> ShowS
show :: ModuleNameP -> String
$cshow :: ModuleNameP -> String
showsPrec :: Int -> ModuleNameP -> ShowS
$cshowsPrec :: Int -> ModuleNameP -> ShowS
Show, ModuleNameP -> ()
(ModuleNameP -> ()) -> NFData ModuleNameP
forall a. (a -> ()) -> NFData a
rnf :: ModuleNameP -> ()
$crnf :: ModuleNameP -> ()
NFData)
instance Display ModuleNameP where
display :: ModuleNameP -> Utf8Builder
display = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder)
-> (ModuleNameP -> String) -> ModuleNameP -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString (ModuleName -> String)
-> (ModuleNameP -> ModuleName) -> ModuleNameP -> String
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 (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
mn
fromPersistValue :: PersistValue -> Either Text ModuleNameP
fromPersistValue PersistValue
v = do
String
str <- PersistValue -> Either Text String
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
case String -> Maybe ModuleName
parseModuleName String
str of
Maybe ModuleName
Nothing -> Text -> Either Text ModuleNameP
forall a b. a -> Either a b
Left (Text -> Either Text ModuleNameP)
-> Text -> Either Text ModuleNameP
forall a b. (a -> b) -> a -> b
$ Text
"Invalid module name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
str
Just ModuleName
pn -> ModuleNameP -> Either Text ModuleNameP
forall a b. b -> Either a b
Right (ModuleNameP -> Either Text ModuleNameP)
-> ModuleNameP -> Either Text ModuleNameP
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. CabalFileInfo -> Rep CabalFileInfo x)
-> (forall x. Rep CabalFileInfo x -> CabalFileInfo)
-> Generic CabalFileInfo
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 -> String
(Int -> CabalFileInfo -> ShowS)
-> (CabalFileInfo -> String)
-> ([CabalFileInfo] -> ShowS)
-> Show CabalFileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CabalFileInfo] -> ShowS
$cshowList :: [CabalFileInfo] -> ShowS
show :: CabalFileInfo -> String
$cshow :: CabalFileInfo -> String
showsPrec :: Int -> CabalFileInfo -> ShowS
$cshowsPrec :: Int -> CabalFileInfo -> ShowS
Show, CabalFileInfo -> CabalFileInfo -> Bool
(CabalFileInfo -> CabalFileInfo -> Bool)
-> (CabalFileInfo -> CabalFileInfo -> Bool) -> Eq CabalFileInfo
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
Eq CabalFileInfo
-> (CabalFileInfo -> CabalFileInfo -> Ordering)
-> (CabalFileInfo -> CabalFileInfo -> Bool)
-> (CabalFileInfo -> CabalFileInfo -> Bool)
-> (CabalFileInfo -> CabalFileInfo -> Bool)
-> (CabalFileInfo -> CabalFileInfo -> Bool)
-> (CabalFileInfo -> CabalFileInfo -> CabalFileInfo)
-> (CabalFileInfo -> CabalFileInfo -> CabalFileInfo)
-> Ord 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
$cp1Ord :: Eq CabalFileInfo
Ord, Typeable)
instance NFData CabalFileInfo
instance Hashable CabalFileInfo
instance Display CabalFileInfo where
display :: CabalFileInfo -> Utf8Builder
display CabalFileInfo
CFILatest = Utf8Builder
forall a. Monoid a => a
mempty
display (CFIHash SHA256
hash' Maybe FileSize
msize) =
Utf8Builder
"@sha256:" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SHA256 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SHA256
hash' Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
-> (FileSize -> Utf8Builder) -> Maybe FileSize -> Utf8Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Utf8Builder
forall a. Monoid a => a
mempty (\FileSize
i -> Utf8Builder
"," Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
i) Maybe FileSize
msize
display (CFIRevision Revision
rev) = Utf8Builder
"@rev:" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Revision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Revision
rev
data PackageIdentifierRevision = PackageIdentifierRevision !PackageName !Version !CabalFileInfo
deriving ((forall x.
PackageIdentifierRevision -> Rep PackageIdentifierRevision x)
-> (forall x.
Rep PackageIdentifierRevision x -> PackageIdentifierRevision)
-> Generic PackageIdentifierRevision
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
(PackageIdentifierRevision -> PackageIdentifierRevision -> Bool)
-> (PackageIdentifierRevision -> PackageIdentifierRevision -> Bool)
-> Eq PackageIdentifierRevision
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
Eq PackageIdentifierRevision
-> (PackageIdentifierRevision
-> PackageIdentifierRevision -> Ordering)
-> (PackageIdentifierRevision -> PackageIdentifierRevision -> Bool)
-> (PackageIdentifierRevision -> PackageIdentifierRevision -> Bool)
-> (PackageIdentifierRevision -> PackageIdentifierRevision -> Bool)
-> (PackageIdentifierRevision -> PackageIdentifierRevision -> Bool)
-> (PackageIdentifierRevision
-> PackageIdentifierRevision -> PackageIdentifierRevision)
-> (PackageIdentifierRevision
-> PackageIdentifierRevision -> PackageIdentifierRevision)
-> Ord 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
$cp1Ord :: Eq PackageIdentifierRevision
Ord, Typeable)
instance NFData PackageIdentifierRevision
instance Show PackageIdentifierRevision where
show :: PackageIdentifierRevision -> String
show = Text -> String
T.unpack (Text -> String)
-> (PackageIdentifierRevision -> Text)
-> PackageIdentifierRevision
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (PackageIdentifierRevision -> Utf8Builder)
-> PackageIdentifierRevision
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance Display PackageIdentifierRevision where
display :: PackageIdentifierRevision -> Utf8Builder
display (PackageIdentifierRevision PackageName
name Version
version CabalFileInfo
cfi) =
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
version) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> CabalFileInfo -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display CabalFileInfo
cfi
instance ToJSON PackageIdentifierRevision where
toJSON :: PackageIdentifierRevision -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (PackageIdentifierRevision -> Text)
-> PackageIdentifierRevision
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (PackageIdentifierRevision -> Utf8Builder)
-> PackageIdentifierRevision
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance FromJSON PackageIdentifierRevision where
parseJSON :: Value -> Parser PackageIdentifierRevision
parseJSON = String
-> (Text -> Parser PackageIdentifierRevision)
-> Value
-> Parser PackageIdentifierRevision
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PackageIdentifierRevision" ((Text -> Parser PackageIdentifierRevision)
-> Value -> Parser PackageIdentifierRevision)
-> (Text -> Parser PackageIdentifierRevision)
-> Value
-> Parser PackageIdentifierRevision
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case Text -> Either PantryException PackageIdentifierRevision
parsePackageIdentifierRevision Text
t of
Left PantryException
e -> String -> Parser PackageIdentifierRevision
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser PackageIdentifierRevision)
-> String -> Parser PackageIdentifierRevision
forall a b. (a -> b) -> a -> b
$ PantryException -> String
forall a. Show a => a -> String
show PantryException
e
Right PackageIdentifierRevision
pir -> PackageIdentifierRevision -> Parser PackageIdentifierRevision
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 =
(String -> Either PantryException (PackageIdentifier, BlobKey))
-> ((PackageIdentifier, BlobKey)
-> Either PantryException (PackageIdentifier, BlobKey))
-> Either String (PackageIdentifier, BlobKey)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
x -> String
-> (Any -> Either PantryException Any)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a. HasCallStack => String -> a
error (ShowS
forall a. Show a => a -> String
show String
x) ((Any -> Either PantryException Any)
-> Either PantryException (PackageIdentifier, BlobKey))
-> (Any -> Either PantryException Any)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a b. (a -> b) -> a -> b
$ Either PantryException Any -> Any -> Either PantryException Any
forall a b. a -> b -> a
const (Either PantryException Any -> Any -> Either PantryException Any)
-> Either PantryException Any -> Any -> Either PantryException Any
forall a b. (a -> b) -> a -> b
$ PantryException -> Either PantryException Any
forall a b. a -> Either a b
Left (PantryException -> Either PantryException Any)
-> PantryException -> Either PantryException Any
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
PackageIdentifierRevisionParseFail Text
t) (PackageIdentifier, BlobKey)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a b. b -> Either a b
Right (Either String (PackageIdentifier, BlobKey)
-> Either PantryException (PackageIdentifier, BlobKey))
-> Either String (PackageIdentifier, BlobKey)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a b. (a -> b) -> a -> b
$
ParsecParser (PackageIdentifier, BlobKey)
-> String -> Either String (PackageIdentifier, BlobKey)
forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec (ParsecParser (PackageIdentifier, BlobKey)
hackageTextParsec ParsecParser (PackageIdentifier, BlobKey)
-> ParsecParser () -> ParsecParser (PackageIdentifier, BlobKey)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecParser ()
forall (m :: * -> *). Parsing m => m ()
Parse.eof) (String -> Either String (PackageIdentifier, BlobKey))
-> String -> Either String (PackageIdentifier, BlobKey)
forall a b. (a -> b) -> a -> b
$
Text -> String
T.unpack Text
t
hackageTextParsec :: ParsecParser (PackageIdentifier, BlobKey)
hackageTextParsec :: ParsecParser (PackageIdentifier, BlobKey)
hackageTextParsec = do
PackageIdentifier
ident <- ParsecParser PackageIdentifier
packageIdentifierParsec
String
_ <- String -> ParsecParser String
forall (m :: * -> *). CharParsing m => String -> m String
Parse.string String
"@sha256:"
String
shaT <- (Char -> Bool) -> ParsecParser String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
Parse.munch (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',')
SHA256
sha <- (SHA256Exception -> ParsecParser SHA256)
-> (SHA256 -> ParsecParser SHA256)
-> Either SHA256Exception SHA256
-> ParsecParser SHA256
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParsecParser SHA256 -> SHA256Exception -> ParsecParser SHA256
forall a b. a -> b -> a
const ParsecParser SHA256
forall (m :: * -> *) a. MonadPlus m => m a
mzero) SHA256 -> ParsecParser SHA256
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SHA256Exception SHA256 -> ParsecParser SHA256)
-> Either SHA256Exception SHA256 -> ParsecParser SHA256
forall a b. (a -> b) -> a -> b
$ Text -> Either SHA256Exception SHA256
SHA256.fromHexText (Text -> Either SHA256Exception SHA256)
-> Text -> Either SHA256Exception SHA256
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
shaT
Char
_ <- Char -> ParsecParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Parse.char Char
','
Word
size' <- ParsecParser Word
forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
Parse.integral
(PackageIdentifier, BlobKey)
-> ParsecParser (PackageIdentifier, BlobKey)
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
t'
in (Text
x, ) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
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 = Either PantryException PackageIdentifierRevision
-> (PackageIdentifierRevision
-> Either PantryException PackageIdentifierRevision)
-> Maybe PackageIdentifierRevision
-> Either PantryException PackageIdentifierRevision
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PantryException -> Either PantryException PackageIdentifierRevision
forall a b. a -> Either a b
Left (PantryException
-> Either PantryException PackageIdentifierRevision)
-> PantryException
-> Either PantryException PackageIdentifierRevision
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
PackageIdentifierRevisionParseFail Text
t) PackageIdentifierRevision
-> Either PantryException PackageIdentifierRevision
forall a b. b -> Either a b
Right (Maybe PackageIdentifierRevision
-> Either PantryException PackageIdentifierRevision)
-> Maybe PackageIdentifierRevision
-> Either PantryException PackageIdentifierRevision
forall a b. (a -> b) -> a -> b
$ do
let (Text
identT, Text
cfiT) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@') Text
t
PackageIdentifier PackageName
name Version
version <- String -> Maybe PackageIdentifier
parsePackageIdentifier (String -> Maybe PackageIdentifier)
-> String -> Maybe PackageIdentifier
forall a b. (a -> b) -> a -> b
$ Text -> String
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
shaSizeT
SHA256
sha <- (SHA256Exception -> Maybe SHA256)
-> (SHA256 -> Maybe SHA256)
-> Either SHA256Exception SHA256
-> Maybe SHA256
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe SHA256 -> SHA256Exception -> Maybe SHA256
forall a b. a -> b -> a
const Maybe SHA256
forall a. Maybe a
Nothing) SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just (Either SHA256Exception SHA256 -> Maybe SHA256)
-> Either SHA256Exception SHA256 -> Maybe SHA256
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 -> Maybe FileSize -> Maybe (Maybe FileSize)
forall a. a -> Maybe a
Just Maybe FileSize
forall a. Maybe a
Nothing
Just Text
sizeT' ->
case Reader Word
forall a. Integral a => Reader a
decimal Text
sizeT' of
Right (Word
size', Text
"") -> Maybe FileSize -> Maybe (Maybe FileSize)
forall a. a -> Maybe a
Just (Maybe FileSize -> Maybe (Maybe FileSize))
-> Maybe FileSize -> Maybe (Maybe FileSize)
forall a b. (a -> b) -> a -> b
$ FileSize -> Maybe FileSize
forall a. a -> Maybe a
Just (FileSize -> Maybe FileSize) -> FileSize -> Maybe FileSize
forall a b. (a -> b) -> a -> b
$ Word -> FileSize
FileSize Word
size'
Either String (Word, Text)
_ -> Maybe (Maybe FileSize)
forall a. Maybe a
Nothing
CabalFileInfo -> Maybe CabalFileInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CabalFileInfo -> Maybe CabalFileInfo)
-> CabalFileInfo -> Maybe CabalFileInfo
forall a b. (a -> b) -> a -> b
$ SHA256 -> Maybe FileSize -> CabalFileInfo
CFIHash SHA256
sha Maybe FileSize
msize
Just (Text
"@rev", Text
revT) ->
case Reader Word
forall a. Integral a => Reader a
decimal Text
revT of
Right (Word
rev, Text
"") -> CabalFileInfo -> Maybe CabalFileInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CabalFileInfo -> Maybe CabalFileInfo)
-> CabalFileInfo -> Maybe CabalFileInfo
forall a b. (a -> b) -> a -> b
$ Revision -> CabalFileInfo
CFIRevision (Revision -> CabalFileInfo) -> Revision -> CabalFileInfo
forall a b. (a -> b) -> a -> b
$ Word -> Revision
Revision Word
rev
Either String (Word, Text)
_ -> Maybe CabalFileInfo
forall a. Maybe a
Nothing
Maybe (Text, Text)
Nothing -> CabalFileInfo -> Maybe CabalFileInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure CabalFileInfo
CFILatest
Maybe (Text, Text)
_ -> Maybe CabalFileInfo
forall a. Maybe a
Nothing
PackageIdentifierRevision -> Maybe PackageIdentifierRevision
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageIdentifierRevision -> Maybe PackageIdentifierRevision)
-> PackageIdentifierRevision -> Maybe PackageIdentifierRevision
forall a b. (a -> b) -> a -> b
$ PackageName
-> Version -> CabalFileInfo -> PackageIdentifierRevision
PackageIdentifierRevision PackageName
name Version
version CabalFileInfo
cfi
data Mismatch a = Mismatch
{ Mismatch a -> a
mismatchExpected :: !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
| 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 !Repo
| 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
deriving Typeable
instance Exception PantryException where
instance Show PantryException where
show :: PantryException -> String
show = Text -> String
T.unpack (Text -> String)
-> (PantryException -> Text) -> PantryException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (PantryException -> Utf8Builder) -> PantryException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PantryException -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance Display PantryException where
display :: PantryException -> Utf8Builder
display (InvalidTreeFromCasa BlobKey
blobKey ByteString
_bs) = Utf8Builder
"Invalid tree from casa: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display BlobKey
blobKey
display (PackageIdentifierRevisionParseFail Text
text) =
Utf8Builder
"Invalid package identifier (with optional revision): " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Text -> Utf8Builder
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
"Unable to parse cabal file from package " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
(RawPackageLocationImmutable -> Utf8Builder)
-> (Path Abs File -> Utf8Builder)
-> Either RawPackageLocationImmutable (Path Abs File)
-> Utf8Builder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder)
-> (Path Abs File -> String) -> Path Abs File -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> String
forall b t. Path b t -> String
toFilePath) Either RawPackageLocationImmutable (Path Abs File)
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\n\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
(PError -> Utf8Builder) -> [PError] -> Utf8Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
(\(PError Position
pos String
msg) ->
Utf8Builder
"- " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Position -> String
showPos Position
pos) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
msg Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\n")
[PError]
errs Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
(PWarning -> Utf8Builder) -> [PWarning] -> Utf8Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
(\(PWarning PWarnType
_ Position
pos String
msg) ->
Utf8Builder
"- " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Position -> String
showPos Position
pos) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
msg Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\n")
[PWarning]
warnings Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
(case Maybe Version
mversion of
Just Version
version
| Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
cabalSpecLatestVersion ->
Utf8Builder
"\n\nThe cabal file uses the cabal specification version " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
version) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", but we only support up to version " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
cabalSpecLatestVersion) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
".\nRecommended action: upgrade your build tool (e.g., `stack upgrade`)."
Maybe Version
_ -> Utf8Builder
forall a. Monoid a => a
mempty)
display (TreeWithoutCabalFile RawPackageLocationImmutable
pl) = Utf8Builder
"No cabal file found for " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
pl
display (TreeWithMultipleCabalFiles RawPackageLocationImmutable
pl [SafeFilePath]
sfps) =
Utf8Builder
"Multiple cabal files found for " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
pl Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
[Utf8Builder] -> Utf8Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Utf8Builder -> [Utf8Builder] -> [Utf8Builder]
forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " ((SafeFilePath -> Utf8Builder) -> [SafeFilePath] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map SafeFilePath -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display [SafeFilePath]
sfps))
display (MismatchedCabalName Path Abs File
fp PackageName
name) =
Utf8Builder
"cabal file path " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" does not match the package name it defines.\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"Please rename the file to: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
".cabal\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"For more information, see: https://github.com/commercialhaskell/stack/issues/317"
display (NoCabalFileFound Path Abs Dir
dir) =
Utf8Builder
"Stack looks for packages in the directories configured in\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"the 'packages' and 'extra-deps' fields defined in your stack.yaml\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"The current entry points to " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
dir) Utf8Builder -> Utf8Builder -> Utf8Builder
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
"Multiple .cabal files found in directory " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
dir) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
":\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
[Utf8Builder] -> Utf8Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Utf8Builder -> [Utf8Builder] -> [Utf8Builder]
forall a. a -> [a] -> [a]
intersperse Utf8Builder
"\n" ((Path Abs File -> Utf8Builder) -> [Path Abs File] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\Path Abs File
x -> Utf8Builder
"- " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Rel File -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Abs File
x))) [Path Abs File]
files))
display (InvalidWantedCompiler Text
t) = Utf8Builder
"Invalid wanted compiler: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
t
display (InvalidSnapshotLocation Path Abs Dir
dir Text
t) =
Utf8Builder
"Invalid snapshot location " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Text -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Text
t Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" relative to directory " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
dir)
display (InvalidOverrideCompiler WantedCompiler
x WantedCompiler
y) =
Utf8Builder
"Specified compiler for a resolver (" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display WantedCompiler
x Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"), but also specified an override compiler (" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display WantedCompiler
y Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
")"
display (InvalidFilePathSnapshot Text
t) =
Utf8Builder
"Specified snapshot as file path with " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Text -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Text
t Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", but not reading from a local file"
display (InvalidSnapshot RawSnapshotLocation
loc SomeException
e) =
Utf8Builder
"Exception while reading snapshot from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
RawSnapshotLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawSnapshotLocation
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
":\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
SomeException -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow SomeException
e
display (MismatchedPackageMetadata RawPackageLocationImmutable
loc RawPackageMetadata
pm Maybe TreeKey
mtreeKey PackageIdentifier
foundIdent) =
Utf8Builder
"Mismatched package metadata for " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nFound: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageIdentifier -> String
packageIdentifierString PackageIdentifier
foundIdent) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
(case Maybe TreeKey
mtreeKey of
Maybe TreeKey
Nothing -> Utf8Builder
forall a. Monoid a => a
mempty
Just TreeKey
treeKey -> Utf8Builder
" with tree " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> TreeKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display TreeKey
treeKey) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nExpected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageMetadata -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageMetadata
pm
display (Non200ResponseStatus Status
status) =
Utf8Builder
"Unexpected non-200 HTTP status code: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Int -> Utf8Builder
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
"Invalid blob key found, expected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display BlobKey
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", actual: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display BlobKey
mismatchActual
display (Couldn'tParseSnapshot RawSnapshotLocation
sl String
e) =
Utf8Builder
"Couldn't parse snapshot from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawSnapshotLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawSnapshotLocation
sl Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
e
display (WrongCabalFileName RawPackageLocationImmutable
pl SafeFilePath
sfp PackageName
name) =
Utf8Builder
"Wrong cabal file name for package " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
pl Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nCabal file is named " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SafeFilePath -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SafeFilePath
sfp Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", but package name is " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name) Utf8Builder -> Utf8Builder -> Utf8Builder
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
"Mismatched SHA256 hash from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nExpected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SHA256 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SHA256
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nActual: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SHA256 -> Utf8Builder
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
"Mismatched download size from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nExpected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nActual: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
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
"Download from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" was too large.\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"Expected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", stopped after receiving: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
FileSize -> Utf8Builder
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
"Mismatched SHA256 hash from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
path) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nExpected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SHA256 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SHA256
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nActual: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SHA256 -> Utf8Builder
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
"Mismatched file size from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
path) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nExpected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nActual: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
mismatchActual
display (UnknownArchiveType ArchiveLocation
loc) = Utf8Builder
"Unable to determine archive type of: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ArchiveLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display ArchiveLocation
loc
display (InvalidTarFileType ArchiveLocation
loc String
fp FileType
x) =
Utf8Builder
"Unsupported tar filetype in archive " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ArchiveLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display ArchiveLocation
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" at file " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
fp Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileType -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FileType
x
display (UnsupportedTarball ArchiveLocation
loc Text
e) =
Utf8Builder
"Unsupported tarball from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ArchiveLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display ArchiveLocation
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
e
display (NoHackageCryptographicHash PackageIdentifier
ident) =
Utf8Builder
"Not cryptographic hash found for Hackage package " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageIdentifier -> String
packageIdentifierString PackageIdentifier
ident)
display (FailedToCloneRepo Repo
repo) = Utf8Builder
"Failed to clone repo " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Repo -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Repo
repo
display (TreeReferencesMissingBlob RawPackageLocationImmutable
loc SafeFilePath
sfp BlobKey
key) =
Utf8Builder
"The package " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" needs blob " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display BlobKey
key Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" for file path " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SafeFilePath -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SafeFilePath
sfp Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", but the blob is not available"
display (CompletePackageMetadataMismatch RawPackageLocationImmutable
loc PackageMetadata
pm) =
Utf8Builder
"When completing package metadata for " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
", some values changed in the new package metadata: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
PackageMetadata -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display PackageMetadata
pm
display (CRC32Mismatch ArchiveLocation
loc String
fp Mismatch {Word32
mismatchActual :: Word32
mismatchExpected :: Word32
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
Utf8Builder
"CRC32 mismatch in ZIP file from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ArchiveLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display ArchiveLocation
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" on internal file " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
fp Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\n.Expected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Word32
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\n.Actual: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Word32
mismatchActual
display (UnknownHackagePackage PackageIdentifierRevision
pir FuzzyResults
fuzzy) =
Utf8Builder
"Could not find " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" on Hackage" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
FuzzyResults -> Utf8Builder
displayFuzzy FuzzyResults
fuzzy
display (CannotCompleteRepoNonSHA1 Repo
repo) =
Utf8Builder
"Cannot complete repo information for a non SHA1 commit due to non-reproducibility: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Repo -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Repo
repo
display (MutablePackageLocationFromUrl Text
t) =
Utf8Builder
"Cannot refer to a mutable package location from a URL: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
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
"When processing cabal file for Hackage package " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
":\nMismatched package identifier." Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nExpected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageIdentifier -> String
packageIdentifierString PackageIdentifier
mismatchExpected) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nActual: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageIdentifier -> String
packageIdentifierString PackageIdentifier
mismatchActual)
display (PackageNameParseFail Text
t) =
Utf8Builder
"Invalid package name: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
t
display (PackageVersionParseFail Text
t) =
Utf8Builder
"Invalid version: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
t
display (InvalidCabalFilePath Path Abs File
fp) =
Utf8Builder
"File path contains a name which is not a valid package name: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp)
display (DuplicatePackageNames Utf8Builder
source [(PackageName, [RawPackageLocationImmutable])]
pairs') =
Utf8Builder
"Duplicate package names (" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
source Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"):\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
((PackageName, [RawPackageLocationImmutable]) -> Utf8Builder)
-> [(PackageName, [RawPackageLocationImmutable])] -> Utf8Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
(\(PackageName
name, [RawPackageLocationImmutable]
locs) ->
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
":\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
(RawPackageLocationImmutable -> Utf8Builder)
-> [RawPackageLocationImmutable] -> Utf8Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
(\RawPackageLocationImmutable
loc -> Utf8Builder
"- " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\n")
[RawPackageLocationImmutable]
locs
)
[(PackageName, [RawPackageLocationImmutable])]
pairs'
display (MigrationFailure Text
desc Path Abs File
fp SomeException
ex) =
Utf8Builder
"Encountered error while migrating " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
desc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" database:" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\n " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SomeException -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow SomeException
ex Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nPlease report this on https://github.com/commercialhaskell/stack/issues" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"\nAs a workaround you may delete " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
desc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" database in " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" triggering its recreation."
display (ParseSnapNameException Text
t) = Utf8Builder
"Invalid snapshot name: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
t
data FuzzyResults
= FRNameNotFound ![PackageName]
| FRVersionNotFound !(NonEmpty PackageIdentifierRevision)
| FRRevisionNotFound !(NonEmpty PackageIdentifierRevision)
displayFuzzy :: FuzzyResults -> Utf8Builder
displayFuzzy :: FuzzyResults -> Utf8Builder
displayFuzzy (FRNameNotFound [PackageName]
names) =
case [PackageName] -> Maybe (NonEmpty PackageName)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [PackageName]
names of
Maybe (NonEmpty PackageName)
Nothing -> Utf8Builder
""
Just NonEmpty PackageName
names' ->
Utf8Builder
"\nPerhaps you meant " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
NonEmpty Utf8Builder -> Utf8Builder
orSeparated ((PackageName -> Utf8Builder)
-> NonEmpty PackageName -> NonEmpty Utf8Builder
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder)
-> (PackageName -> String) -> PackageName -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
packageNameString) NonEmpty PackageName
names') Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"?"
displayFuzzy (FRVersionNotFound NonEmpty PackageIdentifierRevision
pirs) =
Utf8Builder
"\nPossible candidates: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
NonEmpty Utf8Builder -> Utf8Builder
commaSeparated ((PackageIdentifierRevision -> Utf8Builder)
-> NonEmpty PackageIdentifierRevision -> NonEmpty Utf8Builder
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display NonEmpty PackageIdentifierRevision
pirs) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"."
displayFuzzy (FRRevisionNotFound NonEmpty PackageIdentifierRevision
pirs) =
Utf8Builder
"\nThe specified revision was not found.\nPossible candidates: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
NonEmpty Utf8Builder -> Utf8Builder
commaSeparated ((PackageIdentifierRevision -> Utf8Builder)
-> NonEmpty PackageIdentifierRevision -> NonEmpty Utf8Builder
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display NonEmpty PackageIdentifierRevision
pirs) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"."
orSeparated :: NonEmpty Utf8Builder -> Utf8Builder
orSeparated :: NonEmpty Utf8Builder -> Utf8Builder
orSeparated NonEmpty Utf8Builder
xs
| NonEmpty Utf8Builder -> Int
forall a. NonEmpty a -> Int
NE.length NonEmpty Utf8Builder
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = NonEmpty Utf8Builder -> Utf8Builder
forall a. NonEmpty a -> a
NE.head NonEmpty Utf8Builder
xs
| NonEmpty Utf8Builder -> Int
forall a. NonEmpty a -> Int
NE.length NonEmpty Utf8Builder
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = NonEmpty Utf8Builder -> Utf8Builder
forall a. NonEmpty a -> a
NE.head NonEmpty Utf8Builder
xs Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" or " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Utf8Builder -> Utf8Builder
forall a. NonEmpty a -> a
NE.last NonEmpty Utf8Builder
xs
| Bool
otherwise = [Utf8Builder] -> Utf8Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Utf8Builder -> [Utf8Builder] -> [Utf8Builder]
forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " (NonEmpty Utf8Builder -> [Utf8Builder]
forall a. NonEmpty a -> [a]
NE.init NonEmpty Utf8Builder
xs)) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", or " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Utf8Builder -> Utf8Builder
forall a. NonEmpty a -> a
NE.last NonEmpty Utf8Builder
xs
commaSeparated :: NonEmpty Utf8Builder -> Utf8Builder
commaSeparated :: NonEmpty Utf8Builder -> Utf8Builder
commaSeparated = NonEmpty Utf8Builder -> Utf8Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (NonEmpty Utf8Builder -> Utf8Builder)
-> (NonEmpty Utf8Builder -> NonEmpty Utf8Builder)
-> NonEmpty Utf8Builder
-> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> NonEmpty Utf8Builder -> NonEmpty Utf8Builder
forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse Utf8Builder
", "
cabalSpecLatestVersion :: Version
cabalSpecLatestVersion :: Version
cabalSpecLatestVersion =
case CabalSpecVersion
cabalSpecLatest of
CabalSpecVersion
CabalSpecV1_0 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV1_2 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV1_4 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV1_6 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV1_8 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV1_10 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV1_12 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV1_18 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV1_20 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV1_22 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV1_24 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV2_0 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV2_2 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV2_4 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
CabalSpecVersion
CabalSpecV3_0 -> [Int] -> Version
mkVersion [Int
3, Int
0]
data BuildFile = BFCabal !SafeFilePath !TreeEntry
| BFHpack !TreeEntry
deriving (Int -> BuildFile -> ShowS
[BuildFile] -> ShowS
BuildFile -> String
(Int -> BuildFile -> ShowS)
-> (BuildFile -> String)
-> ([BuildFile] -> ShowS)
-> Show BuildFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildFile] -> ShowS
$cshowList :: [BuildFile] -> ShowS
show :: BuildFile -> String
$cshow :: BuildFile -> String
showsPrec :: Int -> BuildFile -> ShowS
$cshowsPrec :: Int -> BuildFile -> ShowS
Show, BuildFile -> BuildFile -> Bool
(BuildFile -> BuildFile -> Bool)
-> (BuildFile -> BuildFile -> Bool) -> Eq BuildFile
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 -> String
(Int -> FileType -> ShowS)
-> (FileType -> String) -> ([FileType] -> ShowS) -> Show FileType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileType] -> ShowS
$cshowList :: [FileType] -> ShowS
show :: FileType -> String
$cshow :: FileType -> String
showsPrec :: Int -> FileType -> ShowS
$cshowsPrec :: Int -> FileType -> ShowS
Show, FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
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]
(FileType -> FileType)
-> (FileType -> FileType)
-> (Int -> FileType)
-> (FileType -> Int)
-> (FileType -> [FileType])
-> (FileType -> FileType -> [FileType])
-> (FileType -> FileType -> [FileType])
-> (FileType -> FileType -> FileType -> [FileType])
-> Enum 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
FileType -> FileType -> Bounded FileType
forall a. a -> a -> Bounded a
maxBound :: FileType
$cmaxBound :: FileType
minBound :: FileType
$cminBound :: FileType
Bounded)
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 <- PersistValue -> Either Text Int64
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
case Int64
i :: Int64 of
Int64
1 -> FileType -> Either Text FileType
forall a b. b -> Either a b
Right FileType
FTNormal
Int64
2 -> FileType -> Either Text FileType
forall a b. b -> Either a b
Right FileType
FTExecutable
Int64
_ -> Text -> Either Text FileType
forall a b. a -> Either a b
Left (Text -> Either Text FileType) -> Text -> Either Text FileType
forall a b. (a -> b) -> a -> b
$ Text
"Invalid FileType: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
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 -> String
(Int -> TreeEntry -> ShowS)
-> (TreeEntry -> String)
-> ([TreeEntry] -> ShowS)
-> Show TreeEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TreeEntry] -> ShowS
$cshowList :: [TreeEntry] -> ShowS
show :: TreeEntry -> String
$cshow :: TreeEntry -> String
showsPrec :: Int -> TreeEntry -> ShowS
$cshowsPrec :: Int -> TreeEntry -> ShowS
Show, TreeEntry -> TreeEntry -> Bool
(TreeEntry -> TreeEntry -> Bool)
-> (TreeEntry -> TreeEntry -> Bool) -> Eq TreeEntry
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)
newtype SafeFilePath = SafeFilePath Text
deriving (Int -> SafeFilePath -> ShowS
[SafeFilePath] -> ShowS
SafeFilePath -> String
(Int -> SafeFilePath -> ShowS)
-> (SafeFilePath -> String)
-> ([SafeFilePath] -> ShowS)
-> Show SafeFilePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SafeFilePath] -> ShowS
$cshowList :: [SafeFilePath] -> ShowS
show :: SafeFilePath -> String
$cshow :: SafeFilePath -> String
showsPrec :: Int -> SafeFilePath -> ShowS
$cshowsPrec :: Int -> SafeFilePath -> ShowS
Show, SafeFilePath -> SafeFilePath -> Bool
(SafeFilePath -> SafeFilePath -> Bool)
-> (SafeFilePath -> SafeFilePath -> Bool) -> Eq SafeFilePath
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
Eq SafeFilePath
-> (SafeFilePath -> SafeFilePath -> Ordering)
-> (SafeFilePath -> SafeFilePath -> Bool)
-> (SafeFilePath -> SafeFilePath -> Bool)
-> (SafeFilePath -> SafeFilePath -> Bool)
-> (SafeFilePath -> SafeFilePath -> Bool)
-> (SafeFilePath -> SafeFilePath -> SafeFilePath)
-> (SafeFilePath -> SafeFilePath -> SafeFilePath)
-> Ord 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
$cp1Ord :: Eq SafeFilePath
Ord, SafeFilePath -> Text
SafeFilePath -> Utf8Builder
(SafeFilePath -> Utf8Builder)
-> (SafeFilePath -> Text) -> Display SafeFilePath
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 = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (SafeFilePath -> Text) -> SafeFilePath -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeFilePath -> Text
unSafeFilePath
fromPersistValue :: PersistValue -> Either Text SafeFilePath
fromPersistValue PersistValue
v = do
Text
t <- PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
Either Text SafeFilePath
-> (SafeFilePath -> Either Text SafeFilePath)
-> Maybe SafeFilePath
-> Either Text SafeFilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text SafeFilePath
forall a b. a -> Either a b
Left (Text -> Either Text SafeFilePath)
-> Text -> Either Text SafeFilePath
forall a b. (a -> b) -> a -> b
$ Text
"Invalid SafeFilePath: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t) SafeFilePath -> Either Text SafeFilePath
forall a b. b -> Either a b
Right (Maybe SafeFilePath -> Either Text SafeFilePath)
-> Maybe SafeFilePath -> Either Text SafeFilePath
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 :: Path Abs Dir -> SafeFilePath -> m (Path Abs File)
safeFilePathtoPath Path Abs Dir
dir (SafeFilePath Text
path) = do
Path Rel File
fpath <- String -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (Text -> String
T.unpack Text
path)
Path Abs File -> m (Path Abs File)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs File -> m (Path Abs File))
-> Path Abs File -> m (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
dir Path Abs Dir -> Path Rel File -> Path Abs File
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
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"\\" Text -> Text -> Bool
`T.isInfixOf` Text
t
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"//" Text -> Text -> Bool
`T.isInfixOf` Text
t
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"\n" Text -> Text -> Bool
`T.isInfixOf` Text
t
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
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
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/'
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')) ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
t
SafeFilePath -> Maybe SafeFilePath
forall a. a -> Maybe a
Just (SafeFilePath -> Maybe SafeFilePath)
-> SafeFilePath -> Maybe SafeFilePath
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 (String -> Text
T.pack String
Hpack.packageConfig)
in case Maybe SafeFilePath
fpath of
Maybe SafeFilePath
Nothing -> String -> SafeFilePath
forall a. HasCallStack => String -> a
error (String -> SafeFilePath) -> String -> SafeFilePath
forall a b. (a -> b) -> a -> b
$ String
"hpackSafeFilePath: Not able to encode " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (String
Hpack.packageConfig)
Just SafeFilePath
sfp -> SafeFilePath
sfp
newtype TreeKey = TreeKey BlobKey
deriving (Int -> TreeKey -> ShowS
[TreeKey] -> ShowS
TreeKey -> String
(Int -> TreeKey -> ShowS)
-> (TreeKey -> String) -> ([TreeKey] -> ShowS) -> Show TreeKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TreeKey] -> ShowS
$cshowList :: [TreeKey] -> ShowS
show :: TreeKey -> String
$cshow :: TreeKey -> String
showsPrec :: Int -> TreeKey -> ShowS
$cshowsPrec :: Int -> TreeKey -> ShowS
Show, TreeKey -> TreeKey -> Bool
(TreeKey -> TreeKey -> Bool)
-> (TreeKey -> TreeKey -> Bool) -> Eq TreeKey
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
Eq TreeKey
-> (TreeKey -> TreeKey -> Ordering)
-> (TreeKey -> TreeKey -> Bool)
-> (TreeKey -> TreeKey -> Bool)
-> (TreeKey -> TreeKey -> Bool)
-> (TreeKey -> TreeKey -> Bool)
-> (TreeKey -> TreeKey -> TreeKey)
-> (TreeKey -> TreeKey -> TreeKey)
-> Ord 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
$cp1Ord :: Eq TreeKey
Ord, (forall x. TreeKey -> Rep TreeKey x)
-> (forall x. Rep TreeKey x -> TreeKey) -> Generic TreeKey
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
(TreeKey -> Value)
-> (TreeKey -> Encoding)
-> ([TreeKey] -> Value)
-> ([TreeKey] -> Encoding)
-> ToJSON TreeKey
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
(Value -> Parser TreeKey)
-> (Value -> Parser [TreeKey]) -> FromJSON 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 -> ()
(TreeKey -> ()) -> NFData TreeKey
forall a. (a -> ()) -> NFData a
rnf :: TreeKey -> ()
$crnf :: TreeKey -> ()
NFData, TreeKey -> Text
TreeKey -> Utf8Builder
(TreeKey -> Utf8Builder) -> (TreeKey -> Text) -> Display TreeKey
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 -> String
(Int -> Tree -> ShowS)
-> (Tree -> String) -> ([Tree] -> ShowS) -> Show Tree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree] -> ShowS
$cshowList :: [Tree] -> ShowS
show :: Tree -> String
$cshow :: Tree -> String
showsPrec :: Int -> Tree -> ShowS
$cshowsPrec :: Int -> Tree -> ShowS
Show, Tree -> Tree -> Bool
(Tree -> Tree -> Bool) -> (Tree -> Tree -> Bool) -> Eq Tree
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)
renderTree :: Tree -> ByteString
renderTree :: Tree -> ByteString
renderTree = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Tree -> ByteString) -> Tree -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> (Tree -> Builder) -> Tree -> ByteString
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:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (SafeFilePath -> TreeEntry -> Builder)
-> Map SafeFilePath TreeEntry -> Builder
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) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
ByteString -> Builder
byteString (SHA256 -> ByteString
SHA256.toRaw SHA256
sha) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Word -> Builder
netword Word
size' Builder -> Builder -> Builder
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 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)) Builder -> Builder -> Builder
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
parseTreeM :: MonadThrow m => (BlobKey, ByteString) -> m (TreeKey, Tree)
parseTreeM :: (BlobKey, ByteString) -> m (TreeKey, Tree)
parseTreeM (BlobKey
blobKey, ByteString
blob) =
case ByteString -> Maybe Tree
parseTree ByteString
blob of
Maybe Tree
Nothing -> PantryException -> m (TreeKey, Tree)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (BlobKey -> ByteString -> PantryException
InvalidTreeFromCasa BlobKey
blobKey ByteString
blob)
Just Tree
tree -> (TreeKey, Tree) -> m (TreeKey, 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
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString
bs1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bs2
Tree -> Maybe Tree
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 (Map SafeFilePath TreeEntry -> Tree)
-> Maybe (Map SafeFilePath TreeEntry) -> Maybe Tree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map SafeFilePath TreeEntry
-> ByteString -> Maybe (Map SafeFilePath TreeEntry)
loop Map SafeFilePath TreeEntry
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 = Map SafeFilePath TreeEntry -> Maybe (Map SafeFilePath TreeEntry)
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
_ -> Maybe SafeFilePath
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 -> FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
FTNormal
Word8
88 -> FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
FTExecutable
Word8
_ -> Maybe FileType
forall a. Maybe a
Nothing
let entry :: TreeEntry
entry = BlobKey -> FileType -> TreeEntry
TreeEntry (SHA256 -> FileSize -> BlobKey
BlobKey SHA256
sha (Word -> FileSize
FileSize (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size'))) FileType
ft
Map SafeFilePath TreeEntry
-> ByteString -> Maybe (Map SafeFilePath TreeEntry)
loop (SafeFilePath
-> TreeEntry
-> Map SafeFilePath TreeEntry
-> Map SafeFilePath TreeEntry
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
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size'
(ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just ((ByteString, ByteString) -> Maybe (ByteString, ByteString))
-> (ByteString, ByteString) -> Maybe (ByteString, ByteString)
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' <- (SHA256Exception -> Maybe SHA256)
-> (SHA256 -> Maybe SHA256)
-> Either SHA256Exception SHA256
-> Maybe SHA256
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe SHA256 -> SHA256Exception -> Maybe SHA256
forall a b. a -> b -> a
const Maybe SHA256
forall a. Maybe a
Nothing) SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just (ByteString -> Either SHA256Exception SHA256
SHA256.fromRaw ByteString
x)
(SHA256, ByteString) -> Maybe (SHA256, ByteString)
forall a. a -> Maybe a
Just (SHA256
x', ByteString
y)
takeNetword :: ByteString -> Maybe (Int, ByteString)
takeNetword =
Int -> ByteString -> Maybe (Int, ByteString)
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
58 -> (t, ByteString) -> Maybe (t, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t
accum, ByteString
rest)
| Word8
next Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
next Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57 ->
t -> ByteString -> Maybe (t, ByteString)
go
(t
accum t -> t -> t
forall a. Num a => a -> a -> a
* t
10 t -> t -> t
forall a. Num a => a -> a -> a
+ Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
next Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48))
ByteString
rest
| Bool
otherwise -> Maybe (t, ByteString)
forall a. Maybe a
Nothing
parsePackageIdentifier :: String -> Maybe PackageIdentifier
parsePackageIdentifier :: String -> Maybe PackageIdentifier
parsePackageIdentifier = (String -> Maybe PackageIdentifier)
-> (PackageIdentifier -> Maybe PackageIdentifier)
-> Either String PackageIdentifier
-> Maybe PackageIdentifier
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe PackageIdentifier -> String -> Maybe PackageIdentifier
forall a b. a -> b -> a
const Maybe PackageIdentifier
forall a. Maybe a
Nothing) PackageIdentifier -> Maybe PackageIdentifier
forall a. a -> Maybe a
Just (Either String PackageIdentifier -> Maybe PackageIdentifier)
-> (String -> Either String PackageIdentifier)
-> String
-> Maybe PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecParser PackageIdentifier
-> String -> Either String PackageIdentifier
forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec (ParsecParser PackageIdentifier
packageIdentifierParsec ParsecParser PackageIdentifier
-> ParsecParser () -> ParsecParser PackageIdentifier
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecParser ()
forall (m :: * -> *). Parsing m => m ()
Parse.eof)
packageIdentifierParsec :: ParsecParser PackageIdentifier
packageIdentifierParsec :: ParsecParser PackageIdentifier
packageIdentifierParsec = do
ident :: PackageIdentifier
ident@(PackageIdentifier PackageName
_ Version
v) <- ParsecParser PackageIdentifier
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
Bool -> ParsecParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
nullVersion)
PackageIdentifier -> ParsecParser PackageIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageIdentifier
ident
parsePackageName :: String -> Maybe PackageName
parsePackageName :: String -> Maybe PackageName
parsePackageName = String -> Maybe PackageName
forall a. Parsec a => String -> Maybe a
Distribution.Text.simpleParse
parsePackageNameThrowing :: MonadThrow m => String -> m PackageName
parsePackageNameThrowing :: String -> m PackageName
parsePackageNameThrowing String
str =
case String -> Maybe PackageName
parsePackageName String
str of
Maybe PackageName
Nothing -> PantryException -> m PackageName
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PantryException -> m PackageName)
-> PantryException -> m PackageName
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
PackageNameParseFail (Text -> PantryException) -> Text -> PantryException
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
str
Just PackageName
pn -> PackageName -> m PackageName
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageName
pn
parseVersion :: String -> Maybe Version
parseVersion :: String -> Maybe Version
parseVersion = String -> Maybe Version
forall a. Parsec a => String -> Maybe a
Distribution.Text.simpleParse
parseVersionThrowing :: MonadThrow m => String -> m Version
parseVersionThrowing :: String -> m Version
parseVersionThrowing String
str =
case String -> Maybe Version
parseVersion String
str of
Maybe Version
Nothing -> PantryException -> m Version
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PantryException -> m Version) -> PantryException -> m Version
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
PackageVersionParseFail (Text -> PantryException) -> Text -> PantryException
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
str
Just Version
v -> Version -> m Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v
parseVersionRange :: String -> Maybe VersionRange
parseVersionRange :: String -> Maybe VersionRange
parseVersionRange = String -> Maybe VersionRange
forall a. Parsec a => String -> Maybe a
Distribution.Text.simpleParse
parseModuleName :: String -> Maybe ModuleName
parseModuleName :: String -> Maybe ModuleName
parseModuleName = String -> Maybe ModuleName
forall a. Parsec a => String -> Maybe a
Distribution.Text.simpleParse
parseFlagName :: String -> Maybe FlagName
parseFlagName :: String -> Maybe FlagName
parseFlagName = String -> Maybe FlagName
forall a. Parsec a => String -> Maybe a
Distribution.Text.simpleParse
packageNameString :: PackageName -> String
packageNameString :: PackageName -> String
packageNameString = PackageName -> String
unPackageName
packageIdentifierString :: PackageIdentifier -> String
packageIdentifierString :: PackageIdentifier -> String
packageIdentifierString = PackageIdentifier -> String
forall a. Pretty a => a -> String
Distribution.Text.display
versionString :: Version -> String
versionString :: Version -> String
versionString = Version -> String
forall a. Pretty a => a -> String
Distribution.Text.display
flagNameString :: FlagName -> String
flagNameString :: FlagName -> String
flagNameString = FlagName -> String
unFlagName
moduleNameString :: ModuleName -> String
moduleNameString :: ModuleName -> String
moduleNameString = ModuleName -> String
forall a. Pretty a => a -> String
Distribution.Text.display
data OptionalSubdirs
= OSSubdirs !(NonEmpty Text)
| OSPackageMetadata !Text !RawPackageMetadata
deriving (Int -> OptionalSubdirs -> ShowS
[OptionalSubdirs] -> ShowS
OptionalSubdirs -> String
(Int -> OptionalSubdirs -> ShowS)
-> (OptionalSubdirs -> String)
-> ([OptionalSubdirs] -> ShowS)
-> Show OptionalSubdirs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionalSubdirs] -> ShowS
$cshowList :: [OptionalSubdirs] -> ShowS
show :: OptionalSubdirs -> String
$cshow :: OptionalSubdirs -> String
showsPrec :: Int -> OptionalSubdirs -> ShowS
$cshowsPrec :: Int -> OptionalSubdirs -> ShowS
Show, OptionalSubdirs -> OptionalSubdirs -> Bool
(OptionalSubdirs -> OptionalSubdirs -> Bool)
-> (OptionalSubdirs -> OptionalSubdirs -> Bool)
-> Eq OptionalSubdirs
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. OptionalSubdirs -> Rep OptionalSubdirs x)
-> (forall x. Rep OptionalSubdirs x -> OptionalSubdirs)
-> Generic OptionalSubdirs
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 -> String
(Int -> RawPackageMetadata -> ShowS)
-> (RawPackageMetadata -> String)
-> ([RawPackageMetadata] -> ShowS)
-> Show RawPackageMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawPackageMetadata] -> ShowS
$cshowList :: [RawPackageMetadata] -> ShowS
show :: RawPackageMetadata -> String
$cshow :: RawPackageMetadata -> String
showsPrec :: Int -> RawPackageMetadata -> ShowS
$cshowsPrec :: Int -> RawPackageMetadata -> ShowS
Show, RawPackageMetadata -> RawPackageMetadata -> Bool
(RawPackageMetadata -> RawPackageMetadata -> Bool)
-> (RawPackageMetadata -> RawPackageMetadata -> Bool)
-> Eq RawPackageMetadata
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
Eq RawPackageMetadata
-> (RawPackageMetadata -> RawPackageMetadata -> Ordering)
-> (RawPackageMetadata -> RawPackageMetadata -> Bool)
-> (RawPackageMetadata -> RawPackageMetadata -> Bool)
-> (RawPackageMetadata -> RawPackageMetadata -> Bool)
-> (RawPackageMetadata -> RawPackageMetadata -> Bool)
-> (RawPackageMetadata -> RawPackageMetadata -> RawPackageMetadata)
-> (RawPackageMetadata -> RawPackageMetadata -> RawPackageMetadata)
-> Ord 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
$cp1Ord :: Eq RawPackageMetadata
Ord, (forall x. RawPackageMetadata -> Rep RawPackageMetadata x)
-> (forall x. Rep RawPackageMetadata x -> RawPackageMetadata)
-> Generic RawPackageMetadata
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 = [Utf8Builder] -> Utf8Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Utf8Builder] -> Utf8Builder) -> [Utf8Builder] -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> [Utf8Builder] -> [Utf8Builder]
forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " ([Utf8Builder] -> [Utf8Builder]) -> [Utf8Builder] -> [Utf8Builder]
forall a b. (a -> b) -> a -> b
$ [Maybe Utf8Builder] -> [Utf8Builder]
forall a. [Maybe a] -> [a]
catMaybes
[ (\PackageName
name -> Utf8Builder
"name == " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name)) (PackageName -> Utf8Builder)
-> Maybe PackageName -> Maybe Utf8Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPackageMetadata -> Maybe PackageName
rpmName RawPackageMetadata
rpm
, (\Version
version -> Utf8Builder
"version == " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
version)) (Version -> Utf8Builder) -> Maybe Version -> Maybe Utf8Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPackageMetadata -> Maybe Version
rpmVersion RawPackageMetadata
rpm
, (\TreeKey
tree -> Utf8Builder
"tree == " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> TreeKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display TreeKey
tree) (TreeKey -> Utf8Builder) -> Maybe TreeKey -> Maybe Utf8Builder
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 -> String
(Int -> PackageMetadata -> ShowS)
-> (PackageMetadata -> String)
-> ([PackageMetadata] -> ShowS)
-> Show PackageMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageMetadata] -> ShowS
$cshowList :: [PackageMetadata] -> ShowS
show :: PackageMetadata -> String
$cshow :: PackageMetadata -> String
showsPrec :: Int -> PackageMetadata -> ShowS
$cshowsPrec :: Int -> PackageMetadata -> ShowS
Show, PackageMetadata -> PackageMetadata -> Bool
(PackageMetadata -> PackageMetadata -> Bool)
-> (PackageMetadata -> PackageMetadata -> Bool)
-> Eq PackageMetadata
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
Eq PackageMetadata
-> (PackageMetadata -> PackageMetadata -> Ordering)
-> (PackageMetadata -> PackageMetadata -> Bool)
-> (PackageMetadata -> PackageMetadata -> Bool)
-> (PackageMetadata -> PackageMetadata -> Bool)
-> (PackageMetadata -> PackageMetadata -> Bool)
-> (PackageMetadata -> PackageMetadata -> PackageMetadata)
-> (PackageMetadata -> PackageMetadata -> PackageMetadata)
-> Ord 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
$cp1Ord :: Eq PackageMetadata
Ord, (forall x. PackageMetadata -> Rep PackageMetadata x)
-> (forall x. Rep PackageMetadata x -> PackageMetadata)
-> Generic PackageMetadata
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 = [Utf8Builder] -> Utf8Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Utf8Builder] -> Utf8Builder) -> [Utf8Builder] -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> [Utf8Builder] -> [Utf8Builder]
forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " ([Utf8Builder] -> [Utf8Builder]) -> [Utf8Builder] -> [Utf8Builder]
forall a b. (a -> b) -> a -> b
$
[ Utf8Builder
"ident == " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageIdentifier -> String
packageIdentifierString (PackageIdentifier -> String) -> PackageIdentifier -> String
forall a b. (a -> b) -> a -> b
$ PackageMetadata -> PackageIdentifier
pmIdent PackageMetadata
pm)
, Utf8Builder
"tree == " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> TreeKey -> Utf8Builder
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 Object -> Text -> WarningParser (Maybe BlobKey)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"cabal-file"
BlobKey
pantryTree :: BlobKey <- Object
o Object -> Text -> WarningParser BlobKey
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"pantry-tree"
CabalString PackageName
pkgName <- Object
o Object -> Text -> WarningParser (CabalString PackageName)
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"name"
CabalString Version
pkgVersion <- Object
o Object -> Text -> WarningParser (CabalString Version)
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 -> PackageIdentifier
PackageIdentifier {PackageName
Version
pkgVersion :: Version
pkgVersion :: Version
pkgName :: PackageName
pkgName :: PackageName
..}
PackageMetadata -> WarningParser PackageMetadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageMetadata :: PackageIdentifier -> TreeKey -> PackageMetadata
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 (PackageName -> Maybe PackageName
forall a. a -> Maybe a
Just PackageName
name) (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
version) (TreeKey -> Maybe TreeKey
forall a. a -> Maybe a
Just (TreeKey -> Maybe TreeKey) -> TreeKey -> Maybe TreeKey
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 -> String
(Int -> RelFilePath -> ShowS)
-> (RelFilePath -> String)
-> ([RelFilePath] -> ShowS)
-> Show RelFilePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelFilePath] -> ShowS
$cshowList :: [RelFilePath] -> ShowS
show :: RelFilePath -> String
$cshow :: RelFilePath -> String
showsPrec :: Int -> RelFilePath -> ShowS
$cshowsPrec :: Int -> RelFilePath -> ShowS
Show, [RelFilePath] -> Encoding
[RelFilePath] -> Value
RelFilePath -> Encoding
RelFilePath -> Value
(RelFilePath -> Value)
-> (RelFilePath -> Encoding)
-> ([RelFilePath] -> Value)
-> ([RelFilePath] -> Encoding)
-> ToJSON RelFilePath
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
(Value -> Parser RelFilePath)
-> (Value -> Parser [RelFilePath]) -> FromJSON 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
(RelFilePath -> RelFilePath -> Bool)
-> (RelFilePath -> RelFilePath -> Bool) -> Eq RelFilePath
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
Eq RelFilePath
-> (RelFilePath -> RelFilePath -> Ordering)
-> (RelFilePath -> RelFilePath -> Bool)
-> (RelFilePath -> RelFilePath -> Bool)
-> (RelFilePath -> RelFilePath -> Bool)
-> (RelFilePath -> RelFilePath -> Bool)
-> (RelFilePath -> RelFilePath -> RelFilePath)
-> (RelFilePath -> RelFilePath -> RelFilePath)
-> Ord 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
$cp1Ord :: Eq RelFilePath
Ord, (forall x. RelFilePath -> Rep RelFilePath x)
-> (forall x. Rep RelFilePath x -> RelFilePath)
-> Generic RelFilePath
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 -> ()
(RelFilePath -> ()) -> NFData RelFilePath
forall a. (a -> ()) -> NFData a
rnf :: RelFilePath -> ()
$crnf :: RelFilePath -> ()
NFData, RelFilePath -> Text
RelFilePath -> Utf8Builder
(RelFilePath -> Utf8Builder)
-> (RelFilePath -> Text) -> Display RelFilePath
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 -> String
(Int -> ArchiveLocation -> ShowS)
-> (ArchiveLocation -> String)
-> ([ArchiveLocation] -> ShowS)
-> Show ArchiveLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArchiveLocation] -> ShowS
$cshowList :: [ArchiveLocation] -> ShowS
show :: ArchiveLocation -> String
$cshow :: ArchiveLocation -> String
showsPrec :: Int -> ArchiveLocation -> ShowS
$cshowsPrec :: Int -> ArchiveLocation -> ShowS
Show, ArchiveLocation -> ArchiveLocation -> Bool
(ArchiveLocation -> ArchiveLocation -> Bool)
-> (ArchiveLocation -> ArchiveLocation -> Bool)
-> Eq ArchiveLocation
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
Eq ArchiveLocation
-> (ArchiveLocation -> ArchiveLocation -> Ordering)
-> (ArchiveLocation -> ArchiveLocation -> Bool)
-> (ArchiveLocation -> ArchiveLocation -> Bool)
-> (ArchiveLocation -> ArchiveLocation -> Bool)
-> (ArchiveLocation -> ArchiveLocation -> Bool)
-> (ArchiveLocation -> ArchiveLocation -> ArchiveLocation)
-> (ArchiveLocation -> ArchiveLocation -> ArchiveLocation)
-> Ord 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
$cp1Ord :: Eq ArchiveLocation
Ord, (forall x. ArchiveLocation -> Rep ArchiveLocation x)
-> (forall x. Rep ArchiveLocation x -> ArchiveLocation)
-> Generic ArchiveLocation
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) = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url
display (ALFilePath ResolvedPath File
resolved) = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder) -> String -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Path Abs File -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> String) -> Path Abs File -> String
forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> Path Abs File
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 Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"url") WarningParser Text
-> (Text -> WarningParser (Unresolved ArchiveLocation))
-> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> WarningParser (Unresolved ArchiveLocation))
-> (Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation))
-> Either Text (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> String)
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation))
-> (Text -> Either Text (Unresolved ArchiveLocation))
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Unresolved ArchiveLocation)
validateUrl) WarningParser (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"filepath") WarningParser Text
-> (Text -> WarningParser (Unresolved ArchiveLocation))
-> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> WarningParser (Unresolved ArchiveLocation))
-> (Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation))
-> Either Text (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> String)
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation))
-> (Text -> Either Text (Unresolved ArchiveLocation))
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Unresolved ArchiveLocation)
validateFilePath) WarningParser (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"archive") WarningParser Text
-> (Text -> WarningParser (Unresolved ArchiveLocation))
-> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> WarningParser (Unresolved ArchiveLocation))
-> (Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation))
-> Either Text (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> String)
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation))
-> (Text -> Either Text (Unresolved ArchiveLocation))
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Unresolved ArchiveLocation)
parseArchiveLocationText) WarningParser (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"location") WarningParser Text
-> (Text -> WarningParser (Unresolved ArchiveLocation))
-> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> WarningParser (Unresolved ArchiveLocation))
-> (Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation))
-> Either Text (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> String)
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation))
-> (Text -> Either Text (Unresolved ArchiveLocation))
-> Text
-> WarningParser (Unresolved ArchiveLocation)
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 -> Text -> Either Text (Unresolved ArchiveLocation)
forall a b. a -> Either a b
Left (Text -> Either Text (Unresolved ArchiveLocation))
-> Text -> Either Text (Unresolved ArchiveLocation)
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: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e1
, Text
" File path error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e2
]
Right Unresolved ArchiveLocation
x -> Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
forall a b. b -> Either a b
Right Unresolved ArchiveLocation
x
Right Unresolved ArchiveLocation
x -> Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
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 String -> Either SomeException Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> Either SomeException Request)
-> String -> Either SomeException Request
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t of
Left SomeException
_ -> Text -> Either Text (Unresolved ArchiveLocation)
forall a b. a -> Either a b
Left (Text -> Either Text (Unresolved ArchiveLocation))
-> Text -> Either Text (Unresolved ArchiveLocation)
forall a b. (a -> b) -> a -> b
$ Text
"Could not parse URL: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
Right Request
_ -> Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation))
-> Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
forall a b. (a -> b) -> a -> b
$ ArchiveLocation -> Unresolved ArchiveLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArchiveLocation -> Unresolved ArchiveLocation)
-> ArchiveLocation -> Unresolved ArchiveLocation
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 (Text -> Bool) -> [Text] -> Bool
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 Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation))
-> Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO ArchiveLocation)
-> Unresolved ArchiveLocation
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO ArchiveLocation)
-> Unresolved ArchiveLocation)
-> (Maybe (Path Abs Dir) -> IO ArchiveLocation)
-> Unresolved ArchiveLocation
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir ->
case Maybe (Path Abs Dir)
mdir of
Maybe (Path Abs Dir)
Nothing -> PantryException -> IO ArchiveLocation
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PantryException -> IO ArchiveLocation)
-> PantryException -> IO ArchiveLocation
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
InvalidFilePathSnapshot Text
t
Just Path Abs Dir
dir -> do
Path Abs File
abs' <- Path Abs Dir -> String -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs File)
resolveFile Path Abs Dir
dir (String -> IO (Path Abs File)) -> String -> IO (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
ArchiveLocation -> IO ArchiveLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArchiveLocation -> IO ArchiveLocation)
-> ArchiveLocation -> IO ArchiveLocation
forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> ArchiveLocation
ALFilePath (ResolvedPath File -> ArchiveLocation)
-> ResolvedPath File -> ArchiveLocation
forall a b. (a -> b) -> a -> b
$ RelFilePath -> Path Abs File -> ResolvedPath File
forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath Text
t) Path Abs File
abs'
else Text -> Either Text (Unresolved ArchiveLocation)
forall a b. a -> Either a b
Left (Text -> Either Text (Unresolved ArchiveLocation))
-> Text -> Either Text (Unresolved ArchiveLocation)
forall a b. (a -> b) -> a -> b
$ Text
"Does not have an archive file extension: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
instance ToJSON RawPackageLocation where
toJSON :: RawPackageLocation -> Value
toJSON (RPLImmutable RawPackageLocationImmutable
rpli) = RawPackageLocationImmutable -> Value
forall a. ToJSON a => a -> Value
toJSON RawPackageLocationImmutable
rpli
toJSON (RPLMutable ResolvedPath Dir
resolved) = RelFilePath -> Value
forall a. ToJSON a => a -> Value
toJSON (ResolvedPath Dir -> RelFilePath
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 =
(((WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))))
-> ((RawPackageLocationImmutable -> RawPackageLocation)
-> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> (RawPackageLocationImmutable -> RawPackageLocation)
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Unresolved (NonEmpty RawPackageLocationImmutable)
-> Unresolved (NonEmpty RawPackageLocation))
-> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Unresolved (NonEmpty RawPackageLocationImmutable)
-> Unresolved (NonEmpty RawPackageLocation))
-> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> ((RawPackageLocationImmutable -> RawPackageLocation)
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> Unresolved (NonEmpty RawPackageLocation))
-> (RawPackageLocationImmutable -> RawPackageLocation)
-> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(NonEmpty RawPackageLocationImmutable
-> NonEmpty RawPackageLocation)
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> Unresolved (NonEmpty RawPackageLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((NonEmpty RawPackageLocationImmutable
-> NonEmpty RawPackageLocation)
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> Unresolved (NonEmpty RawPackageLocation))
-> ((RawPackageLocationImmutable -> RawPackageLocation)
-> NonEmpty RawPackageLocationImmutable
-> NonEmpty RawPackageLocation)
-> (RawPackageLocationImmutable -> RawPackageLocation)
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> Unresolved (NonEmpty RawPackageLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(RawPackageLocationImmutable -> RawPackageLocation)
-> NonEmpty RawPackageLocationImmutable
-> NonEmpty RawPackageLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) RawPackageLocationImmutable -> RawPackageLocation
RPLImmutable (Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)) Parser
(WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> Parser
(WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> Parser
(WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((Unresolved (NonEmpty RawPackageLocation)
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))
forall a. a -> WithJSONWarnings a
noJSONWarnings (Unresolved (NonEmpty RawPackageLocation)
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> (Text -> Unresolved (NonEmpty RawPackageLocation))
-> Text
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Unresolved (NonEmpty RawPackageLocation)
mkMutable) (Text
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> Parser Text
-> Parser
(WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
where
mkMutable :: Text -> Unresolved (NonEmpty RawPackageLocation)
mkMutable :: Text -> Unresolved (NonEmpty RawPackageLocation)
mkMutable Text
t = (Maybe (Path Abs Dir) -> IO (NonEmpty RawPackageLocation))
-> Unresolved (NonEmpty RawPackageLocation)
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO (NonEmpty RawPackageLocation))
-> Unresolved (NonEmpty RawPackageLocation))
-> (Maybe (Path Abs Dir) -> IO (NonEmpty RawPackageLocation))
-> Unresolved (NonEmpty RawPackageLocation)
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 -> PantryException -> IO (NonEmpty RawPackageLocation)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PantryException -> IO (NonEmpty RawPackageLocation))
-> PantryException -> IO (NonEmpty RawPackageLocation)
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
MutablePackageLocationFromUrl Text
t
Just Path Abs Dir
dir -> do
Path Abs Dir
abs' <- Path Abs Dir -> String -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs Dir)
resolveDir Path Abs Dir
dir (String -> IO (Path Abs Dir)) -> String -> IO (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
NonEmpty RawPackageLocation -> IO (NonEmpty RawPackageLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty RawPackageLocation -> IO (NonEmpty RawPackageLocation))
-> NonEmpty RawPackageLocation -> IO (NonEmpty RawPackageLocation)
forall a b. (a -> b) -> a -> b
$ RawPackageLocation -> NonEmpty RawPackageLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawPackageLocation -> NonEmpty RawPackageLocation)
-> RawPackageLocation -> NonEmpty RawPackageLocation
forall a b. (a -> b) -> a -> b
$ ResolvedPath Dir -> RawPackageLocation
RPLMutable (ResolvedPath Dir -> RawPackageLocation)
-> ResolvedPath Dir -> RawPackageLocation
forall a b. (a -> b) -> a -> b
$ RelFilePath -> Path Abs Dir -> ResolvedPath Dir
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) = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Text
"hackage" Text -> PackageIdentifierRevision -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PackageIdentifierRevision
pir]
, [(Text, Value)]
-> (TreeKey -> [(Text, Value)]) -> Maybe TreeKey -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\TreeKey
tree -> [Text
"pantry-tree" Text -> TreeKey -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TreeKey
tree]) Maybe TreeKey
mtree
]
toJSON (RPLIArchive (RawArchive ArchiveLocation
loc Maybe SHA256
msha Maybe FileSize
msize Text
subdir) RawPackageMetadata
rpm) = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ case ArchiveLocation
loc of
ALUrl Text
url -> [Text
"url" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
url]
ALFilePath ResolvedPath File
resolved -> [Text
"filepath" Text -> RelFilePath -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved]
, [(Text, Value)]
-> (SHA256 -> [(Text, Value)]) -> Maybe SHA256 -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\SHA256
sha -> [Text
"sha256" Text -> SHA256 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SHA256
sha]) Maybe SHA256
msha
, [(Text, Value)]
-> (FileSize -> [(Text, Value)])
-> Maybe FileSize
-> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FileSize
size' -> [Text
"size" Text -> FileSize -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FileSize
size']) Maybe FileSize
msize
, if Text -> Bool
T.null Text
subdir then [] else [Text
"subdir" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
subdir]
, RawPackageMetadata -> [(Text, Value)]
rpmToPairs RawPackageMetadata
rpm
]
toJSON (RPLIRepo (Repo Text
url Text
commit RepoType
typ Text
subdir) RawPackageMetadata
rpm) = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ Text
urlKey Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
url
, Text
"commit" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
commit
]
, if Text -> Bool
T.null Text
subdir then [] else [Text
"subdir" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
subdir]
, RawPackageMetadata -> [(Text, Value)]
rpmToPairs RawPackageMetadata
rpm
]
where
urlKey :: Text
urlKey =
case RepoType
typ of
RepoType
RepoGit -> Text
"git"
RepoType
RepoHg -> Text
"hg"
rpmToPairs :: RawPackageMetadata -> [(Text, Value)]
rpmToPairs :: RawPackageMetadata -> [(Text, Value)]
rpmToPairs (RawPackageMetadata Maybe PackageName
mname Maybe Version
mversion Maybe TreeKey
mtree) = [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [(Text, Value)]
-> (PackageName -> [(Text, Value)])
-> Maybe PackageName
-> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PackageName
name -> [Text
"name" Text -> CabalString PackageName -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString PackageName
name]) Maybe PackageName
mname
, [(Text, Value)]
-> (Version -> [(Text, Value)]) -> Maybe Version -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Version
version -> [Text
"version" Text -> CabalString Version -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Version -> CabalString Version
forall a. a -> CabalString a
CabalString Version
version]) Maybe Version
mversion
, [(Text, Value)]
-> (TreeKey -> [(Text, Value)]) -> Maybe TreeKey -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\TreeKey
tree -> [Text
"pantry-tree" Text -> TreeKey -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
archiveObject Value
v Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
hackageObject Value
v Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall (f :: * -> *).
Applicative f =>
Value -> Parser (WithJSONWarnings (f PackageLocationImmutable))
github Value
v
Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Could not parse a UnresolvedPackageLocationImmutable from: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
v)
where
repoObject :: Value -> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
repoObject :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
repoObject = String
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackageLocationImmutable.PLIRepo" ((Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable)))
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
PackageMetadata
pm <- Object -> WarningParser PackageMetadata
parsePackageMetadata Object
o
Text
repoSubdir <- Object
o Object -> Text -> WarningParser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"subdir" WarningParser (Maybe Text) -> Text -> WarningParser Text
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Text
""
Text
repoCommit <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"commit"
(RepoType
repoType, Text
repoUrl) <-
(Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"git" WarningParser Text
-> (Text -> WriterT WarningParserMonoid Parser (RepoType, Text))
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
url -> (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RepoType
RepoGit, Text
url)) WriterT WarningParserMonoid Parser (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hg" WarningParser Text
-> (Text -> WriterT WarningParserMonoid Parser (RepoType, Text))
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
url -> (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RepoType
RepoHg, Text
url))
Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable))
-> Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ PackageLocationImmutable -> Unresolved PackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageLocationImmutable -> Unresolved PackageLocationImmutable)
-> PackageLocationImmutable -> Unresolved PackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ Repo -> PackageMetadata -> PackageLocationImmutable
PLIRepo Repo :: Text -> Text -> RepoType -> Text -> Repo
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 =
String
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackageLocationImmutable.PLIArchive" ((Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable)))
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
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 Object -> Text -> WarningParser SHA256
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"sha256"
FileSize
archiveSize <- Object
o Object -> Text -> WarningParser FileSize
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"size"
Text
archiveSubdir <- Object
o Object -> Text -> WarningParser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"subdir" WarningParser (Maybe Text) -> Text -> WarningParser Text
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Text
""
Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable))
-> Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO PackageLocationImmutable)
-> Unresolved PackageLocationImmutable
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO PackageLocationImmutable)
-> Unresolved PackageLocationImmutable)
-> (Maybe (Path Abs Dir) -> IO PackageLocationImmutable)
-> Unresolved PackageLocationImmutable
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
PackageLocationImmutable -> IO PackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageLocationImmutable -> IO PackageLocationImmutable)
-> PackageLocationImmutable -> IO PackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ Archive -> PackageMetadata -> PackageLocationImmutable
PLIArchive Archive :: ArchiveLocation -> SHA256 -> FileSize -> Text -> Archive
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 =
String
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackagelocationimmutable.PLIHackage (Object)" ((Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable)))
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
BlobKey
treeKey <- Object
o Object -> Text -> WarningParser BlobKey
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"pantry-tree"
Text
htxt <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hackage"
case Text -> Either PantryException (PackageIdentifier, BlobKey)
parseHackageText Text
htxt of
Left PantryException
e -> String -> WarningParser (Unresolved PackageLocationImmutable)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser (Unresolved PackageLocationImmutable))
-> String -> WarningParser (Unresolved PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ PantryException -> String
forall a. Show a => a -> String
show PantryException
e
Right (PackageIdentifier
pkgIdentifier, BlobKey
blobKey) ->
Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable))
-> Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ PackageLocationImmutable -> Unresolved PackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageLocationImmutable -> Unresolved PackageLocationImmutable)
-> PackageLocationImmutable -> Unresolved PackageLocationImmutable
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 =
String
-> (Object -> WarningParser (f PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (f PackageLocationImmutable))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackagelocationimmutable.PLIArchive:github" (\Object
o -> do
PackageMetadata
pm <- Object -> WarningParser PackageMetadata
parsePackageMetadata Object
o
GitHubRepo Text
ghRepo <- Object
o Object -> Text -> WarningParser GitHubRepo
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"github"
Text
commit <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"commit"
let archiveLocation :: ArchiveLocation
archiveLocation = Text -> ArchiveLocation
ALUrl (Text -> ArchiveLocation) -> Text -> ArchiveLocation
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 Object -> Text -> WarningParser SHA256
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"sha256"
FileSize
archiveSize <- Object
o Object -> Text -> WarningParser FileSize
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"size"
Text
archiveSubdir <- Object
o Object -> Text -> WarningParser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"subdir" WarningParser (Maybe Text) -> Text -> WarningParser Text
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Text
""
f PackageLocationImmutable
-> WarningParser (f PackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f PackageLocationImmutable
-> WarningParser (f PackageLocationImmutable))
-> f PackageLocationImmutable
-> WarningParser (f PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ PackageLocationImmutable -> f PackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageLocationImmutable -> f PackageLocationImmutable)
-> PackageLocationImmutable -> f PackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ Archive -> PackageMetadata -> PackageLocationImmutable
PLIArchive Archive :: ArchiveLocation -> SHA256 -> FileSize -> Text -> Archive
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
Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
hackageText Value
v
Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
hackageObject Value
v
Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
repo Value
v
Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
archiveObject Value
v
Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
github Value
v
Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Could not parse a UnresolvedRawPackageLocationImmutable from: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
v)
where
http :: Value -> Parser (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable)))
http :: Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
http = String
-> (Text
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"UnresolvedPackageLocationImmutable.RPLIArchive (Text)" ((Text
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> (Text
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case Text -> Either Text (Unresolved ArchiveLocation)
parseArchiveLocationText Text
t of
Left Text
_ -> String
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> String
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ String
"Invalid archive location: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
Right (Unresolved Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation) ->
WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ Unresolved (NonEmpty RawPackageLocationImmutable)
-> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
forall a. a -> WithJSONWarnings a
noJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable)
-> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO (NonEmpty RawPackageLocationImmutable))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir)
-> IO (NonEmpty RawPackageLocationImmutable))
-> Unresolved (NonEmpty RawPackageLocationImmutable))
-> (Maybe (Path Abs Dir)
-> IO (NonEmpty RawPackageLocationImmutable))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
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 = Maybe a
forall a. Maybe a
Nothing
raSize :: Maybe a
raSize = Maybe a
forall a. Maybe a
Nothing
raSubdir :: Text
raSubdir = Text
T.empty
NonEmpty RawPackageLocationImmutable
-> IO (NonEmpty RawPackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty RawPackageLocationImmutable
-> IO (NonEmpty RawPackageLocationImmutable))
-> NonEmpty RawPackageLocationImmutable
-> IO (NonEmpty RawPackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ RawPackageLocationImmutable -> NonEmpty RawPackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawPackageLocationImmutable
-> NonEmpty RawPackageLocationImmutable)
-> RawPackageLocationImmutable
-> NonEmpty RawPackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ RawArchive -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIArchive RawArchive :: ArchiveLocation
-> Maybe SHA256 -> Maybe FileSize -> Text -> RawArchive
RawArchive {Maybe SHA256
Maybe FileSize
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 = String
-> (Text
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"UnresolvedPackageLocationImmutable.UPLIHackage (Text)" ((Text
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> (Text
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case Text -> Either PantryException PackageIdentifierRevision
parsePackageIdentifierRevision Text
t of
Left PantryException
e -> String
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> String
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ PantryException -> String
forall a. Show a => a -> String
show PantryException
e
Right PackageIdentifierRevision
pir -> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ Unresolved (NonEmpty RawPackageLocationImmutable)
-> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
forall a. a -> WithJSONWarnings a
noJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable)
-> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable))
-> NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ RawPackageLocationImmutable -> NonEmpty RawPackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawPackageLocationImmutable
-> NonEmpty RawPackageLocationImmutable)
-> RawPackageLocationImmutable
-> NonEmpty RawPackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ PackageIdentifierRevision
-> Maybe TreeKey -> RawPackageLocationImmutable
RPLIHackage PackageIdentifierRevision
pir Maybe TreeKey
forall a. Maybe a
Nothing
hackageObject :: Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
hackageObject = String
-> (Object
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackageLocationImmutable.UPLIHackage" ((Object
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> (Object
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ \Object
o -> (NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure(NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable))
-> (RawPackageLocationImmutable
-> NonEmpty RawPackageLocationImmutable)
-> RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RawPackageLocationImmutable -> NonEmpty RawPackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable))
-> WriterT WarningParserMonoid Parser RawPackageLocationImmutable
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PackageIdentifierRevision
-> Maybe TreeKey -> RawPackageLocationImmutable
RPLIHackage
(PackageIdentifierRevision
-> Maybe TreeKey -> RawPackageLocationImmutable)
-> WriterT WarningParserMonoid Parser PackageIdentifierRevision
-> WriterT
WarningParserMonoid
Parser
(Maybe TreeKey -> RawPackageLocationImmutable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object
-> Text
-> WriterT WarningParserMonoid Parser PackageIdentifierRevision
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hackage"
WriterT
WarningParserMonoid
Parser
(Maybe TreeKey -> RawPackageLocationImmutable)
-> WriterT WarningParserMonoid Parser (Maybe TreeKey)
-> WriterT WarningParserMonoid Parser RawPackageLocationImmutable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Text -> WriterT WarningParserMonoid Parser (Maybe TreeKey)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"pantry-tree")
optionalSubdirs :: Object -> WarningParser OptionalSubdirs
optionalSubdirs :: Object -> WarningParser OptionalSubdirs
optionalSubdirs Object
o =
case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
"subdirs" Object
o of
Just Value
v' -> do
Text -> WarningParser ()
tellJSONField Text
"subdirs"
[Text]
subdirs <- Parser [Text] -> WarningParser [Text]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser [Text] -> WarningParser [Text])
-> Parser [Text] -> WarningParser [Text]
forall a b. (a -> b) -> a -> b
$ Value -> Parser [Text]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v'
case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Text]
subdirs of
Maybe (NonEmpty Text)
Nothing -> String -> WarningParser OptionalSubdirs
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid empty subdirs"
Just NonEmpty Text
x -> OptionalSubdirs -> WarningParser OptionalSubdirs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OptionalSubdirs -> WarningParser OptionalSubdirs)
-> OptionalSubdirs -> WarningParser OptionalSubdirs
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> OptionalSubdirs
OSSubdirs NonEmpty Text
x
Maybe Value
Nothing -> Text -> RawPackageMetadata -> OptionalSubdirs
OSPackageMetadata
(Text -> RawPackageMetadata -> OptionalSubdirs)
-> WarningParser Text
-> WriterT
WarningParserMonoid Parser (RawPackageMetadata -> OptionalSubdirs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WarningParser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"subdir" WarningParser (Maybe Text) -> Text -> WarningParser Text
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Text
T.empty
WriterT
WarningParserMonoid Parser (RawPackageMetadata -> OptionalSubdirs)
-> WriterT WarningParserMonoid Parser RawPackageMetadata
-> WarningParser OptionalSubdirs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe PackageName
-> Maybe Version
-> Maybe TreeKey
-> Maybe BlobKey
-> RawPackageMetadata
rawPackageMetadataHelper
(Maybe PackageName
-> Maybe Version
-> Maybe TreeKey
-> Maybe BlobKey
-> RawPackageMetadata)
-> WriterT WarningParserMonoid Parser (Maybe PackageName)
-> WriterT
WarningParserMonoid
Parser
(Maybe Version
-> Maybe TreeKey -> Maybe BlobKey -> RawPackageMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((CabalString PackageName -> PackageName)
-> Maybe (CabalString PackageName) -> Maybe PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CabalString PackageName -> PackageName
forall a. CabalString a -> a
unCabalString (Maybe (CabalString PackageName) -> Maybe PackageName)
-> WriterT
WarningParserMonoid Parser (Maybe (CabalString PackageName))
-> WriterT WarningParserMonoid Parser (Maybe PackageName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Text
-> WriterT
WarningParserMonoid Parser (Maybe (CabalString PackageName))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"name"))
WriterT
WarningParserMonoid
Parser
(Maybe Version
-> Maybe TreeKey -> Maybe BlobKey -> RawPackageMetadata)
-> WriterT WarningParserMonoid Parser (Maybe Version)
-> WriterT
WarningParserMonoid
Parser
(Maybe TreeKey -> Maybe BlobKey -> RawPackageMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((CabalString Version -> Version)
-> Maybe (CabalString Version) -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CabalString Version -> Version
forall a. CabalString a -> a
unCabalString (Maybe (CabalString Version) -> Maybe Version)
-> WriterT WarningParserMonoid Parser (Maybe (CabalString Version))
-> WriterT WarningParserMonoid Parser (Maybe Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Text
-> WriterT WarningParserMonoid Parser (Maybe (CabalString Version))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"version"))
WriterT
WarningParserMonoid
Parser
(Maybe TreeKey -> Maybe BlobKey -> RawPackageMetadata)
-> WriterT WarningParserMonoid Parser (Maybe TreeKey)
-> WriterT
WarningParserMonoid Parser (Maybe BlobKey -> RawPackageMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Text -> WriterT WarningParserMonoid Parser (Maybe TreeKey)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"pantry-tree"
WriterT
WarningParserMonoid Parser (Maybe BlobKey -> RawPackageMetadata)
-> WarningParser (Maybe BlobKey)
-> WriterT WarningParserMonoid Parser RawPackageMetadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> WarningParser (Maybe BlobKey)
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 = String
-> (Object
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackageLocationImmutable.UPLIRepo" ((Object
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> (Object
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
(RepoType
repoType, Text
repoUrl) <-
((RepoType
RepoGit, ) (Text -> (RepoType, Text))
-> WarningParser Text
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"git") WriterT WarningParserMonoid Parser (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((RepoType
RepoHg, ) (Text -> (RepoType, Text))
-> WarningParser Text
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hg")
Text
repoCommit <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"commit"
OptionalSubdirs
os <- Object -> WarningParser OptionalSubdirs
optionalSubdirs Object
o
Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable))
-> NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ ((Text, RawPackageMetadata) -> RawPackageLocationImmutable)
-> NonEmpty (Text, RawPackageMetadata)
-> NonEmpty RawPackageLocationImmutable
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\(Text
repoSubdir, RawPackageMetadata
pm) -> Repo -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIRepo Repo :: Text -> Text -> RepoType -> Text -> Repo
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 = String
-> (Object
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackageLocationImmutable.RPLIArchive" ((Object
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> (Object
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
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 Object -> Text -> WarningParser (Maybe SHA256)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha256"
Maybe FileSize
raSize <- Object
o Object -> Text -> WarningParser (Maybe FileSize)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"size"
OptionalSubdirs
os <- Object -> WarningParser OptionalSubdirs
optionalSubdirs Object
o
Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO (NonEmpty RawPackageLocationImmutable))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir)
-> IO (NonEmpty RawPackageLocationImmutable))
-> Unresolved (NonEmpty RawPackageLocationImmutable))
-> (Maybe (Path Abs Dir)
-> IO (NonEmpty RawPackageLocationImmutable))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
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
NonEmpty RawPackageLocationImmutable
-> IO (NonEmpty RawPackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty RawPackageLocationImmutable
-> IO (NonEmpty RawPackageLocationImmutable))
-> NonEmpty RawPackageLocationImmutable
-> IO (NonEmpty RawPackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ ((Text, RawPackageMetadata) -> RawPackageLocationImmutable)
-> NonEmpty (Text, RawPackageMetadata)
-> NonEmpty RawPackageLocationImmutable
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\(Text
raSubdir, RawPackageMetadata
pm) -> RawArchive -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIArchive RawArchive :: ArchiveLocation
-> Maybe SHA256 -> Maybe FileSize -> Text -> RawArchive
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 = String
-> (Object
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"PLArchive:github" ((Object
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))))
-> (Object
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
(WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
GitHubRepo Text
ghRepo <- Object
o Object -> Text -> WarningParser GitHubRepo
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"github"
Text
commit <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"commit"
let raLocation :: ArchiveLocation
raLocation = Text -> ArchiveLocation
ALUrl (Text -> ArchiveLocation) -> Text -> ArchiveLocation
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 Object -> Text -> WarningParser (Maybe SHA256)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha256"
Maybe FileSize
raSize <- Object
o Object -> Text -> WarningParser (Maybe FileSize)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"size"
OptionalSubdirs
os <- Object -> WarningParser OptionalSubdirs
optionalSubdirs Object
o
Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
(Unresolved (NonEmpty RawPackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable))
-> NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ ((Text, RawPackageMetadata) -> RawPackageLocationImmutable)
-> NonEmpty (Text, RawPackageMetadata)
-> NonEmpty RawPackageLocationImmutable
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\(Text
raSubdir, RawPackageMetadata
pm) -> RawArchive -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIArchive RawArchive :: ArchiveLocation
-> Maybe SHA256 -> Maybe FileSize -> Text -> RawArchive
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) = (Text -> (Text, RawPackageMetadata))
-> NonEmpty Text -> NonEmpty (Text, RawPackageMetadata)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (, RawPackageMetadata
rpmEmpty) NonEmpty Text
subdirs
osToRpms (OSPackageMetadata Text
subdir RawPackageMetadata
rpm) = (Text, RawPackageMetadata) -> NonEmpty (Text, RawPackageMetadata)
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 Maybe PackageName
forall a. Maybe a
Nothing Maybe Version
forall a. Maybe a
Nothing Maybe TreeKey
forall a. Maybe a
Nothing
newtype CabalString a = CabalString { CabalString a -> a
unCabalString :: a }
deriving (Int -> CabalString a -> ShowS
[CabalString a] -> ShowS
CabalString a -> String
(Int -> CabalString a -> ShowS)
-> (CabalString a -> String)
-> ([CabalString a] -> ShowS)
-> Show (CabalString a)
forall a. Show a => Int -> CabalString a -> ShowS
forall a. Show a => [CabalString a] -> ShowS
forall a. Show a => CabalString a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CabalString a] -> ShowS
$cshowList :: forall a. Show a => [CabalString a] -> ShowS
show :: CabalString a -> String
$cshow :: forall a. Show a => CabalString a -> String
showsPrec :: Int -> CabalString a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CabalString a -> ShowS
Show, CabalString a -> CabalString a -> Bool
(CabalString a -> CabalString a -> Bool)
-> (CabalString a -> CabalString a -> Bool) -> Eq (CabalString a)
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, Eq (CabalString a)
Eq (CabalString a)
-> (CabalString a -> CabalString a -> Ordering)
-> (CabalString a -> CabalString a -> Bool)
-> (CabalString a -> CabalString a -> Bool)
-> (CabalString a -> CabalString a -> Bool)
-> (CabalString a -> CabalString a -> Bool)
-> (CabalString a -> CabalString a -> CabalString a)
-> (CabalString a -> CabalString a -> CabalString a)
-> Ord (CabalString a)
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
$cp1Ord :: forall a. Ord a => Eq (CabalString a)
Ord, Typeable)
toCabalStringMap :: Map a v -> Map (CabalString a) v
toCabalStringMap :: Map a v -> Map (CabalString a) v
toCabalStringMap = (a -> CabalString a) -> Map a v -> Map (CabalString a) v
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic a -> CabalString a
forall a. a -> CabalString a
CabalString
unCabalStringMap :: Map (CabalString a) v -> Map a v
unCabalStringMap :: Map (CabalString a) v -> Map a v
unCabalStringMap = (CabalString a -> a) -> Map (CabalString a) v -> Map a v
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic CabalString a -> a
forall a. CabalString a -> a
unCabalString
instance Distribution.Pretty.Pretty a => ToJSON (CabalString a) where
toJSON :: CabalString a -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value)
-> (CabalString a -> String) -> CabalString a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Pretty a => a -> String
Distribution.Text.display (a -> String) -> (CabalString a -> a) -> CabalString a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalString a -> a
forall a. CabalString a -> a
unCabalString
instance Distribution.Pretty.Pretty a => ToJSONKey (CabalString a) where
toJSONKey :: ToJSONKeyFunction (CabalString a)
toJSONKey = (CabalString a -> Text) -> ToJSONKeyFunction (CabalString a)
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ((CabalString a -> Text) -> ToJSONKeyFunction (CabalString a))
-> (CabalString a -> Text) -> ToJSONKeyFunction (CabalString a)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text)
-> (CabalString a -> String) -> CabalString a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Pretty a => a -> String
Distribution.Text.display (a -> String) -> (CabalString a -> a) -> CabalString a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalString a -> a
forall a. CabalString a -> a
unCabalString
instance forall a. IsCabalString a => FromJSON (CabalString a) where
parseJSON :: Value -> Parser (CabalString a)
parseJSON = String
-> (Text -> Parser (CabalString a))
-> Value
-> Parser (CabalString a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
name ((Text -> Parser (CabalString a))
-> Value -> Parser (CabalString a))
-> (Text -> Parser (CabalString a))
-> Value
-> Parser (CabalString a)
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case String -> Maybe a
forall a. IsCabalString a => String -> Maybe a
cabalStringParser (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t of
Maybe a
Nothing -> String -> Parser (CabalString a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (CabalString a))
-> String -> Parser (CabalString a)
forall a b. (a -> b) -> a -> b
$ String
"Invalid " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
Just a
x -> CabalString a -> Parser (CabalString a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CabalString a -> Parser (CabalString a))
-> CabalString a -> Parser (CabalString a)
forall a b. (a -> b) -> a -> b
$ a -> CabalString a
forall a. a -> CabalString a
CabalString a
x
where
name :: String
name = Maybe a -> String
forall a (proxy :: * -> *). IsCabalString a => proxy a -> String
cabalStringName (Maybe a
forall a. Maybe a
Nothing :: Maybe a)
instance forall a. IsCabalString a => FromJSONKey (CabalString a) where
fromJSONKey :: FromJSONKeyFunction (CabalString a)
fromJSONKey =
(Text -> Parser (CabalString a))
-> FromJSONKeyFunction (CabalString a)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser (CabalString a))
-> FromJSONKeyFunction (CabalString a))
-> (Text -> Parser (CabalString a))
-> FromJSONKeyFunction (CabalString a)
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case String -> Maybe a
forall a. IsCabalString a => String -> Maybe a
cabalStringParser (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t of
Maybe a
Nothing -> String -> Parser (CabalString a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (CabalString a))
-> String -> Parser (CabalString a)
forall a b. (a -> b) -> a -> b
$ String
"Invalid " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
Just a
x -> CabalString a -> Parser (CabalString a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CabalString a -> Parser (CabalString a))
-> CabalString a -> Parser (CabalString a)
forall a b. (a -> b) -> a -> b
$ a -> CabalString a
forall a. a -> CabalString a
CabalString a
x
where
name :: String
name = Maybe a -> String
forall a (proxy :: * -> *). IsCabalString a => proxy a -> String
cabalStringName (Maybe a
forall a. Maybe a
Nothing :: Maybe a)
class IsCabalString a where
cabalStringName :: proxy a -> String
cabalStringParser :: String -> Maybe a
instance IsCabalString PackageName where
cabalStringName :: proxy PackageName -> String
cabalStringName proxy PackageName
_ = String
"package name"
cabalStringParser :: String -> Maybe PackageName
cabalStringParser = String -> Maybe PackageName
parsePackageName
instance IsCabalString Version where
cabalStringName :: proxy Version -> String
cabalStringName proxy Version
_ = String
"version"
cabalStringParser :: String -> Maybe Version
cabalStringParser = String -> Maybe Version
parseVersion
instance IsCabalString VersionRange where
cabalStringName :: proxy VersionRange -> String
cabalStringName proxy VersionRange
_ = String
"version range"
cabalStringParser :: String -> Maybe VersionRange
cabalStringParser = String -> Maybe VersionRange
parseVersionRange
instance IsCabalString PackageIdentifier where
cabalStringName :: proxy PackageIdentifier -> String
cabalStringName proxy PackageIdentifier
_ = String
"package identifier"
cabalStringParser :: String -> Maybe PackageIdentifier
cabalStringParser = String -> Maybe PackageIdentifier
parsePackageIdentifier
instance IsCabalString FlagName where
cabalStringName :: proxy FlagName -> String
cabalStringName proxy FlagName
_ = String
"flag name"
cabalStringParser :: String -> Maybe FlagName
cabalStringParser = String -> Maybe FlagName
parseFlagName
data HpackExecutable
= HpackBundled
| HpackCommand !FilePath
deriving (Int -> HpackExecutable -> ShowS
[HpackExecutable] -> ShowS
HpackExecutable -> String
(Int -> HpackExecutable -> ShowS)
-> (HpackExecutable -> String)
-> ([HpackExecutable] -> ShowS)
-> Show HpackExecutable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HpackExecutable] -> ShowS
$cshowList :: [HpackExecutable] -> ShowS
show :: HpackExecutable -> String
$cshow :: HpackExecutable -> String
showsPrec :: Int -> HpackExecutable -> ShowS
$cshowsPrec :: Int -> HpackExecutable -> ShowS
Show, ReadPrec [HpackExecutable]
ReadPrec HpackExecutable
Int -> ReadS HpackExecutable
ReadS [HpackExecutable]
(Int -> ReadS HpackExecutable)
-> ReadS [HpackExecutable]
-> ReadPrec HpackExecutable
-> ReadPrec [HpackExecutable]
-> Read 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
(HpackExecutable -> HpackExecutable -> Bool)
-> (HpackExecutable -> HpackExecutable -> Bool)
-> Eq HpackExecutable
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
Eq HpackExecutable
-> (HpackExecutable -> HpackExecutable -> Ordering)
-> (HpackExecutable -> HpackExecutable -> Bool)
-> (HpackExecutable -> HpackExecutable -> Bool)
-> (HpackExecutable -> HpackExecutable -> Bool)
-> (HpackExecutable -> HpackExecutable -> Bool)
-> (HpackExecutable -> HpackExecutable -> HpackExecutable)
-> (HpackExecutable -> HpackExecutable -> HpackExecutable)
-> Ord 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
$cp1Ord :: Eq HpackExecutable
Ord)
data WantedCompiler
= WCGhc !Version
| WCGhcGit !Text !Text
| WCGhcjs
!Version
!Version
deriving (Int -> WantedCompiler -> ShowS
[WantedCompiler] -> ShowS
WantedCompiler -> String
(Int -> WantedCompiler -> ShowS)
-> (WantedCompiler -> String)
-> ([WantedCompiler] -> ShowS)
-> Show WantedCompiler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WantedCompiler] -> ShowS
$cshowList :: [WantedCompiler] -> ShowS
show :: WantedCompiler -> String
$cshow :: WantedCompiler -> String
showsPrec :: Int -> WantedCompiler -> ShowS
$cshowsPrec :: Int -> WantedCompiler -> ShowS
Show, WantedCompiler -> WantedCompiler -> Bool
(WantedCompiler -> WantedCompiler -> Bool)
-> (WantedCompiler -> WantedCompiler -> Bool) -> Eq WantedCompiler
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
Eq WantedCompiler
-> (WantedCompiler -> WantedCompiler -> Ordering)
-> (WantedCompiler -> WantedCompiler -> Bool)
-> (WantedCompiler -> WantedCompiler -> Bool)
-> (WantedCompiler -> WantedCompiler -> Bool)
-> (WantedCompiler -> WantedCompiler -> Bool)
-> (WantedCompiler -> WantedCompiler -> WantedCompiler)
-> (WantedCompiler -> WantedCompiler -> WantedCompiler)
-> Ord 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
$cp1Ord :: Eq WantedCompiler
Ord, (forall x. WantedCompiler -> Rep WantedCompiler x)
-> (forall x. Rep WantedCompiler x -> WantedCompiler)
-> Generic WantedCompiler
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-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
vghc)
display (WCGhcjs Version
vghcjs Version
vghc) =
Utf8Builder
"ghcjs-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
vghcjs) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"_ghc-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
vghc)
display (WCGhcGit Text
commit Text
flavour) =
Utf8Builder
"ghc-git-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
commit Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
flavour
instance ToJSON WantedCompiler where
toJSON :: WantedCompiler -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (WantedCompiler -> Text) -> WantedCompiler -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (WantedCompiler -> Utf8Builder) -> WantedCompiler -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance FromJSON WantedCompiler where
parseJSON :: Value -> Parser WantedCompiler
parseJSON = String
-> (Text -> Parser WantedCompiler)
-> Value
-> Parser WantedCompiler
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"WantedCompiler" ((Text -> Parser WantedCompiler) -> Value -> Parser WantedCompiler)
-> (Text -> Parser WantedCompiler)
-> Value
-> Parser WantedCompiler
forall a b. (a -> b) -> a -> b
$ (PantryException -> Parser WantedCompiler)
-> (WantedCompiler -> Parser WantedCompiler)
-> Either PantryException WantedCompiler
-> Parser WantedCompiler
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser WantedCompiler
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser WantedCompiler)
-> (PantryException -> String)
-> PantryException
-> Parser WantedCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PantryException -> String
forall a. Show a => a -> String
show) WantedCompiler -> Parser WantedCompiler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PantryException WantedCompiler -> Parser WantedCompiler)
-> (Text -> Either PantryException WantedCompiler)
-> Text
-> Parser WantedCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either PantryException WantedCompiler
parseWantedCompiler
instance FromJSONKey WantedCompiler where
fromJSONKey :: FromJSONKeyFunction WantedCompiler
fromJSONKey =
(Text -> Parser WantedCompiler)
-> FromJSONKeyFunction WantedCompiler
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser WantedCompiler)
-> FromJSONKeyFunction WantedCompiler)
-> (Text -> Parser WantedCompiler)
-> FromJSONKeyFunction WantedCompiler
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case Text -> Either PantryException WantedCompiler
parseWantedCompiler Text
t of
Left PantryException
e -> String -> Parser WantedCompiler
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser WantedCompiler)
-> String -> Parser WantedCompiler
forall a b. (a -> b) -> a -> b
$ String
"Invalid WantedComiler " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PantryException -> String
forall a. Show a => a -> String
show PantryException
e
Right WantedCompiler
x -> WantedCompiler -> Parser WantedCompiler
forall (f :: * -> *) a. Applicative f => a -> f a
pure WantedCompiler
x
parseWantedCompiler :: Text -> Either PantryException WantedCompiler
parseWantedCompiler :: Text -> Either PantryException WantedCompiler
parseWantedCompiler Text
t0 = Either PantryException WantedCompiler
-> (WantedCompiler -> Either PantryException WantedCompiler)
-> Maybe WantedCompiler
-> Either PantryException WantedCompiler
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PantryException -> Either PantryException WantedCompiler
forall a b. a -> Either a b
Left (PantryException -> Either PantryException WantedCompiler)
-> PantryException -> Either PantryException WantedCompiler
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
InvalidWantedCompiler Text
t0) WantedCompiler -> Either PantryException WantedCompiler
forall a b. b -> Either a b
Right (Maybe WantedCompiler -> Either PantryException WantedCompiler)
-> Maybe WantedCompiler -> Either PantryException WantedCompiler
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 -> Text -> Maybe WantedCompiler
forall (f :: * -> *). Applicative f => Text -> f WantedCompiler
parseGhcGit Text
t1
Maybe Text
Nothing -> Text -> Text -> Maybe Text
T.stripPrefix Text
"ghc-" Text
t0 Maybe Text
-> (Text -> Maybe WantedCompiler) -> Maybe WantedCompiler
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
t1
Version
ghcjsV <- String -> Maybe Version
parseVersion (String -> Maybe Version) -> String -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ghcjsVT
Text
ghcVT <- Text -> Text -> Maybe Text
T.stripPrefix Text
"_ghc-" Text
t2
Version
ghcV <- String -> Maybe Version
parseVersion (String -> Maybe Version) -> String -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ghcVT
WantedCompiler -> Maybe WantedCompiler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WantedCompiler -> Maybe WantedCompiler)
-> WantedCompiler -> Maybe WantedCompiler
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Text
t1
WantedCompiler -> f WantedCompiler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WantedCompiler -> f WantedCompiler)
-> WantedCompiler -> f WantedCompiler
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 = (Version -> WantedCompiler)
-> Maybe Version -> Maybe WantedCompiler
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> WantedCompiler
WCGhc (Maybe Version -> Maybe WantedCompiler)
-> (Text -> Maybe Version) -> Text -> Maybe WantedCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Version
parseVersion (String -> Maybe Version)
-> (Text -> String) -> Text -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
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 Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
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 = String
-> (Text
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"UnresolvedSnapshotLocation (Text)" ((Text
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> (Text
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall a b. (a -> b) -> a -> b
$ WithJSONWarnings (Unresolved RawSnapshotLocation)
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WithJSONWarnings (Unresolved RawSnapshotLocation)
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> (Text -> WithJSONWarnings (Unresolved RawSnapshotLocation))
-> Text
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unresolved RawSnapshotLocation
-> WithJSONWarnings (Unresolved RawSnapshotLocation)
forall a. a -> WithJSONWarnings a
noJSONWarnings (Unresolved RawSnapshotLocation
-> WithJSONWarnings (Unresolved RawSnapshotLocation))
-> (Text -> Unresolved RawSnapshotLocation)
-> Text
-> WithJSONWarnings (Unresolved RawSnapshotLocation)
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 = String
-> (Object -> WarningParser (Unresolved RawSnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedSnapshotLocation (Object)" ((Object -> WarningParser (Unresolved RawSnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> (Object -> WarningParser (Unresolved RawSnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall a b. (a -> b) -> a -> b
$ \Object
o ->
((RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> Unresolved RawSnapshotLocation)
-> (WantedCompiler -> RawSnapshotLocation)
-> WantedCompiler
-> Unresolved RawSnapshotLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WantedCompiler -> RawSnapshotLocation
RSLCompiler) (WantedCompiler -> Unresolved RawSnapshotLocation)
-> WriterT WarningParserMonoid Parser WantedCompiler
-> WarningParser (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser WantedCompiler
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"compiler") WarningParser (Unresolved RawSnapshotLocation)
-> WarningParser (Unresolved RawSnapshotLocation)
-> WarningParser (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((\Text
x Maybe BlobKey
y -> RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> Unresolved RawSnapshotLocation)
-> RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ Text -> Maybe BlobKey -> RawSnapshotLocation
RSLUrl Text
x Maybe BlobKey
y) (Text -> Maybe BlobKey -> Unresolved RawSnapshotLocation)
-> WarningParser Text
-> WriterT
WarningParserMonoid
Parser
(Maybe BlobKey -> Unresolved RawSnapshotLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"url" WriterT
WarningParserMonoid
Parser
(Maybe BlobKey -> Unresolved RawSnapshotLocation)
-> WarningParser (Maybe BlobKey)
-> WarningParser (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> WarningParser (Maybe BlobKey)
blobKey Object
o) WarningParser (Unresolved RawSnapshotLocation)
-> WarningParser (Unresolved RawSnapshotLocation)
-> WarningParser (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath (Text -> Unresolved RawSnapshotLocation)
-> WarningParser Text
-> WarningParser (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"filepath")
blobKey :: Object -> WarningParser (Maybe BlobKey)
blobKey Object
o = do
Maybe SHA256
msha <- Object
o Object -> Text -> WarningParser (Maybe SHA256)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha256"
Maybe FileSize
msize <- Object
o Object -> Text -> WarningParser (Maybe FileSize)
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) -> Maybe BlobKey -> WarningParser (Maybe BlobKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe BlobKey
forall a. Maybe a
Nothing
(Just SHA256
sha, Just FileSize
size') -> Maybe BlobKey -> WarningParser (Maybe BlobKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe BlobKey -> WarningParser (Maybe BlobKey))
-> Maybe BlobKey -> WarningParser (Maybe BlobKey)
forall a b. (a -> b) -> a -> b
$ BlobKey -> Maybe BlobKey
forall a. a -> Maybe a
Just (BlobKey -> Maybe BlobKey) -> BlobKey -> Maybe BlobKey
forall a b. (a -> b) -> a -> b
$ SHA256 -> FileSize -> BlobKey
BlobKey SHA256
sha FileSize
size'
(Just SHA256
_sha, Maybe FileSize
Nothing) -> String -> WarningParser (Maybe BlobKey)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"You must also specify the file size"
(Maybe SHA256
Nothing, Just FileSize
_) -> String -> WarningParser (Maybe BlobKey)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"You must also specify the file's SHA256"
instance Display SnapshotLocation where
display :: SnapshotLocation -> Utf8Builder
display (SLCompiler WantedCompiler
compiler) = WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display WantedCompiler
compiler
display (SLUrl Text
url BlobKey
blob) = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" (" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display BlobKey
blob Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
")"
display (SLFilePath ResolvedPath File
resolved) = RelFilePath -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved)
parseRawSnapshotLocation :: Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocation :: Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocation Text
t0 = Unresolved RawSnapshotLocation
-> Maybe (Unresolved RawSnapshotLocation)
-> Unresolved RawSnapshotLocation
forall a. a -> Maybe a -> a
fromMaybe (Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath Text
t0) (Maybe (Unresolved RawSnapshotLocation)
-> Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
-> Unresolved RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$
((PantryException -> Maybe (Unresolved RawSnapshotLocation))
-> (WantedCompiler -> Maybe (Unresolved RawSnapshotLocation))
-> Either PantryException WantedCompiler
-> Maybe (Unresolved RawSnapshotLocation)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Unresolved RawSnapshotLocation)
-> PantryException -> Maybe (Unresolved RawSnapshotLocation)
forall a b. a -> b -> a
const Maybe (Unresolved RawSnapshotLocation)
forall a. Maybe a
Nothing) (Unresolved RawSnapshotLocation
-> Maybe (Unresolved RawSnapshotLocation)
forall a. a -> Maybe a
Just (Unresolved RawSnapshotLocation
-> Maybe (Unresolved RawSnapshotLocation))
-> (WantedCompiler -> Unresolved RawSnapshotLocation)
-> WantedCompiler
-> Maybe (Unresolved RawSnapshotLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> Unresolved RawSnapshotLocation)
-> (WantedCompiler -> RawSnapshotLocation)
-> WantedCompiler
-> Unresolved RawSnapshotLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WantedCompiler -> RawSnapshotLocation
RSLCompiler) (Text -> Either PantryException WantedCompiler
parseWantedCompiler Text
t0)) Maybe (Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> Unresolved RawSnapshotLocation)
-> (SnapName -> RawSnapshotLocation)
-> SnapName
-> Unresolved RawSnapshotLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapName -> RawSnapshotLocation
RSLSynonym (SnapName -> Unresolved RawSnapshotLocation)
-> Maybe SnapName -> Maybe (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe SnapName
forall (m :: * -> *). MonadThrow m => Text -> m SnapName
parseSnapName Text
t0) Maybe (Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Maybe (Unresolved RawSnapshotLocation)
parseGithub Maybe (Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
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 (Char -> Char -> Bool
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
t3
Text
path <- Text -> Text -> Maybe Text
T.stripPrefix Text
":" Text
t4
Unresolved RawSnapshotLocation
-> Maybe (Unresolved RawSnapshotLocation)
forall a. a -> Maybe a
Just (Unresolved RawSnapshotLocation
-> Maybe (Unresolved RawSnapshotLocation))
-> Unresolved RawSnapshotLocation
-> Maybe (Unresolved RawSnapshotLocation)
forall a b. (a -> b) -> a -> b
$ RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> Unresolved RawSnapshotLocation)
-> RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RawSnapshotLocation
githubSnapshotLocation Text
user Text
repo Text
path
parseUrl :: Maybe (Unresolved RawSnapshotLocation)
parseUrl = String -> Maybe Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (Text -> String
T.unpack Text
t0) Maybe Request
-> Unresolved RawSnapshotLocation
-> Maybe (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe BlobKey -> RawSnapshotLocation
RSLUrl Text
t0 Maybe BlobKey
forall a. Maybe a
Nothing)
parseRawSnapshotLocationPath :: Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath :: Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath Text
t =
(Maybe (Path Abs Dir) -> IO RawSnapshotLocation)
-> Unresolved RawSnapshotLocation
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO RawSnapshotLocation)
-> Unresolved RawSnapshotLocation)
-> (Maybe (Path Abs Dir) -> IO RawSnapshotLocation)
-> Unresolved RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir ->
case Maybe (Path Abs Dir)
mdir of
Maybe (Path Abs Dir)
Nothing -> PantryException -> IO RawSnapshotLocation
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PantryException -> IO RawSnapshotLocation)
-> PantryException -> IO RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
InvalidFilePathSnapshot Text
t
Just Path Abs Dir
dir -> do
Path Abs File
abs' <- Path Abs Dir -> String -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs File)
resolveFile Path Abs Dir
dir (Text -> String
T.unpack Text
t) IO (Path Abs File)
-> (SomeException -> IO (Path Abs File)) -> IO (Path Abs File)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
_ -> PantryException -> IO (Path Abs File)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Path Abs Dir -> Text -> PantryException
InvalidSnapshotLocation Path Abs Dir
dir Text
t)
RawSnapshotLocation -> IO RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> IO RawSnapshotLocation)
-> RawSnapshotLocation -> IO RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> RawSnapshotLocation
RSLFilePath (ResolvedPath File -> RawSnapshotLocation)
-> ResolvedPath File -> RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ RelFilePath -> Path Abs File -> ResolvedPath File
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 Maybe BlobKey
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 (Text -> RawSnapshotLocation) -> Text -> RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$
Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> Utf8Builder -> Text
forall a b. (a -> b) -> a -> b
$
Utf8Builder
"lts/" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
x Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"/" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
y Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
".yaml"
defaultSnapshotLocation (Nightly Day
date) =
Text -> Text -> Text -> RawSnapshotLocation
githubSnapshotLocation Text
defUser Text
defRepo (Text -> RawSnapshotLocation) -> Text -> RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$
Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> Utf8Builder -> Text
forall a b. (a -> b) -> a -> b
$
Utf8Builder
"nightly/" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Integer -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Integer
year Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"/" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
month Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"/" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
day Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
".yaml"
where
(Integer
year, Int
month, Int
day) = Day -> (Integer, Int, Int)
toGregorian Day
date
data SnapName
= LTS
!Int
!Int
| Nightly !Day
deriving (SnapName -> SnapName -> Bool
(SnapName -> SnapName -> Bool)
-> (SnapName -> SnapName -> Bool) -> Eq SnapName
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
Eq SnapName
-> (SnapName -> SnapName -> Ordering)
-> (SnapName -> SnapName -> Bool)
-> (SnapName -> SnapName -> Bool)
-> (SnapName -> SnapName -> Bool)
-> (SnapName -> SnapName -> Bool)
-> (SnapName -> SnapName -> SnapName)
-> (SnapName -> SnapName -> SnapName)
-> Ord 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
$cp1Ord :: Eq SnapName
Ord, (forall x. SnapName -> Rep SnapName x)
-> (forall x. Rep SnapName x -> SnapName) -> Generic SnapName
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-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
x Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"." Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
y
display (Nightly Day
date) = Utf8Builder
"nightly-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Day -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Day
date
instance Show SnapName where
show :: SnapName -> String
show = Text -> String
T.unpack (Text -> String) -> (SnapName -> Text) -> SnapName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (SnapName -> Utf8Builder) -> SnapName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapName -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance ToJSON SnapName where
toJSON :: SnapName -> Value
toJSON SnapName
syn = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> Utf8Builder -> Text
forall a b. (a -> b) -> a -> b
$ SnapName -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SnapName
syn
parseSnapName :: MonadThrow m => Text -> m SnapName
parseSnapName :: Text -> m SnapName
parseSnapName Text
t0 =
case Maybe SnapName
lts Maybe SnapName -> Maybe SnapName -> Maybe SnapName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SnapName
nightly of
Maybe SnapName
Nothing -> PantryException -> m SnapName
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PantryException -> m SnapName) -> PantryException -> m SnapName
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
ParseSnapNameException Text
t0
Just SnapName
sn -> SnapName -> m SnapName
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) <- Either String (Int, Text) -> Maybe (Either String (Int, Text))
forall a. a -> Maybe a
Just (Either String (Int, Text) -> Maybe (Either String (Int, Text)))
-> Either String (Int, Text) -> Maybe (Either String (Int, Text))
forall a b. (a -> b) -> a -> b
$ Reader Int
forall a. Integral a => Reader a
decimal Text
t1
Text
t3 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"." Text
t2
Right (Int
y, Text
"") <- Either String (Int, Text) -> Maybe (Either String (Int, Text))
forall a. a -> Maybe a
Just (Either String (Int, Text) -> Maybe (Either String (Int, Text)))
-> Either String (Int, Text) -> Maybe (Either String (Int, Text))
forall a b. (a -> b) -> a -> b
$ Reader Int
forall a. Integral a => Reader a
decimal Text
t3
SnapName -> Maybe SnapName
forall (m :: * -> *) a. Monad m => a -> m a
return (SnapName -> Maybe SnapName) -> SnapName -> Maybe SnapName
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 (Day -> SnapName) -> Maybe Day -> Maybe SnapName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Day
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t1)
data RawSnapshotLocation
= RSLCompiler !WantedCompiler
| RSLUrl !Text !(Maybe BlobKey)
| RSLFilePath !(ResolvedPath File)
| RSLSynonym !SnapName
deriving (Int -> RawSnapshotLocation -> ShowS
[RawSnapshotLocation] -> ShowS
RawSnapshotLocation -> String
(Int -> RawSnapshotLocation -> ShowS)
-> (RawSnapshotLocation -> String)
-> ([RawSnapshotLocation] -> ShowS)
-> Show RawSnapshotLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawSnapshotLocation] -> ShowS
$cshowList :: [RawSnapshotLocation] -> ShowS
show :: RawSnapshotLocation -> String
$cshow :: RawSnapshotLocation -> String
showsPrec :: Int -> RawSnapshotLocation -> ShowS
$cshowsPrec :: Int -> RawSnapshotLocation -> ShowS
Show, RawSnapshotLocation -> RawSnapshotLocation -> Bool
(RawSnapshotLocation -> RawSnapshotLocation -> Bool)
-> (RawSnapshotLocation -> RawSnapshotLocation -> Bool)
-> Eq RawSnapshotLocation
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
Eq RawSnapshotLocation
-> (RawSnapshotLocation -> RawSnapshotLocation -> Ordering)
-> (RawSnapshotLocation -> RawSnapshotLocation -> Bool)
-> (RawSnapshotLocation -> RawSnapshotLocation -> Bool)
-> (RawSnapshotLocation -> RawSnapshotLocation -> Bool)
-> (RawSnapshotLocation -> RawSnapshotLocation -> Bool)
-> (RawSnapshotLocation
-> RawSnapshotLocation -> RawSnapshotLocation)
-> (RawSnapshotLocation
-> RawSnapshotLocation -> RawSnapshotLocation)
-> Ord 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
$cp1Ord :: Eq RawSnapshotLocation
Ord, (forall x. RawSnapshotLocation -> Rep RawSnapshotLocation x)
-> (forall x. Rep RawSnapshotLocation x -> RawSnapshotLocation)
-> Generic RawSnapshotLocation
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) = WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display WantedCompiler
compiler
display (RSLUrl Text
url Maybe BlobKey
Nothing) = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url
display (RSLUrl Text
url (Just BlobKey
blob)) = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" (" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display BlobKey
blob Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
")"
display (RSLFilePath ResolvedPath File
resolved) = RelFilePath -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved)
display (RSLSynonym SnapName
syn) = SnapName -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SnapName
syn
instance ToJSON RawSnapshotLocation where
toJSON :: RawSnapshotLocation -> Value
toJSON (RSLCompiler WantedCompiler
compiler) = [(Text, Value)] -> Value
object [Text
"compiler" Text -> WantedCompiler -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WantedCompiler
compiler]
toJSON (RSLUrl Text
url Maybe BlobKey
mblob) = [(Text, Value)] -> Value
object
([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ Text
"url" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
url
(Text, Value) -> [(Text, Value)] -> [(Text, Value)]
forall a. a -> [a] -> [a]
: [(Text, Value)]
-> (BlobKey -> [(Text, Value)]) -> Maybe BlobKey -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] BlobKey -> [(Text, Value)]
blobKeyPairs Maybe BlobKey
mblob
toJSON (RSLFilePath ResolvedPath File
resolved) = [(Text, Value)] -> Value
object [Text
"filepath" Text -> RelFilePath -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved]
toJSON (RSLSynonym SnapName
syn) = SnapName -> Value
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 -> String
(Int -> SnapshotLocation -> ShowS)
-> (SnapshotLocation -> String)
-> ([SnapshotLocation] -> ShowS)
-> Show SnapshotLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotLocation] -> ShowS
$cshowList :: [SnapshotLocation] -> ShowS
show :: SnapshotLocation -> String
$cshow :: SnapshotLocation -> String
showsPrec :: Int -> SnapshotLocation -> ShowS
$cshowsPrec :: Int -> SnapshotLocation -> ShowS
Show, SnapshotLocation -> SnapshotLocation -> Bool
(SnapshotLocation -> SnapshotLocation -> Bool)
-> (SnapshotLocation -> SnapshotLocation -> Bool)
-> Eq SnapshotLocation
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
Eq SnapshotLocation
-> (SnapshotLocation -> SnapshotLocation -> Ordering)
-> (SnapshotLocation -> SnapshotLocation -> Bool)
-> (SnapshotLocation -> SnapshotLocation -> Bool)
-> (SnapshotLocation -> SnapshotLocation -> Bool)
-> (SnapshotLocation -> SnapshotLocation -> Bool)
-> (SnapshotLocation -> SnapshotLocation -> SnapshotLocation)
-> (SnapshotLocation -> SnapshotLocation -> SnapshotLocation)
-> Ord 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
$cp1Ord :: Eq SnapshotLocation
Ord, (forall x. SnapshotLocation -> Rep SnapshotLocation x)
-> (forall x. Rep SnapshotLocation x -> SnapshotLocation)
-> Generic SnapshotLocation
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 = RawSnapshotLocation -> Value
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 Parser (WithJSONWarnings (Unresolved SnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
url Value
v Parser (WithJSONWarnings (Unresolved SnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
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 = String
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"SLFilepath" ((Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation)))
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Text
ufp <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"filepath"
Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation))
-> Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation)
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation)
-> (Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir ->
case Maybe (Path Abs Dir)
mdir of
Maybe (Path Abs Dir)
Nothing -> PantryException -> IO SnapshotLocation
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PantryException -> IO SnapshotLocation)
-> PantryException -> IO SnapshotLocation
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
InvalidFilePathSnapshot Text
ufp
Just Path Abs Dir
dir -> do
Path Abs File
absolute <- Path Abs Dir -> String -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs File)
resolveFile Path Abs Dir
dir (Text -> String
T.unpack Text
ufp)
let fp :: ResolvedPath File
fp = RelFilePath -> Path Abs File -> ResolvedPath File
forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath Text
ufp) Path Abs File
absolute
SnapshotLocation -> IO SnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapshotLocation -> IO SnapshotLocation)
-> SnapshotLocation -> IO SnapshotLocation
forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> SnapshotLocation
SLFilePath ResolvedPath File
fp
url :: Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
url = String
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"SLUrl" ((Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation)))
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Text
url' <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"url"
SHA256
sha <- Object
o Object -> Text -> WarningParser SHA256
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"sha256"
FileSize
size <- Object
o Object -> Text -> WarningParser FileSize
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"size"
Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation))
-> Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation)
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation)
-> (Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
_ -> SnapshotLocation -> IO SnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapshotLocation -> IO SnapshotLocation)
-> SnapshotLocation -> IO SnapshotLocation
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 = String
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"SLCompiler" ((Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation)))
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
WantedCompiler
c <- Object
o Object -> Text -> WriterT WarningParserMonoid Parser WantedCompiler
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"compiler"
Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation))
-> Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation)
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation)
-> (Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
_ -> SnapshotLocation -> IO SnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapshotLocation -> IO SnapshotLocation)
-> SnapshotLocation -> IO SnapshotLocation
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 (BlobKey -> Maybe BlobKey
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 -> String
(Int -> SnapshotPackage -> ShowS)
-> (SnapshotPackage -> String)
-> ([SnapshotPackage] -> ShowS)
-> Show SnapshotPackage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotPackage] -> ShowS
$cshowList :: [SnapshotPackage] -> ShowS
show :: SnapshotPackage -> String
$cshow :: SnapshotPackage -> String
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 -> String
(Int -> RawSnapshotLayer -> ShowS)
-> (RawSnapshotLayer -> String)
-> ([RawSnapshotLayer] -> ShowS)
-> Show RawSnapshotLayer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawSnapshotLayer] -> ShowS
$cshowList :: [RawSnapshotLayer] -> ShowS
show :: RawSnapshotLayer -> String
$cshow :: RawSnapshotLayer -> String
showsPrec :: Int -> RawSnapshotLayer -> ShowS
$cshowsPrec :: Int -> RawSnapshotLayer -> ShowS
Show, RawSnapshotLayer -> RawSnapshotLayer -> Bool
(RawSnapshotLayer -> RawSnapshotLayer -> Bool)
-> (RawSnapshotLayer -> RawSnapshotLayer -> Bool)
-> Eq RawSnapshotLayer
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. RawSnapshotLayer -> Rep RawSnapshotLayer x)
-> (forall x. Rep RawSnapshotLayer x -> RawSnapshotLayer)
-> Generic RawSnapshotLayer
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 = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Text
"resolver" Text -> RawSnapshotLocation -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RawSnapshotLayer -> RawSnapshotLocation
rslParent RawSnapshotLayer
rsnap]
, [(Text, Value)]
-> (WantedCompiler -> [(Text, Value)])
-> Maybe WantedCompiler
-> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\WantedCompiler
compiler -> [Text
"compiler" Text -> WantedCompiler -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WantedCompiler
compiler]) (RawSnapshotLayer -> Maybe WantedCompiler
rslCompiler RawSnapshotLayer
rsnap)
, [Text
"packages" Text -> [RawPackageLocationImmutable] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RawSnapshotLayer -> [RawPackageLocationImmutable]
rslLocations RawSnapshotLayer
rsnap]
, if Set PackageName -> Bool
forall a. Set a -> Bool
Set.null (RawSnapshotLayer -> Set PackageName
rslDropPackages RawSnapshotLayer
rsnap)
then []
else [Text
"drop-packages" Text -> Set (CabalString PackageName) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PackageName -> CabalString PackageName)
-> Set PackageName -> Set (CabalString PackageName)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString (RawSnapshotLayer -> Set PackageName
rslDropPackages RawSnapshotLayer
rsnap)]
, if Map PackageName (Map FlagName Bool) -> Bool
forall k a. Map k a -> Bool
Map.null (RawSnapshotLayer -> Map PackageName (Map FlagName Bool)
rslFlags RawSnapshotLayer
rsnap)
then []
else [Text
"flags" Text
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Map FlagName Bool -> Map (CabalString FlagName) Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map FlagName Bool -> Map (CabalString FlagName) Bool
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (Map PackageName (Map FlagName Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (RawSnapshotLayer -> Map PackageName (Map FlagName Bool)
rslFlags RawSnapshotLayer
rsnap))]
, if Map PackageName Bool -> Bool
forall k a. Map k a -> Bool
Map.null (RawSnapshotLayer -> Map PackageName Bool
rslHidden RawSnapshotLayer
rsnap)
then []
else [Text
"hidden" Text -> Map (CabalString PackageName) Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Map PackageName Bool -> Map (CabalString PackageName) Bool
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (RawSnapshotLayer -> Map PackageName Bool
rslHidden RawSnapshotLayer
rsnap)]
, if Map PackageName [Text] -> Bool
forall k a. Map k a -> Bool
Map.null (RawSnapshotLayer -> Map PackageName [Text]
rslGhcOptions RawSnapshotLayer
rsnap)
then []
else [Text
"ghc-options" Text -> Map (CabalString PackageName) [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Map PackageName [Text] -> Map (CabalString PackageName) [Text]
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (RawSnapshotLayer -> Map PackageName [Text]
rslGhcOptions RawSnapshotLayer
rsnap)]
, [(Text, Value)]
-> (UTCTime -> [(Text, Value)]) -> Maybe UTCTime -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\UTCTime
time -> [Text
"publish-time" Text -> UTCTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UTCTime
time]) (RawSnapshotLayer -> Maybe UTCTime
rslPublishTime RawSnapshotLayer
rsnap)
]
instance FromJSON (WithJSONWarnings (Unresolved RawSnapshotLayer)) where
parseJSON :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
parseJSON = String
-> (Object -> WarningParser (Unresolved RawSnapshotLayer))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"Snapshot" ((Object -> WarningParser (Unresolved RawSnapshotLayer))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer)))
-> (Object -> WarningParser (Unresolved RawSnapshotLayer))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Maybe Text
_ :: Maybe Text <- Object
o Object -> Text -> WarningParser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"name"
Maybe WantedCompiler
mcompiler <- Object
o Object -> Text -> WarningParser (Maybe WantedCompiler)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"compiler"
Maybe (Unresolved RawSnapshotLocation)
mresolver <- WarningParser
(Maybe (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> WarningParser (Maybe (Unresolved RawSnapshotLocation))
forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT (WarningParser
(Maybe (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> WarningParser (Maybe (Unresolved RawSnapshotLocation)))
-> WarningParser
(Maybe (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> WarningParser (Maybe (Unresolved RawSnapshotLocation))
forall a b. (a -> b) -> a -> b
$ Object
o Object
-> [Text]
-> WarningParser
(Maybe (WithJSONWarnings (Unresolved RawSnapshotLocation)))
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) -> String
-> WriterT
WarningParserMonoid
Parser
(Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Snapshot must have either resolver or compiler"
(Just WantedCompiler
compiler, Maybe (Unresolved RawSnapshotLocation)
Nothing) -> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> WriterT
WarningParserMonoid
Parser
(Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> WriterT
WarningParserMonoid
Parser
(Unresolved (RawSnapshotLocation, Maybe WantedCompiler)))
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> WriterT
WarningParserMonoid
Parser
(Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
forall a b. (a -> b) -> a -> b
$ (RawSnapshotLocation, Maybe WantedCompiler)
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WantedCompiler -> RawSnapshotLocation
RSLCompiler WantedCompiler
compiler, Maybe WantedCompiler
forall a. Maybe a
Nothing)
(Maybe WantedCompiler
_, Just (Unresolved Maybe (Path Abs Dir) -> IO RawSnapshotLocation
usl)) -> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> WriterT
WarningParserMonoid
Parser
(Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> WriterT
WarningParserMonoid
Parser
(Unresolved (RawSnapshotLocation, Maybe WantedCompiler)))
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> WriterT
WarningParserMonoid
Parser
(Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir)
-> IO (RawSnapshotLocation, Maybe WantedCompiler))
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir)
-> IO (RawSnapshotLocation, Maybe WantedCompiler))
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
-> (Maybe (Path Abs Dir)
-> IO (RawSnapshotLocation, Maybe WantedCompiler))
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
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) -> PantryException -> IO (RawSnapshotLocation, Maybe WantedCompiler)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PantryException -> IO (RawSnapshotLocation, Maybe WantedCompiler))
-> PantryException
-> IO (RawSnapshotLocation, Maybe WantedCompiler)
forall a b. (a -> b) -> a -> b
$ WantedCompiler -> WantedCompiler -> PantryException
InvalidOverrideCompiler WantedCompiler
c1 WantedCompiler
c2
(RawSnapshotLocation, Maybe WantedCompiler)
_ -> (RawSnapshotLocation, Maybe WantedCompiler)
-> IO (RawSnapshotLocation, Maybe WantedCompiler)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation
sl, Maybe WantedCompiler
mcompiler)
[Unresolved (NonEmpty RawPackageLocationImmutable)]
unresolvedLocs <- WarningParser
[WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))]
-> WarningParser
[Unresolved (NonEmpty RawPackageLocationImmutable)]
forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT (Object
o Object
-> Text
-> WarningParser
(Maybe
[WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"packages" WarningParser
(Maybe
[WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))])
-> [WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))]
-> WarningParser
[WithJSONWarnings
(Unresolved (NonEmpty RawPackageLocationImmutable))]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= [])
Set PackageName
rslDropPackages <- (CabalString PackageName -> PackageName)
-> Set (CabalString PackageName) -> Set PackageName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map CabalString PackageName -> PackageName
forall a. CabalString a -> a
unCabalString (Set (CabalString PackageName) -> Set PackageName)
-> WriterT
WarningParserMonoid Parser (Set (CabalString PackageName))
-> WriterT WarningParserMonoid Parser (Set PackageName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Text -> WarningParser (Maybe (Set (CabalString PackageName)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"drop-packages" WarningParser (Maybe (Set (CabalString PackageName)))
-> Set (CabalString PackageName)
-> WriterT
WarningParserMonoid Parser (Set (CabalString PackageName))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Set (CabalString PackageName)
forall a. Set a
Set.empty)
Map PackageName (Map FlagName Bool)
rslFlags <- (Map (CabalString PackageName) (Map FlagName Bool)
-> Map PackageName (Map FlagName Bool)
forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap (Map (CabalString PackageName) (Map FlagName Bool)
-> Map PackageName (Map FlagName Bool))
-> (Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> Map (CabalString PackageName) (Map FlagName Bool))
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> Map PackageName (Map FlagName Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (CabalString FlagName) Bool -> Map FlagName Bool)
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map (CabalString FlagName) Bool -> Map FlagName Bool
forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap) (Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> Map PackageName (Map FlagName Bool))
-> WriterT
WarningParserMonoid
Parser
(Map (CabalString PackageName) (Map (CabalString FlagName) Bool))
-> WriterT
WarningParserMonoid Parser (Map PackageName (Map FlagName Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Text
-> WarningParser
(Maybe
(Map (CabalString PackageName) (Map (CabalString FlagName) Bool)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"flags" WarningParser
(Maybe
(Map (CabalString PackageName) (Map (CabalString FlagName) Bool)))
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> WriterT
WarningParserMonoid
Parser
(Map (CabalString PackageName) (Map (CabalString FlagName) Bool))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
forall k a. Map k a
Map.empty)
Map PackageName Bool
rslHidden <- Map (CabalString PackageName) Bool -> Map PackageName Bool
forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap (Map (CabalString PackageName) Bool -> Map PackageName Bool)
-> WriterT
WarningParserMonoid Parser (Map (CabalString PackageName) Bool)
-> WriterT WarningParserMonoid Parser (Map PackageName Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Text
-> WarningParser (Maybe (Map (CabalString PackageName) Bool))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"hidden" WarningParser (Maybe (Map (CabalString PackageName) Bool))
-> Map (CabalString PackageName) Bool
-> WriterT
WarningParserMonoid Parser (Map (CabalString PackageName) Bool)
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map (CabalString PackageName) Bool
forall k a. Map k a
Map.empty)
Map PackageName [Text]
rslGhcOptions <- Map (CabalString PackageName) [Text] -> Map PackageName [Text]
forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap (Map (CabalString PackageName) [Text] -> Map PackageName [Text])
-> WriterT
WarningParserMonoid Parser (Map (CabalString PackageName) [Text])
-> WriterT WarningParserMonoid Parser (Map PackageName [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Text
-> WarningParser (Maybe (Map (CabalString PackageName) [Text]))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"ghc-options" WarningParser (Maybe (Map (CabalString PackageName) [Text]))
-> Map (CabalString PackageName) [Text]
-> WriterT
WarningParserMonoid Parser (Map (CabalString PackageName) [Text])
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map (CabalString PackageName) [Text]
forall k a. Map k a
Map.empty)
Maybe UTCTime
rslPublishTime <- Object
o Object -> Text -> WarningParser (Maybe UTCTime)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"publish-time"
Unresolved RawSnapshotLayer
-> WarningParser (Unresolved RawSnapshotLayer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved RawSnapshotLayer
-> WarningParser (Unresolved RawSnapshotLayer))
-> Unresolved RawSnapshotLayer
-> WarningParser (Unresolved RawSnapshotLayer)
forall a b. (a -> b) -> a -> b
$ (\[RawPackageLocationImmutable]
rslLocations (RawSnapshotLocation
rslParent, Maybe WantedCompiler
rslCompiler) -> RawSnapshotLayer :: RawSnapshotLocation
-> Maybe WantedCompiler
-> [RawPackageLocationImmutable]
-> Set PackageName
-> Map PackageName (Map FlagName Bool)
-> Map PackageName Bool
-> Map PackageName [Text]
-> Maybe UTCTime
-> RawSnapshotLayer
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
..})
([RawPackageLocationImmutable]
-> (RawSnapshotLocation, Maybe WantedCompiler) -> RawSnapshotLayer)
-> Unresolved [RawPackageLocationImmutable]
-> Unresolved
((RawSnapshotLocation, Maybe WantedCompiler) -> RawSnapshotLayer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([[RawPackageLocationImmutable]] -> [RawPackageLocationImmutable]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[RawPackageLocationImmutable]] -> [RawPackageLocationImmutable])
-> ([NonEmpty RawPackageLocationImmutable]
-> [[RawPackageLocationImmutable]])
-> [NonEmpty RawPackageLocationImmutable]
-> [RawPackageLocationImmutable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty RawPackageLocationImmutable
-> [RawPackageLocationImmutable])
-> [NonEmpty RawPackageLocationImmutable]
-> [[RawPackageLocationImmutable]]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty RawPackageLocationImmutable
-> [RawPackageLocationImmutable]
forall a. NonEmpty a -> [a]
NE.toList) ([NonEmpty RawPackageLocationImmutable]
-> [RawPackageLocationImmutable])
-> Unresolved [NonEmpty RawPackageLocationImmutable]
-> Unresolved [RawPackageLocationImmutable]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> Unresolved [NonEmpty RawPackageLocationImmutable]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Unresolved (NonEmpty RawPackageLocationImmutable)]
unresolvedLocs)
Unresolved
((RawSnapshotLocation, Maybe WantedCompiler) -> RawSnapshotLayer)
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> Unresolved RawSnapshotLayer
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 -> String
(Int -> SnapshotLayer -> ShowS)
-> (SnapshotLayer -> String)
-> ([SnapshotLayer] -> ShowS)
-> Show SnapshotLayer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotLayer] -> ShowS
$cshowList :: [SnapshotLayer] -> ShowS
show :: SnapshotLayer -> String
$cshow :: SnapshotLayer -> String
showsPrec :: Int -> SnapshotLayer -> ShowS
$cshowsPrec :: Int -> SnapshotLayer -> ShowS
Show, SnapshotLayer -> SnapshotLayer -> Bool
(SnapshotLayer -> SnapshotLayer -> Bool)
-> (SnapshotLayer -> SnapshotLayer -> Bool) -> Eq SnapshotLayer
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. SnapshotLayer -> Rep SnapshotLayer x)
-> (forall x. Rep SnapshotLayer x -> SnapshotLayer)
-> Generic SnapshotLayer
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 = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Text
"resolver" Text -> SnapshotLocation -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SnapshotLayer -> SnapshotLocation
slParent SnapshotLayer
snap]
, [(Text, Value)]
-> (WantedCompiler -> [(Text, Value)])
-> Maybe WantedCompiler
-> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\WantedCompiler
compiler -> [Text
"compiler" Text -> WantedCompiler -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WantedCompiler
compiler]) (SnapshotLayer -> Maybe WantedCompiler
slCompiler SnapshotLayer
snap)
, [Text
"packages" Text -> [PackageLocationImmutable] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SnapshotLayer -> [PackageLocationImmutable]
slLocations SnapshotLayer
snap]
, if Set PackageName -> Bool
forall a. Set a -> Bool
Set.null (SnapshotLayer -> Set PackageName
slDropPackages SnapshotLayer
snap) then [] else [Text
"drop-packages" Text -> Set (CabalString PackageName) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PackageName -> CabalString PackageName)
-> Set PackageName -> Set (CabalString PackageName)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString (SnapshotLayer -> Set PackageName
slDropPackages SnapshotLayer
snap)]
, if Map PackageName (Map FlagName Bool) -> Bool
forall k a. Map k a -> Bool
Map.null (SnapshotLayer -> Map PackageName (Map FlagName Bool)
slFlags SnapshotLayer
snap) then [] else [Text
"flags" Text
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Map FlagName Bool -> Map (CabalString FlagName) Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map FlagName Bool -> Map (CabalString FlagName) Bool
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (Map PackageName (Map FlagName Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (SnapshotLayer -> Map PackageName (Map FlagName Bool)
slFlags SnapshotLayer
snap))]
, if Map PackageName Bool -> Bool
forall k a. Map k a -> Bool
Map.null (SnapshotLayer -> Map PackageName Bool
slHidden SnapshotLayer
snap) then [] else [Text
"hidden" Text -> Map (CabalString PackageName) Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Map PackageName Bool -> Map (CabalString PackageName) Bool
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (SnapshotLayer -> Map PackageName Bool
slHidden SnapshotLayer
snap)]
, if Map PackageName [Text] -> Bool
forall k a. Map k a -> Bool
Map.null (SnapshotLayer -> Map PackageName [Text]
slGhcOptions SnapshotLayer
snap) then [] else [Text
"ghc-options" Text -> Map (CabalString PackageName) [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Map PackageName [Text] -> Map (CabalString PackageName) [Text]
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (SnapshotLayer -> Map PackageName [Text]
slGhcOptions SnapshotLayer
snap)]
, [(Text, Value)]
-> (UTCTime -> [(Text, Value)]) -> Maybe UTCTime -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\UTCTime
time -> [Text
"publish-time" Text -> UTCTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UTCTime
time]) (SnapshotLayer -> Maybe UTCTime
slPublishTime SnapshotLayer
snap)
]
toRawSnapshotLayer :: SnapshotLayer -> RawSnapshotLayer
toRawSnapshotLayer :: SnapshotLayer -> RawSnapshotLayer
toRawSnapshotLayer SnapshotLayer
sl = RawSnapshotLayer :: RawSnapshotLocation
-> Maybe WantedCompiler
-> [RawPackageLocationImmutable]
-> Set PackageName
-> Map PackageName (Map FlagName Bool)
-> Map PackageName Bool
-> Map PackageName [Text]
-> Maybe UTCTime
-> RawSnapshotLayer
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 = (PackageLocationImmutable -> RawPackageLocationImmutable)
-> [PackageLocationImmutable] -> [RawPackageLocationImmutable]
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 -> String
(Int -> SnapshotCacheHash -> ShowS)
-> (SnapshotCacheHash -> String)
-> ([SnapshotCacheHash] -> ShowS)
-> Show SnapshotCacheHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotCacheHash] -> ShowS
$cshowList :: [SnapshotCacheHash] -> ShowS
show :: SnapshotCacheHash -> String
$cshow :: SnapshotCacheHash -> String
showsPrec :: Int -> SnapshotCacheHash -> ShowS
$cshowsPrec :: Int -> SnapshotCacheHash -> ShowS
Show)
getGlobalHintsFile :: HasPantryConfig env => RIO env (Path Abs File)
getGlobalHintsFile :: RIO env (Path Abs File)
getGlobalHintsFile = do
Path Abs Dir
root <- Getting (Path Abs Dir) env (Path Abs Dir) -> RIO env (Path Abs Dir)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Path Abs Dir) env (Path Abs Dir)
-> RIO env (Path Abs Dir))
-> Getting (Path Abs Dir) env (Path Abs Dir)
-> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ (PantryConfig -> Const (Path Abs Dir) PantryConfig)
-> env -> Const (Path Abs Dir) env
forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigL((PantryConfig -> Const (Path Abs Dir) PantryConfig)
-> env -> Const (Path Abs Dir) env)
-> ((Path Abs Dir -> Const (Path Abs Dir) (Path Abs Dir))
-> PantryConfig -> Const (Path Abs Dir) PantryConfig)
-> Getting (Path Abs Dir) env (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PantryConfig -> Path Abs Dir)
-> SimpleGetter PantryConfig (Path Abs Dir)
forall s a. (s -> a) -> SimpleGetter s a
to PantryConfig -> Path Abs Dir
pcRootDir
Path Rel File
globalHintsRelFile <- String -> RIO env (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
"global-hints-cache.yaml"
Path Abs File -> RIO env (Path Abs File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File -> RIO env (Path Abs File))
-> Path Abs File -> RIO env (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root Path Abs Dir -> Path Rel File -> Path Abs File
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 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)))
warnMissingCabalFile :: HasLogFunc env => RawPackageLocationImmutable -> RIO env ()
warnMissingCabalFile :: RawPackageLocationImmutable -> RIO env ()
warnMissingCabalFile RawPackageLocationImmutable
loc =
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$
Utf8Builder
"DEPRECATED: The package at " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" does not include a cabal file.\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"Instead, it includes an hpack package.yaml file for generating a cabal file.\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"This usage is deprecated; please see https://github.com/commercialhaskell/stack/issues/5210.\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
"Support for this workflow will be removed in the future.\n"