{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}

module Pantry.Types
  ( PantryConfig (..)
  , PackageIndexConfig (..)
  , HackageSecurityConfig (..)
  , defaultHackageSecurityConfig
  , Storage (..)
  , HasPantryConfig (..)
  , BlobKey (..)
  , PackageName
  , Version
  , PackageIdentifier (..)
  , Revision (..)
  , ModuleName
  , CabalFileInfo (..)
  , PrintWarnings (..)
  , PackageNameP (..)
  , VersionP (..)
  , ModuleNameP (..)
  , PackageIdentifierRevision (..)
  , pirForHash
  , FileType (..)
  , BuildFile (..)
  , FileSize (..)
  , TreeEntry (..)
  , SafeFilePath
  , unSafeFilePath
  , mkSafeFilePath
  , safeFilePathToPath
  , hpackSafeFilePath
  , TreeKey (..)
  , Tree (..)
  , renderTree
  , parseTree
  , parseTreeM
  , SHA256
  , Unresolved
  , resolvePaths
  , Package (..)
  , PackageCabal (..)
  , PHpack (..)
  -- , PackageTarball (..)

  , RawPackageLocation (..)
  , PackageLocation (..)
  , toRawPL
  , RawPackageLocationImmutable (..)
  , PackageLocationImmutable (..)
  , toRawPLI
  , RawArchive (..)
  , Archive (..)
  , toRawArchive
  , Repo (..)
  , AggregateRepo (..)
  , SimpleRepo (..)
  , toAggregateRepos
  , rToSimpleRepo
  , arToSimpleRepo
  , RepoType (..)
  , parsePackageIdentifier
  , parsePackageName
  , parsePackageNameThrowing
  , parseFlagName
  , parseVersion
  , parseVersionThrowing
  , packageIdentifierString
  , packageNameString
  , flagNameString
  , versionString
  , moduleNameString
  , OptionalSubdirs (..)
  , ArchiveLocation (..)
  , RelFilePath (..)
  , CabalString (..)
  , toCabalStringMap
  , unCabalStringMap
  , parsePackageIdentifierRevision
  , Mismatch (..)
  , PantryException (..)
  , FuzzyResults (..)
  , ResolvedPath (..)
  , HpackExecutable (..)
  , WantedCompiler (..)
  --, resolveSnapshotLocation

  , snapshotLocation
  , defaultSnapshotLocation
  , globalHintsLocation
  , defaultGlobalHintsLocation
  , SnapName (..)
  , parseSnapName
  , RawSnapshotLocation (..)
  , SnapshotLocation (..)
  , toRawSL
  , parseHackageText
  , parseRawSnapshotLocation
  , RawSnapshotLayer (..)
  , SnapshotLayer (..)
  , toRawSnapshotLayer
  , RawSnapshot (..)
  , Snapshot (..)
  , RawSnapshotPackage (..)
  , SnapshotPackage (..)
  , GlobalHintsLocation (..)
  , parseGlobalHintsLocation
  , parseWantedCompiler
  , RawPackageMetadata (..)
  , PackageMetadata (..)
  , toRawPM
  , cabalFileName
  , SnapshotCacheHash (..)
  , getGlobalHintsFile
  , bsToBlobKey
  , warnMissingCabalFile
  , connRDBMS
  ) where

import           Casa.Client ( CasaRepoPrefix )
import           Database.Persist.Class.PersistField ( PersistField (..) )
import           Database.Persist.PersistValue ( PersistValue (..) )
import           Database.Persist.Sql ( PersistFieldSql (..), SqlBackend )
#if MIN_VERSION_persistent(2, 13, 0)
import           Database.Persist.SqlBackend.Internal ( connRDBMS )
#endif
import           Database.Persist.Types ( SqlType (..) )
import           Data.Aeson.Encoding.Internal ( unsafeToEncoding )
import           Data.Aeson.Types
                   ( FromJSON (..), FromJSONKey (..), FromJSONKeyFunction (..)
                   , Object, Parser, ToJSON (..), ToJSONKey (..)
                   , ToJSONKeyFunction (..), Value (..), (.=), object
                   , toJSONKeyText, withObject, withText
                   )
import           Data.Aeson.WarningParser
                   ( WarningParser, WithJSONWarnings, (..:), (..:?), (..!=)
                   , (.:), (...:?), jsonSubWarnings, jsonSubWarningsT
                   , noJSONWarnings, tellJSONField, withObjectWarnings
                   )
import           Data.ByteString.Builder
                   ( byteString, toLazyByteString, wordDec )
import qualified Data.Conduit.Tar as Tar
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map ( mapKeysMonotonic )
import           Data.Text.Read ( decimal )
import           Distribution.CabalSpecVersion ( cabalSpecLatest )
#if MIN_VERSION_Cabal(3,4,0)
import           Distribution.CabalSpecVersion ( cabalSpecToVersionDigits )
#else
import           Distribution.CabalSpecVersion ( CabalSpecVersion (..) )
#endif
import qualified Distribution.Compat.CharParsing as Parse
import           Distribution.ModuleName ( ModuleName )
import           Distribution.PackageDescription
                   ( FlagName, GenericPackageDescription, unFlagName )
import           Distribution.Parsec
                   ( PError (..), PWarning (..), ParsecParser
                   , explicitEitherParsec, parsec, showPos
                   )
import qualified Distribution.Pretty
import qualified Distribution.Text
import           Distribution.Types.PackageId ( PackageIdentifier (..) )
import           Distribution.Types.PackageName
                   ( PackageName, mkPackageName, unPackageName )
import           Distribution.Types.Version ( Version, mkVersion, nullVersion )
import           Distribution.Types.VersionRange ( VersionRange )
import qualified Hpack
import qualified Hpack.Config as Hpack
import           Network.HTTP.Client ( parseRequest )
import           Network.HTTP.Types ( Status, statusCode )
import           Pantry.SHA256 ( SHA256 )
import qualified Pantry.SHA256 as SHA256
import           Path
                   ( Abs, Dir, File, Path, (</>), filename, parseRelFile
                   , toFilePath
                   )
import           Path.IO ( resolveDir, resolveFile )
import qualified RIO.Set as Set
import           RIO
import qualified RIO.ByteString as B
import qualified RIO.ByteString.Lazy as BL
import           RIO.List ( groupBy, intersperse )
import qualified RIO.Text as T
import           RIO.Time ( Day, UTCTime, toGregorian )
import qualified RIO.Map as Map
import           RIO.PrettyPrint
                   ( blankLine, bulletedList, fillSep, flow, hang, line
                   , mkNarrativeList, parens, string, style
                   )
import           RIO.PrettyPrint.Types ( Style (..) )
import           Text.PrettyPrint.Leijen.Extended ( Pretty (..), StyleDoc )

#if MIN_VERSION_aeson(2, 0, 0)
import qualified Data.Aeson.KeyMap as HM
import qualified Data.Aeson.Key

type AesonKey = Data.Aeson.Key.Key
#else
import qualified RIO.HashMap as HM

type AesonKey = Text
#endif

-- | Parsed tree with more information on the Haskell package it contains.

--

-- @since 0.1.0.0

data Package = Package
  { Package -> TreeKey
packageTreeKey :: !TreeKey
    -- ^ The 'TreeKey' containing this package.

    --

    -- This is a hash of the binary representation of 'packageTree'.

    --

    -- @since 0.1.0.0

  , Package -> Tree
packageTree :: !Tree
    -- ^ The 'Tree' containing this package.

    --

    -- @since 0.1.0.0

  , Package -> PackageCabal
packageCabalEntry :: !PackageCabal
    -- ^ Information on the cabal file inside this package.

    --

    -- @since 0.1.0.0

  , Package -> PackageIdentifier
packageIdent :: !PackageIdentifier
    -- ^ The package name and version in this package.

    --

    -- @since 0.1.0.0

  }
  deriving (Int -> Package -> ShowS
[Package] -> ShowS
Package -> [Char]
(Int -> Package -> ShowS)
-> (Package -> [Char]) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Package -> ShowS
showsPrec :: Int -> Package -> ShowS
$cshow :: Package -> [Char]
show :: Package -> [Char]
$cshowList :: [Package] -> ShowS
showList :: [Package] -> ShowS
Show, Package -> Package -> Bool
(Package -> Package -> Bool)
-> (Package -> Package -> Bool) -> Eq Package
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
/= :: Package -> Package -> Bool
Eq, Eq Package
Eq Package =>
(Package -> Package -> Ordering)
-> (Package -> Package -> Bool)
-> (Package -> Package -> Bool)
-> (Package -> Package -> Bool)
-> (Package -> Package -> Bool)
-> (Package -> Package -> Package)
-> (Package -> Package -> Package)
-> Ord Package
Package -> Package -> Bool
Package -> Package -> Ordering
Package -> Package -> Package
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Package -> Package -> Ordering
compare :: Package -> Package -> Ordering
$c< :: Package -> Package -> Bool
< :: Package -> Package -> Bool
$c<= :: Package -> Package -> Bool
<= :: Package -> Package -> Bool
$c> :: Package -> Package -> Bool
> :: Package -> Package -> Bool
$c>= :: Package -> Package -> Bool
>= :: Package -> Package -> Bool
$cmax :: Package -> Package -> Package
max :: Package -> Package -> Package
$cmin :: Package -> Package -> Package
min :: Package -> Package -> Package
Ord)

data PHpack = PHpack
  { PHpack -> TreeEntry
phOriginal :: !TreeEntry
    -- ^ Original hpack file

  , PHpack -> TreeEntry
phGenerated :: !TreeEntry
    -- ^ Generated Cabal file

  , PHpack -> Version
phVersion :: !Version
    -- ^ Version of Hpack used

  }
  deriving (Int -> PHpack -> ShowS
[PHpack] -> ShowS
PHpack -> [Char]
(Int -> PHpack -> ShowS)
-> (PHpack -> [Char]) -> ([PHpack] -> ShowS) -> Show PHpack
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PHpack -> ShowS
showsPrec :: Int -> PHpack -> ShowS
$cshow :: PHpack -> [Char]
show :: PHpack -> [Char]
$cshowList :: [PHpack] -> ShowS
showList :: [PHpack] -> ShowS
Show, PHpack -> PHpack -> Bool
(PHpack -> PHpack -> Bool)
-> (PHpack -> PHpack -> Bool) -> Eq PHpack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PHpack -> PHpack -> Bool
== :: PHpack -> PHpack -> Bool
$c/= :: PHpack -> PHpack -> Bool
/= :: PHpack -> PHpack -> Bool
Eq, Eq PHpack
Eq PHpack =>
(PHpack -> PHpack -> Ordering)
-> (PHpack -> PHpack -> Bool)
-> (PHpack -> PHpack -> Bool)
-> (PHpack -> PHpack -> Bool)
-> (PHpack -> PHpack -> Bool)
-> (PHpack -> PHpack -> PHpack)
-> (PHpack -> PHpack -> PHpack)
-> Ord PHpack
PHpack -> PHpack -> Bool
PHpack -> PHpack -> Ordering
PHpack -> PHpack -> PHpack
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PHpack -> PHpack -> Ordering
compare :: PHpack -> PHpack -> Ordering
$c< :: PHpack -> PHpack -> Bool
< :: PHpack -> PHpack -> Bool
$c<= :: PHpack -> PHpack -> Bool
<= :: PHpack -> PHpack -> Bool
$c> :: PHpack -> PHpack -> Bool
> :: PHpack -> PHpack -> Bool
$c>= :: PHpack -> PHpack -> Bool
>= :: PHpack -> PHpack -> Bool
$cmax :: PHpack -> PHpack -> PHpack
max :: PHpack -> PHpack -> PHpack
$cmin :: PHpack -> PHpack -> PHpack
min :: PHpack -> PHpack -> PHpack
Ord)

data PackageCabal
  = PCCabalFile !TreeEntry -- ^ TreeEntry of Cabal file

  | PCHpack !PHpack
  deriving (Int -> PackageCabal -> ShowS
[PackageCabal] -> ShowS
PackageCabal -> [Char]
(Int -> PackageCabal -> ShowS)
-> (PackageCabal -> [Char])
-> ([PackageCabal] -> ShowS)
-> Show PackageCabal
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageCabal -> ShowS
showsPrec :: Int -> PackageCabal -> ShowS
$cshow :: PackageCabal -> [Char]
show :: PackageCabal -> [Char]
$cshowList :: [PackageCabal] -> ShowS
showList :: [PackageCabal] -> ShowS
Show, PackageCabal -> PackageCabal -> Bool
(PackageCabal -> PackageCabal -> Bool)
-> (PackageCabal -> PackageCabal -> Bool) -> Eq PackageCabal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageCabal -> PackageCabal -> Bool
== :: PackageCabal -> PackageCabal -> Bool
$c/= :: PackageCabal -> PackageCabal -> Bool
/= :: PackageCabal -> PackageCabal -> Bool
Eq, Eq PackageCabal
Eq PackageCabal =>
(PackageCabal -> PackageCabal -> Ordering)
-> (PackageCabal -> PackageCabal -> Bool)
-> (PackageCabal -> PackageCabal -> Bool)
-> (PackageCabal -> PackageCabal -> Bool)
-> (PackageCabal -> PackageCabal -> Bool)
-> (PackageCabal -> PackageCabal -> PackageCabal)
-> (PackageCabal -> PackageCabal -> PackageCabal)
-> Ord PackageCabal
PackageCabal -> PackageCabal -> Bool
PackageCabal -> PackageCabal -> Ordering
PackageCabal -> PackageCabal -> PackageCabal
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PackageCabal -> PackageCabal -> Ordering
compare :: PackageCabal -> PackageCabal -> Ordering
$c< :: PackageCabal -> PackageCabal -> Bool
< :: PackageCabal -> PackageCabal -> Bool
$c<= :: PackageCabal -> PackageCabal -> Bool
<= :: PackageCabal -> PackageCabal -> Bool
$c> :: PackageCabal -> PackageCabal -> Bool
> :: PackageCabal -> PackageCabal -> Bool
$c>= :: PackageCabal -> PackageCabal -> Bool
>= :: PackageCabal -> PackageCabal -> Bool
$cmax :: PackageCabal -> PackageCabal -> PackageCabal
max :: PackageCabal -> PackageCabal -> PackageCabal
$cmin :: PackageCabal -> PackageCabal -> PackageCabal
min :: PackageCabal -> PackageCabal -> PackageCabal
Ord)

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
$ [Char] -> Text
T.pack (PackageName -> [Char]
packageNameString PackageName
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".cabal" of
    Maybe SafeFilePath
Nothing -> [Char] -> SafeFilePath
forall a. HasCallStack => [Char] -> a
error ([Char] -> SafeFilePath) -> [Char] -> SafeFilePath
forall a b. (a -> b) -> a -> b
$ [Char]
"cabalFileName: failed for " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> [Char]
forall a. Show a => a -> [Char]
show PackageName
name
    Just SafeFilePath
sfp -> SafeFilePath
sfp

-- | The revision number of a package from Hackage, counting upwards from 0 (the

-- original cabal file).

--

-- See caveats on 'CFIRevision'.

--

-- @since 0.1.0.0

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
$cfrom :: forall x. Revision -> Rep Revision x
from :: forall x. Revision -> Rep Revision x
$cto :: forall x. Rep Revision x -> Revision
to :: forall x. Rep Revision x -> Revision
Generic, Int -> Revision -> ShowS
[Revision] -> ShowS
Revision -> [Char]
(Int -> Revision -> ShowS)
-> (Revision -> [Char]) -> ([Revision] -> ShowS) -> Show Revision
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Revision -> ShowS
showsPrec :: Int -> Revision -> ShowS
$cshow :: Revision -> [Char]
show :: Revision -> [Char]
$cshowList :: [Revision] -> ShowS
showList :: [Revision] -> ShowS
Show, Revision -> Revision -> Bool
(Revision -> Revision -> Bool)
-> (Revision -> Revision -> Bool) -> Eq Revision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Revision -> Revision -> Bool
== :: Revision -> Revision -> Bool
$c/= :: Revision -> Revision -> Bool
/= :: Revision -> Revision -> Bool
Eq, Revision -> ()
(Revision -> ()) -> NFData Revision
forall a. (a -> ()) -> NFData a
$crnf :: Revision -> ()
rnf :: Revision -> ()
NFData, Typeable Revision
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 -> Constr
Revision -> DataType
(forall b. Data b => b -> b) -> Revision -> Revision
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Revision -> u
forall u. (forall d. Data d => d -> u) -> Revision -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Revision -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Revision -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Revision
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Revision -> c Revision
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Revision)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Revision)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Revision -> c Revision
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Revision -> c Revision
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Revision
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Revision
$ctoConstr :: Revision -> Constr
toConstr :: Revision -> Constr
$cdataTypeOf :: Revision -> DataType
dataTypeOf :: Revision -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Revision)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Revision)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Revision)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Revision)
$cgmapT :: (forall b. Data b => b -> b) -> Revision -> Revision
gmapT :: (forall b. Data b => b -> b) -> Revision -> Revision
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Revision -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Revision -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Revision -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Revision -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Revision -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Revision -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Revision -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Revision -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Revision -> m Revision
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Revision -> m 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
$ccompare :: Revision -> Revision -> Ordering
compare :: Revision -> Revision -> Ordering
$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
>= :: Revision -> Revision -> Bool
$cmax :: Revision -> Revision -> Revision
max :: Revision -> Revision -> Revision
$cmin :: Revision -> Revision -> Revision
min :: Revision -> Revision -> Revision
Ord, Eq Revision
Eq Revision =>
(Int -> Revision -> Int) -> (Revision -> Int) -> Hashable Revision
Int -> Revision -> Int
Revision -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Revision -> Int
hashWithSalt :: Int -> Revision -> Int
$chash :: Revision -> Int
hash :: Revision -> Int
Hashable, Revision -> Text
Revision -> Utf8Builder
(Revision -> Utf8Builder) -> (Revision -> Text) -> Display Revision
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
$cdisplay :: Revision -> Utf8Builder
display :: Revision -> Utf8Builder
$ctextDisplay :: Revision -> Text
textDisplay :: Revision -> Text
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
$ctoPersistValue :: Revision -> PersistValue
toPersistValue :: Revision -> PersistValue
$cfromPersistValue :: PersistValue -> Either Text Revision
fromPersistValue :: PersistValue -> Either Text Revision
PersistField, PersistField Revision
Proxy Revision -> SqlType
PersistField Revision =>
(Proxy Revision -> SqlType) -> PersistFieldSql Revision
forall a.
PersistField a =>
(Proxy a -> SqlType) -> PersistFieldSql a
$csqlType :: Proxy Revision -> SqlType
sqlType :: Proxy Revision -> SqlType
PersistFieldSql)

-- | Represents a SQL database connection.


-- This used to be a newtype wrapper around a connection pool. However, when

-- investigating <https://github.com/commercialhaskell/stack/issues/4471>, it

-- appeared that holding a pool resulted in overly long write locks being held

-- on the database. As a result, we now abstract away whether a pool is used,

-- and the default implementation in "Pantry.Storage" does not use a pool.

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
  }

-- | Configuration value used by the entire pantry package. Create one using

-- 'withPantryConfig' or 'withPantryConfig''. See also 'PantryApp' for a

-- convenience approach to using pantry.

--

-- @since 0.1.0.0

data PantryConfig = PantryConfig
  { PantryConfig -> PackageIndexConfig
pcPackageIndex :: !PackageIndexConfig
  , PantryConfig -> HpackExecutable
pcHpackExecutable :: !HpackExecutable
  , PantryConfig -> Force
pcHpackForce :: !Hpack.Force
  , PantryConfig -> Path Abs Dir
pcRootDir :: !(Path Abs Dir)
  , PantryConfig -> Storage
pcStorage :: !Storage
  , PantryConfig -> MVar Bool
pcUpdateRef :: !(MVar Bool)
    -- ^ Want to try updating the index once during a single run for missing

    -- package identifiers. We also want to ensure we only update once at a

    -- time. Start at @True@.

  , PantryConfig
-> IORef
     (Map RawPackageLocationImmutable GenericPackageDescription)
pcParsedCabalFilesRawImmutable ::
      !(IORef (Map RawPackageLocationImmutable GenericPackageDescription))
    -- ^ Cache of previously parsed cabal files, to save on slow parsing time.

  , 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
             )
           )
       )
    -- ^ Cache for mutable packages. We want to allow for an optimization:

    -- deferring parsing of the 'GenericPackageDescription' until its actually

    -- needed. Therefore, we keep the filepath and the 'PackageName' derived

    -- from that filepath. When the @IO GenericPackageDescription@ is run, it

    -- will ensure that the @PackageName@ matches the value inside the cabal

    -- file, and print out any warnings that still need to be printed.

  , PantryConfig -> Int
pcConnectionCount :: !Int
    -- ^ concurrently open downloads

  , PantryConfig -> Maybe (CasaRepoPrefix, Int)
pcCasaConfig :: !(Maybe (CasaRepoPrefix, Int))
    -- ^ Optionally, the Casa pull URL e.g. @https://casa.stackage.org@ and

    -- the maximum number of Casa keys to pull per request.

  , PantryConfig -> SnapName -> RawSnapshotLocation
pcSnapshotLocation :: SnapName -> RawSnapshotLocation
    -- ^ The location of snapshot synonyms

  , PantryConfig -> WantedCompiler -> GlobalHintsLocation
pcGlobalHintsLocation :: WantedCompiler -> GlobalHintsLocation
    -- ^ The location of global hints

  }

-- | Get the location of a snapshot synonym from the 'PantryConfig'.

--

-- @since 0.5.0.0

snapshotLocation ::
     HasPantryConfig env
  => SnapName
  -> RIO env RawSnapshotLocation
snapshotLocation :: forall env.
HasPantryConfig env =>
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
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 a. a -> RIO env a
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

-- | Get the location of global hints from the 'PantryConfig'.

--

-- @since 0.9.4

globalHintsLocation ::
     HasPantryConfig env
  => WantedCompiler
  -> RIO env GlobalHintsLocation
globalHintsLocation :: forall env.
HasPantryConfig env =>
WantedCompiler -> RIO env GlobalHintsLocation
globalHintsLocation WantedCompiler
wc = do
  WantedCompiler -> GlobalHintsLocation
loc <- Getting
  (WantedCompiler -> GlobalHintsLocation)
  env
  (WantedCompiler -> GlobalHintsLocation)
-> RIO env (WantedCompiler -> GlobalHintsLocation)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting
   (WantedCompiler -> GlobalHintsLocation)
   env
   (WantedCompiler -> GlobalHintsLocation)
 -> RIO env (WantedCompiler -> GlobalHintsLocation))
-> Getting
     (WantedCompiler -> GlobalHintsLocation)
     env
     (WantedCompiler -> GlobalHintsLocation)
-> RIO env (WantedCompiler -> GlobalHintsLocation)
forall a b. (a -> b) -> a -> b
$ (PantryConfig
 -> Const (WantedCompiler -> GlobalHintsLocation) PantryConfig)
-> env -> Const (WantedCompiler -> GlobalHintsLocation) env
forall env. HasPantryConfig env => Lens' env PantryConfig
Lens' env PantryConfig
pantryConfigL((PantryConfig
  -> Const (WantedCompiler -> GlobalHintsLocation) PantryConfig)
 -> env -> Const (WantedCompiler -> GlobalHintsLocation) env)
-> (((WantedCompiler -> GlobalHintsLocation)
     -> Const
          (WantedCompiler -> GlobalHintsLocation)
          (WantedCompiler -> GlobalHintsLocation))
    -> PantryConfig
    -> Const (WantedCompiler -> GlobalHintsLocation) PantryConfig)
-> Getting
     (WantedCompiler -> GlobalHintsLocation)
     env
     (WantedCompiler -> GlobalHintsLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PantryConfig -> WantedCompiler -> GlobalHintsLocation)
-> SimpleGetter
     PantryConfig (WantedCompiler -> GlobalHintsLocation)
forall s a. (s -> a) -> SimpleGetter s a
to PantryConfig -> WantedCompiler -> GlobalHintsLocation
pcGlobalHintsLocation
  GlobalHintsLocation -> RIO env GlobalHintsLocation
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GlobalHintsLocation -> RIO env GlobalHintsLocation)
-> GlobalHintsLocation -> RIO env GlobalHintsLocation
forall a b. (a -> b) -> a -> b
$ WantedCompiler -> GlobalHintsLocation
loc WantedCompiler
wc

-- | Should we print warnings when loading a cabal file?

--

-- @since 0.1.0.0

data PrintWarnings = YesPrintWarnings | NoPrintWarnings

-- | Wraps a value which potentially contains relative paths. Needs to be

-- provided with a base directory to resolve these paths.

--

-- Unwrap this using 'resolvePaths'.

--

-- @since 0.1.0.0

newtype Unresolved a = Unresolved (Maybe (Path Abs Dir) -> IO a)
  deriving (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
$cfmap :: forall a b. (a -> b) -> Unresolved a -> Unresolved b
fmap :: forall a b. (a -> b) -> Unresolved a -> Unresolved b
$c<$ :: forall a b. a -> Unresolved b -> Unresolved a
<$ :: forall a b. a -> Unresolved b -> Unresolved a
Functor

instance Applicative Unresolved where
  pure :: forall a. 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Unresolved Maybe (Path Abs Dir) -> IO (a -> b)
f <*> :: forall a b. Unresolved (a -> b) -> Unresolved a -> Unresolved b
<*> Unresolved Maybe (Path Abs Dir) -> IO a
x = (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 a b. 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

-- | Resolve all of the file paths in an 'Unresolved' relative to the given

-- directory.

--

-- @since 0.1.0.0

resolvePaths ::
     MonadIO m
  => Maybe (Path Abs Dir) -- ^ directory to use for relative paths

  -> Unresolved a
  -> m a
resolvePaths :: forall (m :: * -> *) a.
MonadIO m =>
Maybe (Path Abs Dir) -> Unresolved a -> m a
resolvePaths Maybe (Path Abs Dir)
mdir (Unresolved Maybe (Path Abs Dir) -> IO a
f) = IO a -> m a
forall a. 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)

-- | A combination of the relative path provided in a config file, together with

-- the resolved absolute path.

--

-- @since 0.1.0.0

data ResolvedPath t = ResolvedPath
  { forall t. ResolvedPath t -> RelFilePath
resolvedRelative :: !RelFilePath
    -- ^ Original value parsed from a config file.

  , forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute :: !(Path Abs t)
    -- ^ Absolute path resolved against base directory loaded from.

  }
  deriving (Int -> ResolvedPath t -> ShowS
[ResolvedPath t] -> ShowS
ResolvedPath t -> [Char]
(Int -> ResolvedPath t -> ShowS)
-> (ResolvedPath t -> [Char])
-> ([ResolvedPath t] -> ShowS)
-> Show (ResolvedPath t)
forall t. Int -> ResolvedPath t -> ShowS
forall t. [ResolvedPath t] -> ShowS
forall t. ResolvedPath t -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Int -> ResolvedPath t -> ShowS
showsPrec :: Int -> ResolvedPath t -> ShowS
$cshow :: forall t. ResolvedPath t -> [Char]
show :: ResolvedPath t -> [Char]
$cshowList :: forall t. [ResolvedPath t] -> ShowS
showList :: [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
$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
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
$cfrom :: forall t x. ResolvedPath t -> Rep (ResolvedPath t) x
from :: forall x. ResolvedPath t -> Rep (ResolvedPath t) x
$cto :: forall t x. Rep (ResolvedPath t) x -> ResolvedPath t
to :: forall x. Rep (ResolvedPath t) x -> ResolvedPath t
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
$ccompare :: forall t. ResolvedPath t -> ResolvedPath t -> Ordering
compare :: ResolvedPath t -> ResolvedPath t -> Ordering
$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
>= :: ResolvedPath t -> ResolvedPath t -> Bool
$cmax :: forall t. ResolvedPath t -> ResolvedPath t -> ResolvedPath t
max :: ResolvedPath t -> ResolvedPath t -> ResolvedPath t
$cmin :: forall t. ResolvedPath t -> ResolvedPath t -> ResolvedPath t
min :: ResolvedPath t -> ResolvedPath t -> ResolvedPath t
Ord)

instance NFData (ResolvedPath t)

-- | Location to load a package from. Can either be immutable (see

-- 'PackageLocationImmutable') or a local directory which is expected to change

-- over time. Raw version doesn't include exact package version (e.g. could

-- refer to the latest revision on Hackage)

--

-- @since 0.1.0.0

data RawPackageLocation
  = RPLImmutable !RawPackageLocationImmutable
  | RPLMutable !(ResolvedPath Dir)
  deriving (Int -> RawPackageLocation -> ShowS
[RawPackageLocation] -> ShowS
RawPackageLocation -> [Char]
(Int -> RawPackageLocation -> ShowS)
-> (RawPackageLocation -> [Char])
-> ([RawPackageLocation] -> ShowS)
-> Show RawPackageLocation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawPackageLocation -> ShowS
showsPrec :: Int -> RawPackageLocation -> ShowS
$cshow :: RawPackageLocation -> [Char]
show :: RawPackageLocation -> [Char]
$cshowList :: [RawPackageLocation] -> ShowS
showList :: [RawPackageLocation] -> ShowS
Show, RawPackageLocation -> RawPackageLocation -> Bool
(RawPackageLocation -> RawPackageLocation -> Bool)
-> (RawPackageLocation -> RawPackageLocation -> Bool)
-> Eq RawPackageLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawPackageLocation -> RawPackageLocation -> Bool
== :: RawPackageLocation -> RawPackageLocation -> Bool
$c/= :: RawPackageLocation -> RawPackageLocation -> Bool
/= :: 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
$cfrom :: forall x. RawPackageLocation -> Rep RawPackageLocation x
from :: forall x. RawPackageLocation -> Rep RawPackageLocation x
$cto :: forall x. Rep RawPackageLocation x -> RawPackageLocation
to :: forall x. Rep RawPackageLocation x -> RawPackageLocation
Generic)

instance NFData RawPackageLocation

-- | Location to load a package from. Can either be immutable (see

-- 'PackageLocationImmutable') or a local directory which is expected to change

-- over time.

--

-- @since 0.1.0.0

data PackageLocation
  = PLImmutable !PackageLocationImmutable
  | PLMutable !(ResolvedPath Dir)
  deriving (Int -> PackageLocation -> ShowS
[PackageLocation] -> ShowS
PackageLocation -> [Char]
(Int -> PackageLocation -> ShowS)
-> (PackageLocation -> [Char])
-> ([PackageLocation] -> ShowS)
-> Show PackageLocation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageLocation -> ShowS
showsPrec :: Int -> PackageLocation -> ShowS
$cshow :: PackageLocation -> [Char]
show :: PackageLocation -> [Char]
$cshowList :: [PackageLocation] -> ShowS
showList :: [PackageLocation] -> ShowS
Show, PackageLocation -> PackageLocation -> Bool
(PackageLocation -> PackageLocation -> Bool)
-> (PackageLocation -> PackageLocation -> Bool)
-> Eq PackageLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageLocation -> PackageLocation -> Bool
== :: PackageLocation -> PackageLocation -> Bool
$c/= :: PackageLocation -> PackageLocation -> Bool
/= :: 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
$cfrom :: forall x. PackageLocation -> Rep PackageLocation x
from :: forall x. PackageLocation -> Rep PackageLocation x
$cto :: forall x. Rep PackageLocation x -> PackageLocation
to :: forall x. Rep PackageLocation x -> PackageLocation
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) = [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString ([Char] -> Utf8Builder) -> [Char] -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath (Path Abs Dir -> [Char]) -> Path Abs Dir -> [Char]
forall a b. (a -> b) -> a -> b
$ ResolvedPath Dir -> Path Abs Dir
forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute ResolvedPath Dir
fp

-- | Convert `PackageLocation` to its "raw" equivalent

--

-- @since 0.1.0.0

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

-- | Location for remote packages or archives assumed to be immutable.

-- as user specifies it i.e. not an exact location

--

-- @since 0.1.0.0

data RawPackageLocationImmutable
  = RPLIHackage !PackageIdentifierRevision !(Maybe TreeKey)
  | RPLIArchive !RawArchive !RawPackageMetadata
  | RPLIRepo    !Repo !RawPackageMetadata
  deriving (Int -> RawPackageLocationImmutable -> ShowS
[RawPackageLocationImmutable] -> ShowS
RawPackageLocationImmutable -> [Char]
(Int -> RawPackageLocationImmutable -> ShowS)
-> (RawPackageLocationImmutable -> [Char])
-> ([RawPackageLocationImmutable] -> ShowS)
-> Show RawPackageLocationImmutable
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawPackageLocationImmutable -> ShowS
showsPrec :: Int -> RawPackageLocationImmutable -> ShowS
$cshow :: RawPackageLocationImmutable -> [Char]
show :: RawPackageLocationImmutable -> [Char]
$cshowList :: [RawPackageLocationImmutable] -> ShowS
showList :: [RawPackageLocationImmutable] -> ShowS
Show, RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
(RawPackageLocationImmutable
 -> RawPackageLocationImmutable -> Bool)
-> (RawPackageLocationImmutable
    -> RawPackageLocationImmutable -> Bool)
-> Eq RawPackageLocationImmutable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
== :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
$c/= :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
/= :: 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
$ccompare :: RawPackageLocationImmutable
-> RawPackageLocationImmutable -> Ordering
compare :: RawPackageLocationImmutable
-> RawPackageLocationImmutable -> Ordering
$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
>= :: RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
$cmax :: RawPackageLocationImmutable
-> RawPackageLocationImmutable -> RawPackageLocationImmutable
max :: RawPackageLocationImmutable
-> RawPackageLocationImmutable -> RawPackageLocationImmutable
$cmin :: RawPackageLocationImmutable
-> RawPackageLocationImmutable -> RawPackageLocationImmutable
min :: RawPackageLocationImmutable
-> RawPackageLocationImmutable -> 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
$cfrom :: forall x.
RawPackageLocationImmutable -> Rep RawPackageLocationImmutable x
from :: forall x.
RawPackageLocationImmutable -> Rep RawPackageLocationImmutable x
$cto :: forall x.
Rep RawPackageLocationImmutable x -> RawPackageLocationImmutable
to :: forall x.
Rep RawPackageLocationImmutable x -> RawPackageLocationImmutable
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))

instance Pretty RawPackageLocationImmutable where
  pretty :: RawPackageLocationImmutable -> StyleDoc
pretty (RPLIHackage PackageIdentifierRevision
pir Maybe TreeKey
_tree) = [StyleDoc] -> StyleDoc
fillSep
    [ [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ PackageIdentifierRevision -> Text
forall a. Display a => a -> Text
textDisplay PackageIdentifierRevision
pir
    , StyleDoc -> StyleDoc
parens ([Char] -> StyleDoc
flow [Char]
"from Hackage")
    ]
  pretty (RPLIArchive RawArchive
archive RawPackageMetadata
_pm) = [StyleDoc] -> StyleDoc
fillSep
    [ [Char] -> StyleDoc
flow [Char]
"Archive from"
    , ArchiveLocation -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty (RawArchive -> ArchiveLocation
raLocation RawArchive
archive)
    , if Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ RawArchive -> Text
raSubdir RawArchive
archive
        then StyleDoc
forall a. Monoid a => a
mempty
        else [StyleDoc] -> StyleDoc
fillSep
          [ [Char] -> StyleDoc
flow [Char]
"in subdir"
          , Style -> StyleDoc -> StyleDoc
style Style
Dir ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (RawArchive -> Text
raSubdir RawArchive
archive))
          ]
    ]
  pretty (RPLIRepo Repo
repo RawPackageMetadata
_pm) = [StyleDoc] -> StyleDoc
fillSep
    [ [Char] -> StyleDoc
flow [Char]
"Repo from"
    , Style -> StyleDoc -> StyleDoc
style Style
Url ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Repo -> Text
repoUrl Repo
repo)) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
    , StyleDoc
"commit"
    , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Repo -> Text
repoCommit Repo
repo)
    , if Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Repo -> Text
repoSubdir Repo
repo
        then StyleDoc
forall a. Monoid a => a
mempty
        else [StyleDoc] -> StyleDoc
fillSep
          [ [Char] -> StyleDoc
flow [Char]
"in subdir"
          , Style -> StyleDoc -> StyleDoc
style Style
Dir ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Repo -> Text
repoSubdir Repo
repo))
          ]
    ]

-- | Location for remote packages or archives assumed to be immutable.

--

-- @since 0.1.0.0

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
$cfrom :: forall x.
PackageLocationImmutable -> Rep PackageLocationImmutable x
from :: forall x.
PackageLocationImmutable -> Rep PackageLocationImmutable x
$cto :: forall x.
Rep PackageLocationImmutable x -> PackageLocationImmutable
to :: forall x.
Rep PackageLocationImmutable x -> PackageLocationImmutable
Generic, Int -> PackageLocationImmutable -> ShowS
[PackageLocationImmutable] -> ShowS
PackageLocationImmutable -> [Char]
(Int -> PackageLocationImmutable -> ShowS)
-> (PackageLocationImmutable -> [Char])
-> ([PackageLocationImmutable] -> ShowS)
-> Show PackageLocationImmutable
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageLocationImmutable -> ShowS
showsPrec :: Int -> PackageLocationImmutable -> ShowS
$cshow :: PackageLocationImmutable -> [Char]
show :: PackageLocationImmutable -> [Char]
$cshowList :: [PackageLocationImmutable] -> ShowS
showList :: [PackageLocationImmutable] -> ShowS
Show, PackageLocationImmutable -> PackageLocationImmutable -> Bool
(PackageLocationImmutable -> PackageLocationImmutable -> Bool)
-> (PackageLocationImmutable -> PackageLocationImmutable -> Bool)
-> Eq PackageLocationImmutable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
== :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
$c/= :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
/= :: 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
$ccompare :: PackageLocationImmutable -> PackageLocationImmutable -> Ordering
compare :: PackageLocationImmutable -> PackageLocationImmutable -> Ordering
$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
>= :: PackageLocationImmutable -> PackageLocationImmutable -> Bool
$cmax :: PackageLocationImmutable
-> PackageLocationImmutable -> PackageLocationImmutable
max :: PackageLocationImmutable
-> PackageLocationImmutable -> PackageLocationImmutable
$cmin :: PackageLocationImmutable
-> PackageLocationImmutable -> PackageLocationImmutable
min :: PackageLocationImmutable
-> PackageLocationImmutable -> PackageLocationImmutable
Ord, Typeable)

instance NFData PackageLocationImmutable

instance Display PackageLocationImmutable where
  display :: PackageLocationImmutable -> Utf8Builder
display (PLIHackage PackageIdentifier
ident BlobKey
_cabalHash TreeKey
_tree) =
    [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
packageNameString (PackageName -> [Char]) -> PackageName -> [Char]
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

-- | Package identifier and revision with a specified cabal file hash

--

-- @since 0.1.0.0

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

-- | Convert `PackageLocationImmutable` to its "raw" equivalent

--

-- @since 0.1.0.0

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)

-- | A raw package archive, specified by a user, could have no

-- hash and file size information.

--

-- @since 0.1.0.0

data RawArchive = RawArchive
  { RawArchive -> ArchiveLocation
raLocation :: !ArchiveLocation
    -- ^ Location of the archive

    --

    -- @since 0.1.0.0

  , RawArchive -> Maybe SHA256
raHash :: !(Maybe SHA256)
    -- ^ Cryptographic hash of the archive file

    --

    -- @since 0.1.0.0

  , RawArchive -> Maybe FileSize
raSize :: !(Maybe FileSize)
    -- ^ Size of the archive file

    --

    -- @since 0.1.0.0

  , RawArchive -> Text
raSubdir :: !Text
    -- ^ Subdirectory within the archive to get the package from.

    --

    -- @since 0.1.0.0

  }
  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
$cfrom :: forall x. RawArchive -> Rep RawArchive x
from :: forall x. RawArchive -> Rep RawArchive x
$cto :: forall x. Rep RawArchive x -> RawArchive
to :: forall x. Rep RawArchive x -> RawArchive
Generic, Int -> RawArchive -> ShowS
[RawArchive] -> ShowS
RawArchive -> [Char]
(Int -> RawArchive -> ShowS)
-> (RawArchive -> [Char])
-> ([RawArchive] -> ShowS)
-> Show RawArchive
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawArchive -> ShowS
showsPrec :: Int -> RawArchive -> ShowS
$cshow :: RawArchive -> [Char]
show :: RawArchive -> [Char]
$cshowList :: [RawArchive] -> ShowS
showList :: [RawArchive] -> ShowS
Show, RawArchive -> RawArchive -> Bool
(RawArchive -> RawArchive -> Bool)
-> (RawArchive -> RawArchive -> Bool) -> Eq RawArchive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawArchive -> RawArchive -> Bool
== :: RawArchive -> RawArchive -> Bool
$c/= :: RawArchive -> RawArchive -> Bool
/= :: 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
$ccompare :: RawArchive -> RawArchive -> Ordering
compare :: RawArchive -> RawArchive -> Ordering
$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
>= :: RawArchive -> RawArchive -> Bool
$cmax :: RawArchive -> RawArchive -> RawArchive
max :: RawArchive -> RawArchive -> RawArchive
$cmin :: RawArchive -> RawArchive -> RawArchive
min :: RawArchive -> RawArchive -> RawArchive
Ord, Typeable)

instance NFData RawArchive

-- | A package archive, could be from a URL or a local file path. Local file

-- path archives are assumed to be unchanging over time, and so are allowed in

-- custom snapshots.

--

-- @since 0.1.0.0

data Archive = Archive
  { Archive -> ArchiveLocation
archiveLocation :: !ArchiveLocation
    -- ^ Location of the archive

    --

    -- @since 0.1.0.0

  , Archive -> SHA256
archiveHash :: !SHA256
    -- ^ Cryptographic hash of the archive file

    --

    -- @since 0.1.0.0

  , Archive -> FileSize
archiveSize :: !FileSize
    -- ^ Size of the archive file

    --

    -- @since 0.1.0.0

  , Archive -> Text
archiveSubdir :: !Text
    -- ^ Subdirectory within the archive to get the package from.

    --

    -- @since 0.1.0.0

  }
  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
$cfrom :: forall x. Archive -> Rep Archive x
from :: forall x. Archive -> Rep Archive x
$cto :: forall x. Rep Archive x -> Archive
to :: forall x. Rep Archive x -> Archive
Generic, Int -> Archive -> ShowS
[Archive] -> ShowS
Archive -> [Char]
(Int -> Archive -> ShowS)
-> (Archive -> [Char]) -> ([Archive] -> ShowS) -> Show Archive
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Archive -> ShowS
showsPrec :: Int -> Archive -> ShowS
$cshow :: Archive -> [Char]
show :: Archive -> [Char]
$cshowList :: [Archive] -> ShowS
showList :: [Archive] -> ShowS
Show, Archive -> Archive -> Bool
(Archive -> Archive -> Bool)
-> (Archive -> Archive -> Bool) -> Eq Archive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Archive -> Archive -> Bool
== :: Archive -> Archive -> Bool
$c/= :: Archive -> Archive -> Bool
/= :: 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
$ccompare :: Archive -> Archive -> Ordering
compare :: Archive -> Archive -> Ordering
$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
>= :: Archive -> Archive -> Bool
$cmax :: Archive -> Archive -> Archive
max :: Archive -> Archive -> Archive
$cmin :: Archive -> Archive -> Archive
min :: Archive -> Archive -> Archive
Ord, Typeable)

instance NFData Archive

-- | Convert archive to its "raw" equivalent.

--

-- @since 0.1.0.0

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)

-- | The type of a source control repository.

--

-- @since 0.1.0.0

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
$cfrom :: forall x. RepoType -> Rep RepoType x
from :: forall x. RepoType -> Rep RepoType x
$cto :: forall x. Rep RepoType x -> RepoType
to :: forall x. Rep RepoType x -> RepoType
Generic, Int -> RepoType -> ShowS
[RepoType] -> ShowS
RepoType -> [Char]
(Int -> RepoType -> ShowS)
-> (RepoType -> [Char]) -> ([RepoType] -> ShowS) -> Show RepoType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepoType -> ShowS
showsPrec :: Int -> RepoType -> ShowS
$cshow :: RepoType -> [Char]
show :: RepoType -> [Char]
$cshowList :: [RepoType] -> ShowS
showList :: [RepoType] -> ShowS
Show, RepoType -> RepoType -> Bool
(RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool) -> Eq RepoType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepoType -> RepoType -> Bool
== :: RepoType -> RepoType -> Bool
$c/= :: RepoType -> RepoType -> Bool
/= :: 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
$ccompare :: RepoType -> RepoType -> Ordering
compare :: RepoType -> RepoType -> Ordering
$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
>= :: RepoType -> RepoType -> Bool
$cmax :: RepoType -> RepoType -> RepoType
max :: RepoType -> RepoType -> RepoType
$cmin :: RepoType -> RepoType -> RepoType
min :: RepoType -> RepoType -> 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 a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoType
RepoGit
      Int32
2 -> RepoType -> Either Text RepoType
forall a. a -> Either Text a
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
$ [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid RepoType: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> [Char]
forall a. Show a => a -> [Char]
show Int32
i

instance PersistFieldSql RepoType where
  sqlType :: Proxy RepoType -> SqlType
sqlType Proxy RepoType
_ = SqlType
SqlInt32

-- | Information on packages stored in a source control repository.

--

-- @since 0.1.0.0

data Repo = Repo
  { Repo -> Text
repoUrl :: !Text
    -- ^ Location of the repo

    --

    -- @since 0.1.0.0

  , Repo -> Text
repoCommit :: !Text
    -- ^ Commit to use from the repo. It's strongly recommended to use

    -- a hash instead of a tag or branch name.

    --

    -- @since 0.1.0.0

  , Repo -> RepoType
repoType :: !RepoType
    -- ^ The type of the repo

    --

    -- @since 0.1.0.0

  , Repo -> Text
repoSubdir :: !Text
    -- ^ Subdirectory within the archive to get the package from.

    --

    -- @since 0.1.0.0

  }
  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
$cfrom :: forall x. Repo -> Rep Repo x
from :: forall x. Repo -> Rep Repo x
$cto :: forall x. Rep Repo x -> Repo
to :: forall x. Rep Repo x -> Repo
Generic, Repo -> Repo -> Bool
(Repo -> Repo -> Bool) -> (Repo -> Repo -> Bool) -> Eq Repo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Repo -> Repo -> Bool
== :: Repo -> Repo -> Bool
$c/= :: Repo -> Repo -> Bool
/= :: 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
$ccompare :: Repo -> Repo -> Ordering
compare :: Repo -> Repo -> Ordering
$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
>= :: Repo -> Repo -> Bool
$cmax :: Repo -> Repo -> Repo
max :: Repo -> Repo -> Repo
$cmin :: Repo -> Repo -> Repo
min :: Repo -> Repo -> Repo
Ord, Typeable)

instance NFData Repo

instance Show Repo where
  show :: Repo -> [Char]
show = Text -> [Char]
T.unpack (Text -> [Char]) -> (Repo -> Text) -> Repo -> [Char]
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)

rToSimpleRepo :: Repo -> SimpleRepo
rToSimpleRepo :: Repo -> SimpleRepo
rToSimpleRepo Repo {Text
RepoType
repoUrl :: Repo -> Text
repoCommit :: Repo -> Text
repoSubdir :: Repo -> Text
repoType :: Repo -> RepoType
repoUrl :: Text
repoCommit :: Text
repoType :: RepoType
repoSubdir :: Text
..} = SimpleRepo
  { sRepoUrl :: Text
sRepoUrl = Text
repoUrl
  , sRepoCommit :: Text
sRepoCommit = Text
repoCommit
  , sRepoType :: RepoType
sRepoType = RepoType
repoType
  }

data AggregateRepo = AggregateRepo
  { AggregateRepo -> SimpleRepo
aRepo :: !SimpleRepo
  , AggregateRepo -> [(Text, RawPackageMetadata)]
aRepoSubdirs :: [(Text, RawPackageMetadata)]
  }
  deriving (Int -> AggregateRepo -> ShowS
[AggregateRepo] -> ShowS
AggregateRepo -> [Char]
(Int -> AggregateRepo -> ShowS)
-> (AggregateRepo -> [Char])
-> ([AggregateRepo] -> ShowS)
-> Show AggregateRepo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AggregateRepo -> ShowS
showsPrec :: Int -> AggregateRepo -> ShowS
$cshow :: AggregateRepo -> [Char]
show :: AggregateRepo -> [Char]
$cshowList :: [AggregateRepo] -> ShowS
showList :: [AggregateRepo] -> ShowS
Show, (forall x. AggregateRepo -> Rep AggregateRepo x)
-> (forall x. Rep AggregateRepo x -> AggregateRepo)
-> Generic AggregateRepo
forall x. Rep AggregateRepo x -> AggregateRepo
forall x. AggregateRepo -> Rep AggregateRepo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AggregateRepo -> Rep AggregateRepo x
from :: forall x. AggregateRepo -> Rep AggregateRepo x
$cto :: forall x. Rep AggregateRepo x -> AggregateRepo
to :: forall x. Rep AggregateRepo x -> AggregateRepo
Generic, AggregateRepo -> AggregateRepo -> Bool
(AggregateRepo -> AggregateRepo -> Bool)
-> (AggregateRepo -> AggregateRepo -> Bool) -> Eq AggregateRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AggregateRepo -> AggregateRepo -> Bool
== :: AggregateRepo -> AggregateRepo -> Bool
$c/= :: AggregateRepo -> AggregateRepo -> Bool
/= :: AggregateRepo -> AggregateRepo -> Bool
Eq, Eq AggregateRepo
Eq AggregateRepo =>
(AggregateRepo -> AggregateRepo -> Ordering)
-> (AggregateRepo -> AggregateRepo -> Bool)
-> (AggregateRepo -> AggregateRepo -> Bool)
-> (AggregateRepo -> AggregateRepo -> Bool)
-> (AggregateRepo -> AggregateRepo -> Bool)
-> (AggregateRepo -> AggregateRepo -> AggregateRepo)
-> (AggregateRepo -> AggregateRepo -> AggregateRepo)
-> Ord AggregateRepo
AggregateRepo -> AggregateRepo -> Bool
AggregateRepo -> AggregateRepo -> Ordering
AggregateRepo -> AggregateRepo -> AggregateRepo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AggregateRepo -> AggregateRepo -> Ordering
compare :: AggregateRepo -> AggregateRepo -> Ordering
$c< :: AggregateRepo -> AggregateRepo -> Bool
< :: AggregateRepo -> AggregateRepo -> Bool
$c<= :: AggregateRepo -> AggregateRepo -> Bool
<= :: AggregateRepo -> AggregateRepo -> Bool
$c> :: AggregateRepo -> AggregateRepo -> Bool
> :: AggregateRepo -> AggregateRepo -> Bool
$c>= :: AggregateRepo -> AggregateRepo -> Bool
>= :: AggregateRepo -> AggregateRepo -> Bool
$cmax :: AggregateRepo -> AggregateRepo -> AggregateRepo
max :: AggregateRepo -> AggregateRepo -> AggregateRepo
$cmin :: AggregateRepo -> AggregateRepo -> AggregateRepo
min :: AggregateRepo -> AggregateRepo -> AggregateRepo
Ord, Typeable)

-- | Group input repositories by non-subdir values.

toAggregateRepos :: [(Repo, RawPackageMetadata)] -> [AggregateRepo]
toAggregateRepos :: [(Repo, RawPackageMetadata)] -> [AggregateRepo]
toAggregateRepos = ([(Repo, RawPackageMetadata)] -> Maybe AggregateRepo)
-> [[(Repo, RawPackageMetadata)]] -> [AggregateRepo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [(Repo, RawPackageMetadata)] -> Maybe AggregateRepo
toAggregateRepo ([[(Repo, RawPackageMetadata)]] -> [AggregateRepo])
-> ([(Repo, RawPackageMetadata)] -> [[(Repo, RawPackageMetadata)]])
-> [(Repo, RawPackageMetadata)]
-> [AggregateRepo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Repo, RawPackageMetadata) -> (Repo, RawPackageMetadata) -> Bool)
-> [(Repo, RawPackageMetadata)] -> [[(Repo, RawPackageMetadata)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Repo, RawPackageMetadata) -> (Repo, RawPackageMetadata) -> Bool
forall {b} {b}. (Repo, b) -> (Repo, b) -> Bool
matchRepoExclSubdir
 where
  toAggregateRepo :: [(Repo, RawPackageMetadata)] -> Maybe AggregateRepo
  toAggregateRepo :: [(Repo, RawPackageMetadata)] -> Maybe AggregateRepo
toAggregateRepo [] = Maybe AggregateRepo
forall a. Maybe a
Nothing
  toAggregateRepo xs :: [(Repo, RawPackageMetadata)]
xs@((Repo
repo, RawPackageMetadata
_):[(Repo, RawPackageMetadata)]
_) =
    AggregateRepo -> Maybe AggregateRepo
forall a. a -> Maybe a
Just (AggregateRepo -> Maybe AggregateRepo)
-> AggregateRepo -> Maybe AggregateRepo
forall a b. (a -> b) -> a -> b
$ SimpleRepo -> [(Text, RawPackageMetadata)] -> AggregateRepo
AggregateRepo (Repo -> SimpleRepo
rToSimpleRepo Repo
repo) (((Repo, RawPackageMetadata) -> (Text, RawPackageMetadata))
-> [(Repo, RawPackageMetadata)] -> [(Text, RawPackageMetadata)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Repo -> Text)
-> (Repo, RawPackageMetadata) -> (Text, RawPackageMetadata)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Repo -> Text
repoSubdir) [(Repo, RawPackageMetadata)]
xs)

  matchRepoExclSubdir :: (Repo, b) -> (Repo, b) -> Bool
matchRepoExclSubdir (Repo, b)
x1 (Repo, b)
x2 =
    let (Repo Text
url1 Text
commit1 RepoType
type1 Text
_, b
_) = (Repo, b)
x1
        (Repo Text
url2 Text
commit2 RepoType
type2 Text
_, b
_) = (Repo, b)
x2
    in  (Text
url1, Text
commit1, RepoType
type1) (Text, Text, RepoType) -> (Text, Text, RepoType) -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
url2, Text
commit2, RepoType
type2)

arToSimpleRepo :: AggregateRepo -> SimpleRepo
arToSimpleRepo :: AggregateRepo -> SimpleRepo
arToSimpleRepo AggregateRepo {[(Text, RawPackageMetadata)]
SimpleRepo
aRepo :: AggregateRepo -> SimpleRepo
aRepoSubdirs :: AggregateRepo -> [(Text, RawPackageMetadata)]
aRepo :: SimpleRepo
aRepoSubdirs :: [(Text, RawPackageMetadata)]
..} = SimpleRepo
aRepo

-- | Repository without subdirectory information.

--

-- @since 0.5.3

data SimpleRepo = SimpleRepo
  { SimpleRepo -> Text
sRepoUrl :: !Text
  , SimpleRepo -> Text
sRepoCommit :: !Text
  , SimpleRepo -> RepoType
sRepoType :: !RepoType
  }
  deriving (Int -> SimpleRepo -> ShowS
[SimpleRepo] -> ShowS
SimpleRepo -> [Char]
(Int -> SimpleRepo -> ShowS)
-> (SimpleRepo -> [Char])
-> ([SimpleRepo] -> ShowS)
-> Show SimpleRepo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimpleRepo -> ShowS
showsPrec :: Int -> SimpleRepo -> ShowS
$cshow :: SimpleRepo -> [Char]
show :: SimpleRepo -> [Char]
$cshowList :: [SimpleRepo] -> ShowS
showList :: [SimpleRepo] -> ShowS
Show, (forall x. SimpleRepo -> Rep SimpleRepo x)
-> (forall x. Rep SimpleRepo x -> SimpleRepo) -> Generic SimpleRepo
forall x. Rep SimpleRepo x -> SimpleRepo
forall x. SimpleRepo -> Rep SimpleRepo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SimpleRepo -> Rep SimpleRepo x
from :: forall x. SimpleRepo -> Rep SimpleRepo x
$cto :: forall x. Rep SimpleRepo x -> SimpleRepo
to :: forall x. Rep SimpleRepo x -> SimpleRepo
Generic, SimpleRepo -> SimpleRepo -> Bool
(SimpleRepo -> SimpleRepo -> Bool)
-> (SimpleRepo -> SimpleRepo -> Bool) -> Eq SimpleRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleRepo -> SimpleRepo -> Bool
== :: SimpleRepo -> SimpleRepo -> Bool
$c/= :: SimpleRepo -> SimpleRepo -> Bool
/= :: SimpleRepo -> SimpleRepo -> Bool
Eq, Eq SimpleRepo
Eq SimpleRepo =>
(SimpleRepo -> SimpleRepo -> Ordering)
-> (SimpleRepo -> SimpleRepo -> Bool)
-> (SimpleRepo -> SimpleRepo -> Bool)
-> (SimpleRepo -> SimpleRepo -> Bool)
-> (SimpleRepo -> SimpleRepo -> Bool)
-> (SimpleRepo -> SimpleRepo -> SimpleRepo)
-> (SimpleRepo -> SimpleRepo -> SimpleRepo)
-> Ord SimpleRepo
SimpleRepo -> SimpleRepo -> Bool
SimpleRepo -> SimpleRepo -> Ordering
SimpleRepo -> SimpleRepo -> SimpleRepo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SimpleRepo -> SimpleRepo -> Ordering
compare :: SimpleRepo -> SimpleRepo -> Ordering
$c< :: SimpleRepo -> SimpleRepo -> Bool
< :: SimpleRepo -> SimpleRepo -> Bool
$c<= :: SimpleRepo -> SimpleRepo -> Bool
<= :: SimpleRepo -> SimpleRepo -> Bool
$c> :: SimpleRepo -> SimpleRepo -> Bool
> :: SimpleRepo -> SimpleRepo -> Bool
$c>= :: SimpleRepo -> SimpleRepo -> Bool
>= :: SimpleRepo -> SimpleRepo -> Bool
$cmax :: SimpleRepo -> SimpleRepo -> SimpleRepo
max :: SimpleRepo -> SimpleRepo -> SimpleRepo
$cmin :: SimpleRepo -> SimpleRepo -> SimpleRepo
min :: SimpleRepo -> SimpleRepo -> SimpleRepo
Ord, Typeable)

instance Display SimpleRepo where
  display :: SimpleRepo -> Utf8Builder
display (SimpleRepo Text
url Text
commit RepoType
typ) =
    (case RepoType
typ of
       RepoType
RepoGit -> Utf8Builder
"Git"
       RepoType
RepoHg -> Utf8Builder
"Mercurial") 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

-- An unexported newtype wrapper to hang a 'FromJSON' instance off of. Contains

-- a GitHub user and repo name separated by a forward slash, e.g. "foo/bar".

newtype GitHubRepo = GitHubRepo Text

instance FromJSON GitHubRepo where
  parseJSON :: Value -> Parser GitHubRepo
parseJSON = [Char] -> (Text -> Parser GitHubRepo) -> Value -> Parser GitHubRepo
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> GitHubRepo
GitHubRepo Text
s)
      [Text]
_ -> [Char] -> Parser GitHubRepo
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expecting \"user/repo\""

-- | Configuration to securely download package metadata and contents. For most

-- purposes, you'll want to use the default Hackage settings via

-- @defaultPackageIndexConfig@.

--

-- /NOTE/ It's highly recommended to only use the official Hackage

-- server or a mirror. See

-- <https://github.com/commercialhaskell/stack/issues/4137>.

--

-- @since 0.6.0

data PackageIndexConfig = PackageIndexConfig
  { PackageIndexConfig -> Text
picDownloadPrefix :: !Text
  , PackageIndexConfig -> HackageSecurityConfig
picHackageSecurityConfig :: !HackageSecurityConfig
  }
  deriving Int -> PackageIndexConfig -> ShowS
[PackageIndexConfig] -> ShowS
PackageIndexConfig -> [Char]
(Int -> PackageIndexConfig -> ShowS)
-> (PackageIndexConfig -> [Char])
-> ([PackageIndexConfig] -> ShowS)
-> Show PackageIndexConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageIndexConfig -> ShowS
showsPrec :: Int -> PackageIndexConfig -> ShowS
$cshow :: PackageIndexConfig -> [Char]
show :: PackageIndexConfig -> [Char]
$cshowList :: [PackageIndexConfig] -> ShowS
showList :: [PackageIndexConfig] -> ShowS
Show

-- | If the @hackage-security@ key is absent from the JSON object, assigns

-- default value 'defaultHackageSecurityConfig'.

--

-- @since 0.6.0

instance FromJSON (WithJSONWarnings PackageIndexConfig) where
  parseJSON :: Value -> Parser (WithJSONWarnings PackageIndexConfig)
parseJSON = [Char]
-> (Object -> WarningParser PackageIndexConfig)
-> Value
-> Parser (WithJSONWarnings PackageIndexConfig)
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"PackageIndexConfig" ((Object -> WarningParser PackageIndexConfig)
 -> Value -> Parser (WithJSONWarnings PackageIndexConfig))
-> (Object -> WarningParser PackageIndexConfig)
-> Value
-> Parser (WithJSONWarnings PackageIndexConfig)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
picDownloadPrefix <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"download-prefix"
    HackageSecurityConfig
picHackageSecurityConfig <- WarningParser (WithJSONWarnings HackageSecurityConfig)
-> WarningParser HackageSecurityConfig
forall a. WarningParser (WithJSONWarnings a) -> WarningParser a
jsonSubWarnings (WarningParser (WithJSONWarnings HackageSecurityConfig)
 -> WarningParser HackageSecurityConfig)
-> WarningParser (WithJSONWarnings HackageSecurityConfig)
-> WarningParser HackageSecurityConfig
forall a b. (a -> b) -> a -> b
$
      Object
o Object
-> Text
-> WarningParser (Maybe (WithJSONWarnings HackageSecurityConfig))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"hackage-security" WarningParser (Maybe (WithJSONWarnings HackageSecurityConfig))
-> WithJSONWarnings HackageSecurityConfig
-> WarningParser (WithJSONWarnings HackageSecurityConfig)
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= HackageSecurityConfig -> WithJSONWarnings HackageSecurityConfig
forall a. a -> WithJSONWarnings a
noJSONWarnings HackageSecurityConfig
defaultHackageSecurityConfig
    PackageIndexConfig -> WarningParser PackageIndexConfig
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageIndexConfig {Text
HackageSecurityConfig
picDownloadPrefix :: Text
picHackageSecurityConfig :: HackageSecurityConfig
picDownloadPrefix :: Text
picHackageSecurityConfig :: HackageSecurityConfig
..}

-- | Default 'HackageSecurityConfig' value using the official Hackage server.

-- The value of the 'hscIgnoreExpiry' field is 'True'.

--

-- @since 0.7.0

defaultHackageSecurityConfig :: HackageSecurityConfig
defaultHackageSecurityConfig :: HackageSecurityConfig
defaultHackageSecurityConfig = HackageSecurityConfig
  { hscKeyIds :: [Text]
hscKeyIds =
      -- Key owners and public keys are provided as a convenience to readers.

      -- The canonical source for this mapping data is the hackage-root-keys

      -- repository and Hackage's root.json file.

      --

      -- Links:

      --  * https://github.com/haskell-infra/hackage-root-keys

      --  * https://hackage.haskell.org/root.json

      -- Please consult root.json on Hackage to map key IDs to public keys,

      -- and the hackage-root-keys repository to map public keys to their

      -- owners.

      [ -- Adam Gundry (uRPdSiL3/MNsk50z6NB55ABo0OrrNDXigtCul4vtzmw=)

        Text
"fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0"
      , -- Gershom Bazerman (bYoUXXQ9TtX10UriaMiQtTccuXPGnmldP68djzZ7cLo=)

        Text
"1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42"
      , -- John Wiegley (zazm5w480r+zPO6Z0+8fjGuxZtb9pAuoVmQ+VkuCvgU=)

        Text
"0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d"
      , -- Norman Ramsey (ZI8di3a9Un0s2RBrt5GwVRvfOXVuywADfXGPZfkiDb0=)

        Text
"51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921"
      , -- Mathieu Boespflug (ydN1nGGQ79K1Q0nN+ul+Ln8MxikTB95w0YdGd3v3kmg=)

        Text
"be75553f3c7ba1dbe298da81f1d1b05c9d39dd8ed2616c9bddf1525ca8c03e48"
      , -- Joachim Breitner (5iUgwqZCWrCJktqMx0bBMIuoIyT4A1RYGozzchRN9rA=)

        Text
"d26e46f3b631aae1433b89379a6c68bd417eb5d1c408f0643dcc07757fece522"
      ]
  , hscKeyThreshold :: Int
hscKeyThreshold = Int
3
  , hscIgnoreExpiry :: Bool
hscIgnoreExpiry = Bool
True
  }

-- | Configuration for Hackage Security to securely download package metadata

-- and contents. For most purposes, you'll want to use the default Hackage

-- settings via @defaultHackageSecurityConfig@.

--

-- /NOTE/ It's highly recommended to only use the official Hackage

-- server or a mirror. See

-- <https://github.com/commercialhaskell/stack/issues/4137>.

--

-- @since 0.6.0

data HackageSecurityConfig = HackageSecurityConfig
  { HackageSecurityConfig -> [Text]
hscKeyIds :: ![Text]
  , HackageSecurityConfig -> Int
hscKeyThreshold :: !Int
  , HackageSecurityConfig -> Bool
hscIgnoreExpiry :: !Bool
  }
  deriving Int -> HackageSecurityConfig -> ShowS
[HackageSecurityConfig] -> ShowS
HackageSecurityConfig -> [Char]
(Int -> HackageSecurityConfig -> ShowS)
-> (HackageSecurityConfig -> [Char])
-> ([HackageSecurityConfig] -> ShowS)
-> Show HackageSecurityConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HackageSecurityConfig -> ShowS
showsPrec :: Int -> HackageSecurityConfig -> ShowS
$cshow :: HackageSecurityConfig -> [Char]
show :: HackageSecurityConfig -> [Char]
$cshowList :: [HackageSecurityConfig] -> ShowS
showList :: [HackageSecurityConfig] -> ShowS
Show

-- | If the @ignore-expiry@ key is absent from the JSON object, assigns default

-- value 'True'.

--

-- @since 0.1.1.0

instance FromJSON (WithJSONWarnings HackageSecurityConfig) where
  parseJSON :: Value -> Parser (WithJSONWarnings HackageSecurityConfig)
parseJSON = [Char]
-> (Object -> WarningParser HackageSecurityConfig)
-> Value
-> Parser (WithJSONWarnings HackageSecurityConfig)
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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]
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 a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HackageSecurityConfig {Bool
Int
[Text]
hscIgnoreExpiry :: Bool
hscKeyIds :: [Text]
hscKeyThreshold :: Int
hscKeyIds :: [Text]
hscKeyThreshold :: Int
hscIgnoreExpiry :: Bool
..}

-- | An environment which contains a 'PantryConfig'.

--

-- @since 0.1.0.0

class HasPantryConfig env where
  -- | Lens to get or set the 'PantryConfig'

  --

  -- @since 0.1.0.0

  pantryConfigL :: Lens' env PantryConfig


-- | File size in bytes

--

-- @since 0.1.0.0

newtype FileSize = FileSize Word
  deriving ( Int -> FileSize -> ShowS
[FileSize] -> ShowS
FileSize -> [Char]
(Int -> FileSize -> ShowS)
-> (FileSize -> [Char]) -> ([FileSize] -> ShowS) -> Show FileSize
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileSize -> ShowS
showsPrec :: Int -> FileSize -> ShowS
$cshow :: FileSize -> [Char]
show :: FileSize -> [Char]
$cshowList :: [FileSize] -> ShowS
showList :: [FileSize] -> ShowS
Show, FileSize -> FileSize -> Bool
(FileSize -> FileSize -> Bool)
-> (FileSize -> FileSize -> Bool) -> Eq FileSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileSize -> FileSize -> Bool
== :: FileSize -> FileSize -> Bool
$c/= :: FileSize -> FileSize -> Bool
/= :: 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
$ccompare :: FileSize -> FileSize -> Ordering
compare :: FileSize -> FileSize -> Ordering
$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
>= :: FileSize -> FileSize -> Bool
$cmax :: FileSize -> FileSize -> FileSize
max :: FileSize -> FileSize -> FileSize
$cmin :: FileSize -> FileSize -> FileSize
min :: FileSize -> FileSize -> 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
$cfrom :: forall x. FileSize -> Rep FileSize x
from :: forall x. FileSize -> Rep FileSize x
$cto :: forall x. Rep FileSize x -> FileSize
to :: forall x. Rep FileSize x -> FileSize
Generic, FileSize -> Text
FileSize -> Utf8Builder
(FileSize -> Utf8Builder) -> (FileSize -> Text) -> Display FileSize
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
$cdisplay :: FileSize -> Utf8Builder
display :: FileSize -> Utf8Builder
$ctextDisplay :: FileSize -> Text
textDisplay :: FileSize -> Text
Display, Eq FileSize
Eq FileSize =>
(Int -> FileSize -> Int) -> (FileSize -> Int) -> Hashable FileSize
Int -> FileSize -> Int
FileSize -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> FileSize -> Int
hashWithSalt :: Int -> FileSize -> Int
$chash :: FileSize -> Int
hash :: FileSize -> Int
Hashable, FileSize -> ()
(FileSize -> ()) -> NFData FileSize
forall a. (a -> ()) -> NFData a
$crnf :: FileSize -> ()
rnf :: 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
$ctoPersistValue :: FileSize -> PersistValue
toPersistValue :: FileSize -> PersistValue
$cfromPersistValue :: PersistValue -> Either Text FileSize
fromPersistValue :: PersistValue -> Either Text FileSize
PersistField, PersistField FileSize
Proxy FileSize -> SqlType
PersistField FileSize =>
(Proxy FileSize -> SqlType) -> PersistFieldSql FileSize
forall a.
PersistField a =>
(Proxy a -> SqlType) -> PersistFieldSql a
$csqlType :: Proxy FileSize -> SqlType
sqlType :: Proxy FileSize -> SqlType
PersistFieldSql, [FileSize] -> Value
[FileSize] -> Encoding
FileSize -> Bool
FileSize -> Value
FileSize -> Encoding
(FileSize -> Value)
-> (FileSize -> Encoding)
-> ([FileSize] -> Value)
-> ([FileSize] -> Encoding)
-> (FileSize -> Bool)
-> ToJSON FileSize
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: FileSize -> Value
toJSON :: FileSize -> Value
$ctoEncoding :: FileSize -> Encoding
toEncoding :: FileSize -> Encoding
$ctoJSONList :: [FileSize] -> Value
toJSONList :: [FileSize] -> Value
$ctoEncodingList :: [FileSize] -> Encoding
toEncodingList :: [FileSize] -> Encoding
$comitField :: FileSize -> Bool
omitField :: FileSize -> Bool
ToJSON, Maybe FileSize
Value -> Parser [FileSize]
Value -> Parser FileSize
(Value -> Parser FileSize)
-> (Value -> Parser [FileSize])
-> Maybe FileSize
-> FromJSON FileSize
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser FileSize
parseJSON :: Value -> Parser FileSize
$cparseJSONList :: Value -> Parser [FileSize]
parseJSONList :: Value -> Parser [FileSize]
$comittedField :: Maybe FileSize
omittedField :: Maybe FileSize
FromJSON
           )

-- | A key for looking up a blob, which combines the SHA256 hash of the contents

-- and the file size.

--

-- The file size may seem redundant with the hash. However, it is necessary for

-- safely downloading blobs from an untrusted source. See

-- <https://www.fpcomplete.com/blog/2018/07/pantry-part-2-trees-keys>.

--

-- @since 0.1.0.0

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
$c== :: BlobKey -> BlobKey -> Bool
== :: BlobKey -> BlobKey -> Bool
$c/= :: BlobKey -> BlobKey -> Bool
/= :: 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
$ccompare :: BlobKey -> BlobKey -> Ordering
compare :: BlobKey -> BlobKey -> Ordering
$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
>= :: BlobKey -> BlobKey -> Bool
$cmax :: BlobKey -> BlobKey -> BlobKey
max :: BlobKey -> BlobKey -> BlobKey
$cmin :: BlobKey -> BlobKey -> BlobKey
min :: BlobKey -> BlobKey -> 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
$cfrom :: forall x. BlobKey -> Rep BlobKey x
from :: forall x. BlobKey -> Rep BlobKey x
$cto :: forall x. Rep BlobKey x -> BlobKey
to :: forall x. Rep BlobKey x -> BlobKey
Generic)

instance NFData BlobKey

instance Show BlobKey where
  show :: BlobKey -> [Char]
show = Text -> [Char]
T.unpack (Text -> [Char]) -> (BlobKey -> Text) -> BlobKey -> [Char]
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 -> [(AesonKey, Value)]
blobKeyPairs :: BlobKey -> [(AesonKey, Value)]
blobKeyPairs (BlobKey SHA256
sha FileSize
size') =
  [ AesonKey
"sha256" AesonKey -> SHA256 -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= SHA256
sha
  , AesonKey
"size" AesonKey -> FileSize -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= FileSize
size'
  ]

instance ToJSON BlobKey where
  toJSON :: BlobKey -> Value
toJSON = [(AesonKey, Value)] -> Value
object ([(AesonKey, Value)] -> Value)
-> (BlobKey -> [(AesonKey, Value)]) -> BlobKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlobKey -> [(AesonKey, Value)]
blobKeyPairs

instance FromJSON BlobKey where
  parseJSON :: Value -> Parser BlobKey
parseJSON = [Char] -> (Object -> Parser BlobKey) -> Value -> Parser BlobKey
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"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 a b. Parser (a -> b) -> Parser a -> Parser b
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
$c== :: PackageNameP -> PackageNameP -> Bool
== :: PackageNameP -> PackageNameP -> Bool
$c/= :: PackageNameP -> PackageNameP -> Bool
/= :: 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
$ccompare :: PackageNameP -> PackageNameP -> Ordering
compare :: PackageNameP -> PackageNameP -> Ordering
$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
>= :: PackageNameP -> PackageNameP -> Bool
$cmax :: PackageNameP -> PackageNameP -> PackageNameP
max :: PackageNameP -> PackageNameP -> PackageNameP
$cmin :: PackageNameP -> PackageNameP -> PackageNameP
min :: PackageNameP -> PackageNameP -> PackageNameP
Ord, Int -> PackageNameP -> ShowS
[PackageNameP] -> ShowS
PackageNameP -> [Char]
(Int -> PackageNameP -> ShowS)
-> (PackageNameP -> [Char])
-> ([PackageNameP] -> ShowS)
-> Show PackageNameP
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageNameP -> ShowS
showsPrec :: Int -> PackageNameP -> ShowS
$cshow :: PackageNameP -> [Char]
show :: PackageNameP -> [Char]
$cshowList :: [PackageNameP] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS PackageNameP
readsPrec :: Int -> ReadS PackageNameP
$creadList :: ReadS [PackageNameP]
readList :: ReadS [PackageNameP]
$creadPrec :: ReadPrec PackageNameP
readPrec :: ReadPrec PackageNameP
$creadListPrec :: ReadPrec [PackageNameP]
readListPrec :: ReadPrec [PackageNameP]
Read, PackageNameP -> ()
(PackageNameP -> ()) -> NFData PackageNameP
forall a. (a -> ()) -> NFData a
$crnf :: PackageNameP -> ()
rnf :: PackageNameP -> ()
NFData)

instance Display PackageNameP where
  display :: PackageNameP -> Utf8Builder
display = [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString ([Char] -> Utf8Builder)
-> (PackageNameP -> [Char]) -> PackageNameP -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> [Char]
packageNameString (PackageName -> [Char])
-> (PackageNameP -> PackageName) -> PackageNameP -> [Char]
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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PackageName -> [Char]
packageNameString PackageName
pn
  fromPersistValue :: PersistValue -> Either Text PackageNameP
fromPersistValue PersistValue
v = do
    [Char]
str <- PersistValue -> Either Text [Char]
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
    case [Char] -> Maybe PackageName
parsePackageName [Char]
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
<> [Char] -> Text
T.pack [Char]
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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PackageName -> [Char]
packageNameString PackageName
pn

instance FromJSON PackageNameP where
  parseJSON :: Value -> Parser PackageNameP
parseJSON =
    [Char]
-> (Text -> Parser PackageNameP) -> Value -> Parser PackageNameP
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"PackageNameP" ((Text -> Parser PackageNameP) -> Value -> Parser PackageNameP)
-> (Text -> Parser PackageNameP) -> Value -> Parser PackageNameP
forall a b. (a -> b) -> a -> b
$ PackageNameP -> Parser PackageNameP
forall a. a -> Parser a
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
. [Char] -> PackageName
mkPackageName ([Char] -> PackageName) -> (Text -> [Char]) -> Text -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

instance ToJSONKey PackageNameP where
  toJSONKey :: ToJSONKeyFunction PackageNameP
toJSONKey =
    (PackageNameP -> AesonKey)
-> (PackageNameP -> Encoding' AesonKey)
-> ToJSONKeyFunction PackageNameP
forall a.
(a -> AesonKey) -> (a -> Encoding' AesonKey) -> ToJSONKeyFunction a
ToJSONKeyText
      ([Char] -> AesonKey
forall a. IsString a => [Char] -> a
fromString ([Char] -> AesonKey)
-> (PackageNameP -> [Char]) -> PackageNameP -> AesonKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> [Char]
packageNameString (PackageName -> [Char])
-> (PackageNameP -> PackageName) -> PackageNameP -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageNameP -> PackageName
unPackageNameP)
      (Builder -> Encoding' AesonKey
forall a. Builder -> Encoding' a
unsafeToEncoding (Builder -> Encoding' AesonKey)
-> (PackageNameP -> Builder) -> PackageNameP -> Encoding' AesonKey
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
. [Char] -> PackageName
mkPackageName ([Char] -> PackageName) -> (Text -> [Char]) -> Text -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

newtype VersionP = VersionP { VersionP -> Version
unVersionP :: Version }
  deriving (VersionP -> VersionP -> Bool
(VersionP -> VersionP -> Bool)
-> (VersionP -> VersionP -> Bool) -> Eq VersionP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionP -> VersionP -> Bool
== :: VersionP -> VersionP -> Bool
$c/= :: VersionP -> VersionP -> Bool
/= :: 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
$ccompare :: VersionP -> VersionP -> Ordering
compare :: VersionP -> VersionP -> Ordering
$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
>= :: VersionP -> VersionP -> Bool
$cmax :: VersionP -> VersionP -> VersionP
max :: VersionP -> VersionP -> VersionP
$cmin :: VersionP -> VersionP -> VersionP
min :: VersionP -> VersionP -> VersionP
Ord, Int -> VersionP -> ShowS
[VersionP] -> ShowS
VersionP -> [Char]
(Int -> VersionP -> ShowS)
-> (VersionP -> [Char]) -> ([VersionP] -> ShowS) -> Show VersionP
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionP -> ShowS
showsPrec :: Int -> VersionP -> ShowS
$cshow :: VersionP -> [Char]
show :: VersionP -> [Char]
$cshowList :: [VersionP] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS VersionP
readsPrec :: Int -> ReadS VersionP
$creadList :: ReadS [VersionP]
readList :: ReadS [VersionP]
$creadPrec :: ReadPrec VersionP
readPrec :: ReadPrec VersionP
$creadListPrec :: ReadPrec [VersionP]
readListPrec :: ReadPrec [VersionP]
Read, VersionP -> ()
(VersionP -> ()) -> NFData VersionP
forall a. (a -> ()) -> NFData a
$crnf :: VersionP -> ()
rnf :: 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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Version -> [Char]
versionString Version
v
  fromPersistValue :: PersistValue -> Either Text VersionP
fromPersistValue PersistValue
v = do
    [Char]
str <- PersistValue -> Either Text [Char]
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
    case [Char] -> Maybe Version
parseVersion [Char]
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
<> [Char] -> Text
T.pack [Char]
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) = [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString ([Char] -> Utf8Builder) -> [Char] -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Version -> [Char]
versionString Version
v

instance ToJSON VersionP where
  toJSON :: VersionP -> Value
toJSON (VersionP Version
v) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Version -> [Char]
versionString Version
v

instance FromJSON VersionP where
  parseJSON :: Value -> Parser VersionP
parseJSON =
    [Char] -> (Text -> Parser VersionP) -> Value -> Parser VersionP
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"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 ([Char] -> Parser VersionP
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser VersionP)
-> (SomeException -> [Char]) -> SomeException -> Parser VersionP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException) (VersionP -> Parser VersionP
forall a. a -> Parser a
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
. [Char] -> Either SomeException Version
forall (m :: * -> *). MonadThrow m => [Char] -> m Version
parseVersionThrowing ([Char] -> Either SomeException Version)
-> (Text -> [Char]) -> Text -> Either SomeException Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

newtype ModuleNameP = ModuleNameP
  { ModuleNameP -> ModuleName
unModuleNameP :: ModuleName
  }
  deriving (ModuleNameP -> ModuleNameP -> Bool
(ModuleNameP -> ModuleNameP -> Bool)
-> (ModuleNameP -> ModuleNameP -> Bool) -> Eq ModuleNameP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleNameP -> ModuleNameP -> Bool
== :: ModuleNameP -> ModuleNameP -> Bool
$c/= :: ModuleNameP -> ModuleNameP -> Bool
/= :: 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
$ccompare :: ModuleNameP -> ModuleNameP -> Ordering
compare :: ModuleNameP -> ModuleNameP -> Ordering
$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
>= :: ModuleNameP -> ModuleNameP -> Bool
$cmax :: ModuleNameP -> ModuleNameP -> ModuleNameP
max :: ModuleNameP -> ModuleNameP -> ModuleNameP
$cmin :: ModuleNameP -> ModuleNameP -> ModuleNameP
min :: ModuleNameP -> ModuleNameP -> ModuleNameP
Ord, Int -> ModuleNameP -> ShowS
[ModuleNameP] -> ShowS
ModuleNameP -> [Char]
(Int -> ModuleNameP -> ShowS)
-> (ModuleNameP -> [Char])
-> ([ModuleNameP] -> ShowS)
-> Show ModuleNameP
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleNameP -> ShowS
showsPrec :: Int -> ModuleNameP -> ShowS
$cshow :: ModuleNameP -> [Char]
show :: ModuleNameP -> [Char]
$cshowList :: [ModuleNameP] -> ShowS
showList :: [ModuleNameP] -> ShowS
Show, ModuleNameP -> ()
(ModuleNameP -> ()) -> NFData ModuleNameP
forall a. (a -> ()) -> NFData a
$crnf :: ModuleNameP -> ()
rnf :: ModuleNameP -> ()
NFData)

instance Display ModuleNameP where
  display :: ModuleNameP -> Utf8Builder
display = [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString ([Char] -> Utf8Builder)
-> (ModuleNameP -> [Char]) -> ModuleNameP -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [Char]
moduleNameString (ModuleName -> [Char])
-> (ModuleNameP -> ModuleName) -> ModuleNameP -> [Char]
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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> [Char]
moduleNameString ModuleName
mn
  fromPersistValue :: PersistValue -> Either Text ModuleNameP
fromPersistValue PersistValue
v = do
    [Char]
str <- PersistValue -> Either Text [Char]
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
    case [Char] -> Maybe ModuleName
parseModuleName [Char]
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
<> [Char] -> Text
T.pack [Char]
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

-- | How to choose a cabal file for a package from Hackage. This is to work with

-- Hackage cabal file revisions, which makes @PackageIdentifier@ insufficient

-- for specifying a package from Hackage.

--

-- @since 0.1.0.0

data CabalFileInfo
  = CFILatest
    -- ^ Take the latest revision of the cabal file available. This

    -- isn't reproducible at all, but the running assumption (not

    -- necessarily true) is that cabal file revisions do not change

    -- semantics of the build.

    --

    -- @since 0.1.0.0

  | CFIHash !SHA256 !(Maybe FileSize)
    -- ^ Identify by contents of the cabal file itself. Only reason for

    -- @Maybe@ on @FileSize@ is for compatibility with input that

    -- doesn't include the file size.

    --

    -- @since 0.1.0.0

  | CFIRevision !Revision
    -- ^ Identify by revision number, with 0 being the original and

    -- counting upward. This relies on Hackage providing consistent

    -- versioning. @CFIHash@ should be preferred wherever possible for

    -- reproducibility.

    --

    -- @since 0.1.0.0

  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
$cfrom :: forall x. CabalFileInfo -> Rep CabalFileInfo x
from :: forall x. CabalFileInfo -> Rep CabalFileInfo x
$cto :: forall x. Rep CabalFileInfo x -> CabalFileInfo
to :: forall x. Rep CabalFileInfo x -> CabalFileInfo
Generic, Int -> CabalFileInfo -> ShowS
[CabalFileInfo] -> ShowS
CabalFileInfo -> [Char]
(Int -> CabalFileInfo -> ShowS)
-> (CabalFileInfo -> [Char])
-> ([CabalFileInfo] -> ShowS)
-> Show CabalFileInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CabalFileInfo -> ShowS
showsPrec :: Int -> CabalFileInfo -> ShowS
$cshow :: CabalFileInfo -> [Char]
show :: CabalFileInfo -> [Char]
$cshowList :: [CabalFileInfo] -> ShowS
showList :: [CabalFileInfo] -> ShowS
Show, CabalFileInfo -> CabalFileInfo -> Bool
(CabalFileInfo -> CabalFileInfo -> Bool)
-> (CabalFileInfo -> CabalFileInfo -> Bool) -> Eq CabalFileInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CabalFileInfo -> CabalFileInfo -> Bool
== :: CabalFileInfo -> CabalFileInfo -> Bool
$c/= :: CabalFileInfo -> CabalFileInfo -> Bool
/= :: 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
$ccompare :: CabalFileInfo -> CabalFileInfo -> Ordering
compare :: CabalFileInfo -> CabalFileInfo -> Ordering
$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
>= :: CabalFileInfo -> CabalFileInfo -> Bool
$cmax :: CabalFileInfo -> CabalFileInfo -> CabalFileInfo
max :: CabalFileInfo -> CabalFileInfo -> CabalFileInfo
$cmin :: CabalFileInfo -> CabalFileInfo -> CabalFileInfo
min :: CabalFileInfo -> CabalFileInfo -> 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

-- | A full specification for a package from Hackage, including the package

-- name, version, and how to load up the correct cabal file revision.

--

-- @since 0.1.0.0

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
$cfrom :: forall x.
PackageIdentifierRevision -> Rep PackageIdentifierRevision x
from :: forall x.
PackageIdentifierRevision -> Rep PackageIdentifierRevision x
$cto :: forall x.
Rep PackageIdentifierRevision x -> PackageIdentifierRevision
to :: forall x.
Rep PackageIdentifierRevision x -> PackageIdentifierRevision
Generic, PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
(PackageIdentifierRevision -> PackageIdentifierRevision -> Bool)
-> (PackageIdentifierRevision -> PackageIdentifierRevision -> Bool)
-> Eq PackageIdentifierRevision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
== :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
$c/= :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
/= :: 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
$ccompare :: PackageIdentifierRevision -> PackageIdentifierRevision -> Ordering
compare :: PackageIdentifierRevision -> PackageIdentifierRevision -> Ordering
$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
>= :: PackageIdentifierRevision -> PackageIdentifierRevision -> Bool
$cmax :: PackageIdentifierRevision
-> PackageIdentifierRevision -> PackageIdentifierRevision
max :: PackageIdentifierRevision
-> PackageIdentifierRevision -> PackageIdentifierRevision
$cmin :: PackageIdentifierRevision
-> PackageIdentifierRevision -> PackageIdentifierRevision
min :: PackageIdentifierRevision
-> PackageIdentifierRevision -> PackageIdentifierRevision
Ord, Typeable)

instance NFData PackageIdentifierRevision

instance Show PackageIdentifierRevision where
  show :: PackageIdentifierRevision -> [Char]
show = Text -> [Char]
T.unpack (Text -> [Char])
-> (PackageIdentifierRevision -> Text)
-> PackageIdentifierRevision
-> [Char]
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) =
       [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
packageNameString PackageName
name)
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"-"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
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 = [Char]
-> (Text -> Parser PackageIdentifierRevision)
-> Value
-> Parser PackageIdentifierRevision
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"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 -> [Char] -> Parser PackageIdentifierRevision
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser PackageIdentifierRevision)
-> [Char] -> Parser PackageIdentifierRevision
forall a b. (a -> b) -> a -> b
$ PantryException -> [Char]
forall a. Show a => a -> [Char]
show PantryException
e
      Right PackageIdentifierRevision
pir -> PackageIdentifierRevision -> Parser PackageIdentifierRevision
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageIdentifierRevision
pir

-- | Parse a hackage text.

--

-- @since 0.1.0.0

parseHackageText :: Text -> Either PantryException (PackageIdentifier, BlobKey)
parseHackageText :: Text -> Either PantryException (PackageIdentifier, BlobKey)
parseHackageText Text
t =
  ([Char] -> Either PantryException (PackageIdentifier, BlobKey))
-> ((PackageIdentifier, BlobKey)
    -> Either PantryException (PackageIdentifier, BlobKey))
-> Either [Char] (PackageIdentifier, BlobKey)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\[Char]
x -> [Char]
-> (Any -> Either PantryException Any)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a. HasCallStack => [Char] -> a
error (ShowS
forall a. Show a => a -> [Char]
show [Char]
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 [Char] (PackageIdentifier, BlobKey)
 -> Either PantryException (PackageIdentifier, BlobKey))
-> Either [Char] (PackageIdentifier, BlobKey)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a b. (a -> b) -> a -> b
$
  ParsecParser (PackageIdentifier, BlobKey)
-> [Char] -> Either [Char] (PackageIdentifier, BlobKey)
forall a. ParsecParser a -> [Char] -> Either [Char] a
explicitEitherParsec (ParsecParser (PackageIdentifier, BlobKey)
hackageTextParsec ParsecParser (PackageIdentifier, BlobKey)
-> ParsecParser () -> ParsecParser (PackageIdentifier, BlobKey)
forall a b. ParsecParser a -> ParsecParser b -> ParsecParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecParser ()
forall (m :: * -> *). Parsing m => m ()
Parse.eof) ([Char] -> Either [Char] (PackageIdentifier, BlobKey))
-> [Char] -> Either [Char] (PackageIdentifier, BlobKey)
forall a b. (a -> b) -> a -> b
$
  Text -> [Char]
T.unpack Text
t

hackageTextParsec :: ParsecParser (PackageIdentifier, BlobKey)
hackageTextParsec :: ParsecParser (PackageIdentifier, BlobKey)
hackageTextParsec = do
  PackageIdentifier
ident <- ParsecParser PackageIdentifier
packageIdentifierParsec
  [Char]
_ <- [Char] -> ParsecParser [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
Parse.string [Char]
"@sha256:"

  [Char]
shaT <- (Char -> Bool) -> ParsecParser [Char]
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m [Char]
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 a. ParsecParser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero) SHA256 -> ParsecParser SHA256
forall a. a -> ParsecParser a
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
$ [Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
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 -- FIXME probably need to handle overflow, since unfortunately Cabal doesn't

  (PackageIdentifier, BlobKey)
-> ParsecParser (PackageIdentifier, BlobKey)
forall a. a -> ParsecParser a
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

-- | Parse a 'PackageIdentifierRevision'

--

-- @since 0.1.0.0

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 <- [Char] -> Maybe PackageIdentifier
parsePackageIdentifier ([Char] -> Maybe PackageIdentifier)
-> [Char] -> Maybe PackageIdentifier
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
identT
    CabalFileInfo
cfi <-
      case Text -> Maybe (Text, Text)
splitColon Text
cfiT of
        Just (Text
"@sha256", Text
shaSizeT) -> do
          let (Text
shaT, Text
sizeT) = (Char -> Bool) -> Text -> (Text, Text)
T.break (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 [Char] (Word, Text)
_ -> Maybe (Maybe FileSize)
forall a. Maybe a
Nothing
          CabalFileInfo -> Maybe CabalFileInfo
forall a. a -> Maybe a
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 a. a -> Maybe a
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 [Char] (Word, Text)
_ -> Maybe CabalFileInfo
forall a. Maybe a
Nothing
        Maybe (Text, Text)
Nothing -> CabalFileInfo -> Maybe CabalFileInfo
forall a. a -> Maybe a
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 a. a -> Maybe a
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
  { forall a. Mismatch a -> a
mismatchExpected :: !a
  , forall a. Mismatch a -> a
mismatchActual :: !a
  }

-- | Things that can go wrong in pantry. Note two things:

--

-- * Many other exception types may be thrown from underlying libraries. Pantry

--   does not attempt to wrap these underlying exceptions.

--

-- * We may add more constructors to this data type in minor version bumps of

--   pantry. This technically breaks the PVP. You should not be writing pattern

--   matches against this type that expect total matching.

--

-- @since 0.1.0.0

data PantryException
  = PackageIdentifierRevisionParseFail !Text
  | InvalidCabalFile
      !(Either RawPackageLocationImmutable (Path Abs File))
      !(Maybe Version)
      ![PError]
      ![PWarning]
  | TreeWithoutCabalFile !RawPackageLocationImmutable
  | TreeWithMultipleCabalFiles !RawPackageLocationImmutable ![SafeFilePath]
  | MismatchedCabalName !(Path Abs File) !PackageName
  | NoLocalPackageDirFound !(Path Abs Dir)
  | NoCabalFileFound !(Path Abs Dir)
  | MultipleCabalFilesFound !(Path Abs Dir) ![Path Abs File]
  | InvalidWantedCompiler !Text
  | InvalidSnapshotLocation !(Path Abs Dir) !Text
  | InvalidOverrideCompiler !WantedCompiler !WantedCompiler
  | InvalidFilePathSnapshot !Text
  | InvalidSnapshot !RawSnapshotLocation !SomeException
  | InvalidGlobalHintsLocation !(Path Abs Dir) !Text
  | InvalidFilePathGlobalHints !Text
  | 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)
  -- ^ Different from 'DownloadInvalidSize' since 'mismatchActual' is

  -- a lower bound on the size from the server.

  | LocalNoArchiveFileFound !(Path Abs File)
  | LocalInvalidSHA256 !(Path Abs File) !(Mismatch SHA256)
  | LocalInvalidSize !(Path Abs File) !(Mismatch FileSize)
  | UnknownArchiveType !ArchiveLocation
  | InvalidTarFileType !ArchiveLocation !FilePath !Tar.FileType
  | UnsupportedTarball !ArchiveLocation !Text
  | NoHackageCryptographicHash !PackageIdentifier
  | FailedToCloneRepo !SimpleRepo
  | TreeReferencesMissingBlob !RawPackageLocationImmutable !SafeFilePath !BlobKey
  | CompletePackageMetadataMismatch !RawPackageLocationImmutable !PackageMetadata
  | CRC32Mismatch !ArchiveLocation !FilePath !(Mismatch Word32)
  | UnknownHackagePackage !PackageIdentifierRevision !FuzzyResults
  | CannotCompleteRepoNonSHA1 !Repo
  | MutablePackageLocationFromUrl !Text
  | MismatchedCabalFileForHackage !PackageIdentifierRevision !(Mismatch PackageIdentifier)
  | PackageNameParseFail !Text
  | PackageVersionParseFail !Text
  | InvalidCabalFilePath !(Path Abs File)
  | DuplicatePackageNames !Utf8Builder ![(PackageName, [RawPackageLocationImmutable])]
  | MigrationFailure !Text !(Path Abs File) !SomeException
  | NoCasaConfig
  | InvalidTreeFromCasa !BlobKey !ByteString
  | ParseSnapNameException !Text
  | HpackLibraryException !(Path Abs File) !String
  | HpackExeException !FilePath !(Path Abs Dir) !SomeException
  deriving Typeable

instance Exception PantryException where

instance Show PantryException where
  show :: PantryException -> [Char]
show = Text -> [Char]
T.unpack (Text -> [Char])
-> (PantryException -> Text) -> PantryException -> [Char]
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

-- To support the Haskell Foundation's

-- [Haskell Error Index](https://errors.haskell.org/) initiative, all Pantry

-- error messages generated by Pantry itself begin with an unique code in the

-- form `[S-nnn]`, where `nnn` is a three-digit number in the range 100 to 999.

-- The numbers are selected at random, not in sequence.

--

-- Prettier versions of these error messages are also provided. See the instance

-- of Pretty.

instance Display PantryException where
  display :: PantryException -> Utf8Builder
display PantryException
NoCasaConfig =
    Utf8Builder
"Error: [S-889]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"The Pantry configuration has no Casa configuration."
  display (InvalidTreeFromCasa BlobKey
blobKey ByteString
_bs) =
    Utf8Builder
"Error: [S-258]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
"Error: [S-360]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
"Error: [S-242]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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 ([Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString ([Char] -> Utf8Builder)
-> (Path Abs File -> [Char]) -> Path Abs File -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> [Char]
forall b t. Path b t -> [Char]
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 m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
         ( \(PError Position
pos [Char]
msg) ->
                 Utf8Builder
"- "
              Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Position -> [Char]
showPos Position
pos)
              Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
              Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString [Char]
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 m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
         ( \(PWarning PWarnType
_ Position
pos [Char]
msg) ->
                 Utf8Builder
"- "
              Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Position -> [Char]
showPos Position
pos)
              Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
              Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString [Char]
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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
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
"Error: [S-654]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
"Error: [S-500]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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 m. Monoid m => [m] -> m
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
"Error: [S-910]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"The Cabal file:\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs File
fp)
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nis not named after the package that 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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
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
"Hackage rejects packages where the first part of the Cabal file name "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"is not the package name."
  display (NoLocalPackageDirFound Path Abs Dir
dir) =
    Utf8Builder
"Error: [S-395]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Stack looks for packages in the directories configured in the\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"'packages' and 'extra-deps' fields defined in its project-level\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"configuration file (usually 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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
dir)
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
",\nbut no such directory could be found. If, alternatively, a package\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"in the package index was intended, its name and version must be\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"specified as an extra-dep."
  display (NoCabalFileFound Path Abs Dir
dir) =
    Utf8Builder
"Error: [S-636]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Stack looks for packages in the directories configured in the\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"'packages' and 'extra-deps' fields defined in its project-level\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"configuration file (usually 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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
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
"Error: [S-368]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Multiple .cabal files found in directory "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
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 m. Monoid m => [m] -> m
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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Rel File -> [Char]
forall b t. Path b t -> [Char]
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
"Error: [S-204]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
"Error: [S-935]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
<> [Char] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow (Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
dir)
  display (InvalidOverrideCompiler WantedCompiler
x WantedCompiler
y) =
    Utf8Builder
"Error: [S-287]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Specified compiler for a snapshot ("
    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
"Error: [S-617]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
err) =
    Utf8Builder
"Error: [S-775]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
err
  display (InvalidGlobalHintsLocation Path Abs Dir
dir Text
t) =
    Utf8Builder
"Error: [S-926]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Invalid global hints 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
<> [Char] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow (Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
dir)
  display (InvalidFilePathGlobalHints Text
t) =
    Utf8Builder
"Error: [S-832]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Specified global hints 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 (MismatchedPackageMetadata RawPackageLocationImmutable
loc RawPackageMetadata
pm Maybe TreeKey
mtreeKey PackageIdentifier
foundIdent) =
    Utf8Builder
"Error: [S-427]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
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
"Error: [S-571]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: BlobKey
mismatchActual :: BlobKey
..}) =
    Utf8Builder
"Error: [S-236]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> 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 [Char]
err) =
    Utf8Builder
"Error: [S-645]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString [Char]
err
  display (WrongCabalFileName RawPackageLocationImmutable
pl SafeFilePath
sfp PackageName
name) =
    Utf8Builder
"Error: [S-575]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
"\nThe cabal 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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
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
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: SHA256
mismatchActual :: SHA256
..}) =
    Utf8Builder
"Error: [S-394]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> 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
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: FileSize
mismatchActual :: FileSize
..}) =
    Utf8Builder
"Error: [S-401]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> 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
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: FileSize
mismatchActual :: FileSize
..}) =
    Utf8Builder
"Error: [S-113]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> 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 (LocalNoArchiveFileFound Path Abs File
path) =
    Utf8Builder
"Error: [S-628]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Stack looks for packages in the archive files configured in the\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"'extra-deps' field defined in its project-level configuration file\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"(usually stack.yaml)\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"An entry points to "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs File
path)
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
",\nbut no such archive file could be found."
  display (LocalInvalidSHA256 Path Abs File
path Mismatch {SHA256
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: SHA256
mismatchActual :: SHA256
..}) =
    Utf8Builder
"Error: [S-834]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Mismatched SHA256 hash from "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Abs File -> [Char]
forall b t. Path b t -> [Char]
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
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: FileSize
mismatchActual :: FileSize
..}) =
    Utf8Builder
"Error: [S-713]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Mismatched file size from "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Abs File -> [Char]
forall b t. Path b t -> [Char]
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
"Error: [S-372]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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 [Char]
fp FileType
x) =
    Utf8Builder
"Error: [S-950]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Unsupported tar file type 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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString [Char]
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
err) =
    Utf8Builder
"Error: [S-760]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
err
  display (NoHackageCryptographicHash PackageIdentifier
ident) =
    Utf8Builder
"Error: [S-922]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"No cryptographic hash found for Hackage package "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
ident)
  display (FailedToCloneRepo SimpleRepo
repo) =
    Utf8Builder
"Error: [S-109]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Failed to clone repo "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SimpleRepo -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SimpleRepo
repo
  display (TreeReferencesMissingBlob RawPackageLocationImmutable
loc SafeFilePath
sfp BlobKey
key) =
    Utf8Builder
"Error: [S-237]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
"Error: [S-984]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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 [Char]
fp Mismatch {Word32
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: Word32
mismatchActual :: Word32
..}) =
    Utf8Builder
"Error: [S-607]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> 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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString [Char]
fp
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\nExpected: "
    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
"\nActual:   "
    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
"Error: [S-476]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
"Error: [S-112]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
"Error: [S-321]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: PackageIdentifier
mismatchActual :: PackageIdentifier
..}) =
    Utf8Builder
"Error: [S-377]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> 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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
mismatchActual)
  display (PackageNameParseFail Text
t) =
    Utf8Builder
"Error: [S-580]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
"Error: [S-479]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
"Error: [S-824]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"File path contains a name which is not a valid package name: "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs File
fp)
  display (DuplicatePackageNames Utf8Builder
source [(PackageName, [RawPackageLocationImmutable])]
pairs') =
    Utf8Builder
"Error: [S-674]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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 m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
         ( \(PackageName
name, [RawPackageLocationImmutable]
locs) ->
                [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
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 m a. Monoid m => (a -> m) -> [a] -> m
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
err) =
    Utf8Builder
"Error: [S-536]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Encountered error while migrating database "
    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
"\nlocated at "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs File
fp)
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
":"
    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
err
  display (ParseSnapNameException Text
t) =
    Utf8Builder
"Error: [S-994]\n"
     Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> 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
  display (HpackLibraryException Path Abs File
file [Char]
err) =
    Utf8Builder
"Error: [S-305]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Failed to generate a Cabal file using the Hpack library on file:\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs File
file)
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\n\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"The error encountered was:\n\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString [Char]
err
  display (HpackExeException [Char]
fp Path Abs Dir
dir SomeException
err) =
    Utf8Builder
"Error: [S-720]\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Failed to generate a Cabal file using the Hpack executable:\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString [Char]
fp
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"in directory: "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Path Abs Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs Dir
dir)
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\n\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"The error encountered was:\n\n"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
err)

-- See also the instance of Display. Although prettier, these messages are

-- intended to be substantively the same as the corresponding 'black and white'

-- versions.

instance Pretty PantryException where
  pretty :: PantryException -> StyleDoc
pretty PantryException
NoCasaConfig =
    StyleDoc
"[S-889]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
flow [Char]
"The Pantry configuration has no Casa configuration."
  pretty (InvalidTreeFromCasa BlobKey
blobKey ByteString
_bs) =
    StyleDoc
"[S-258]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Invalid tree from casa:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ BlobKey -> Text
forall a. Display a => a -> Text
textDisplay BlobKey
blobKey
         ]
  pretty (PackageIdentifierRevisionParseFail Text
text) =
    StyleDoc
"[S-360]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Invalid package identifier (with optional revision):"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
text
         ]
  pretty (InvalidCabalFile Either RawPackageLocationImmutable (Path Abs File)
loc Maybe Version
mversion [PError]
errs [PWarning]
warnings) =
    StyleDoc
"[S-242]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Unable to parse Cabal file from package"
         , (RawPackageLocationImmutable -> StyleDoc)
-> (Path Abs File -> StyleDoc)
-> Either RawPackageLocationImmutable (Path Abs File)
-> StyleDoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RawPackageLocationImmutable -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Either RawPackageLocationImmutable (Path Abs File)
loc StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList
         ( (PError -> StyleDoc) -> [PError] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\(PError Position
pos [Char]
msg) -> [StyleDoc] -> StyleDoc
fillSep
             [ [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString (Position -> [Char]
showPos Position
pos) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
             , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString [Char]
msg
             ])
             [PError]
errs
         )
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList
         ( (PWarning -> StyleDoc) -> [PWarning] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\(PWarning PWarnType
_ Position
pos [Char]
msg) -> [StyleDoc] -> StyleDoc
fillSep
             [ [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString (Position -> [Char]
showPos Position
pos) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
             , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString [Char]
msg
             ])
             [PWarning]
warnings
         )
    StyleDoc -> StyleDoc -> StyleDoc
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 ->
                StyleDoc
line
             StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
                  [ [Char] -> StyleDoc
flow [Char]
"The Cabal file uses the Cabal specification version"
                  , Style -> StyleDoc -> StyleDoc
style Style
Current ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Version -> [Char]
versionString Version
version) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
                  , [Char] -> StyleDoc
flow [Char]
"but we only support up to version"
                  , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
cabalSpecLatestVersion) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
                  , [Char] -> StyleDoc
flow [Char]
"Recommended action: upgrade your build tool"
                  , StyleDoc -> StyleDoc
parens ([StyleDoc] -> StyleDoc
fillSep
                      [ StyleDoc
"e.g."
                      , Style -> StyleDoc -> StyleDoc
style Style
Shell ([Char] -> StyleDoc
flow [Char]
"stack upgrade")
                      ]) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
                  ]
           Maybe Version
_ -> StyleDoc
forall a. Monoid a => a
mempty
       )
  pretty (TreeWithoutCabalFile RawPackageLocationImmutable
loc) =
    StyleDoc
"[S-654]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"No Cabal file found for"
         , RawPackageLocationImmutable -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty RawPackageLocationImmutable
loc StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
  pretty (TreeWithMultipleCabalFiles RawPackageLocationImmutable
loc [SafeFilePath]
sfps) =
    StyleDoc
"[S-500]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         ( [Char] -> StyleDoc
flow [Char]
"Multiple Cabal files found for"
         StyleDoc -> [StyleDoc] -> [StyleDoc]
forall a. a -> [a] -> [a]
: (RawPackageLocationImmutable -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty RawPackageLocationImmutable
loc StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":")
         StyleDoc -> [StyleDoc] -> [StyleDoc]
forall a. a -> [a] -> [a]
: Maybe Style -> Bool -> [StyleDoc] -> [StyleDoc]
forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
File) Bool
False
             ((SafeFilePath -> StyleDoc) -> [SafeFilePath] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc)
-> (SafeFilePath -> [Char]) -> SafeFilePath -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> [Char])
-> (SafeFilePath -> Text) -> SafeFilePath -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeFilePath -> Text
forall a. Display a => a -> Text
textDisplay) [SafeFilePath]
sfps :: [StyleDoc])
         )
  pretty (MismatchedCabalName Path Abs File
fp PackageName
name) =
    StyleDoc
"[S-910]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"The Cabal file"
         , Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
fp
         , [Char] -> StyleDoc
flow [Char]
"is not named after the package that it defines. Please rename"
         , [Char] -> StyleDoc
flow [Char]
"the file to"
         , Style -> StyleDoc -> StyleDoc
style Style
File ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ PackageName -> [Char]
packageNameString PackageName
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
".cabal") StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         , [Char] -> StyleDoc
flow [Char]
"Hackage rejects packages where the first part of the Cabal"
         , [Char] -> StyleDoc
flow [Char]
"file name is not the package name."
         ]
  pretty (NoLocalPackageDirFound Path Abs Dir
dir) =
    StyleDoc
"[S-395]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Stack looks for packages in the directories configured in the"
         , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"packages"
         , StyleDoc
"and"
         , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"extra-deps"
         , [Char] -> StyleDoc
flow [Char]
"fields defined in its project-level configuration file"
         , StyleDoc -> StyleDoc
parens ([StyleDoc] -> StyleDoc
fillSep [StyleDoc
"usually", Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"stack.yaml"]) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         , [Char] -> StyleDoc
flow [Char]
"The current entry points to"
         , Path Abs Dir -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
dir
         , [Char] -> StyleDoc
flow [Char]
"but no such directory could be found. If, alternatively, a"
         , [Char] -> StyleDoc
flow [Char]
"package in the package index was intended, its name and"
         , [Char] -> StyleDoc
flow [Char]
"version must be specified as an extra-dep."
         ]
  pretty (NoCabalFileFound Path Abs Dir
dir) =
    StyleDoc
"[S-636]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Stack looks for packages in the directories configured in the"
         , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"packages"
         , StyleDoc
"and"
         , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"extra-deps"
         , [Char] -> StyleDoc
flow [Char]
"fields defined in its project-level configuration file"
         , StyleDoc -> StyleDoc
parens ([StyleDoc] -> StyleDoc
fillSep [StyleDoc
"usually", Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"stack.yaml"]) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         , [Char] -> StyleDoc
flow [Char]
"The current entry points to"
         , Path Abs Dir -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
dir
         , [Char] -> StyleDoc
flow [Char]
"but no Cabal file or"
         , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"package.yaml"
         , [Char] -> StyleDoc
flow [Char]
"could be found there."
         ]
  pretty (MultipleCabalFilesFound Path Abs Dir
dir [Path Abs File]
files) =
    StyleDoc
"[S-368]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         ( [Char] -> StyleDoc
flow [Char]
"Multiple Cabal files found in directory"
         StyleDoc -> [StyleDoc] -> [StyleDoc]
forall a. a -> [a] -> [a]
: (Path Abs Dir -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
dir StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":")
         StyleDoc -> [StyleDoc] -> [StyleDoc]
forall a. a -> [a] -> [a]
: Maybe Style -> Bool -> [StyleDoc] -> [StyleDoc]
forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
File) Bool
False
             ((Path Abs File -> StyleDoc) -> [Path Abs File] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty (Path Rel File -> StyleDoc)
-> (Path Abs File -> Path Rel File) -> Path Abs File -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename) [Path Abs File]
files)
         )
  pretty (InvalidWantedCompiler Text
t) =
    StyleDoc
"[S-204]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Invalid wanted compiler:"
         , Style -> StyleDoc -> StyleDoc
style Style
Current ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
  pretty (InvalidSnapshotLocation Path Abs Dir
dir Text
t) =
    StyleDoc
"[S-935]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Invalid snapshot location"
         , Style -> StyleDoc -> StyleDoc
style Style
Current ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t)
         , [Char] -> StyleDoc
flow [Char]
"relative to directory"
         , Path Abs Dir -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
dir StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
  pretty (InvalidOverrideCompiler WantedCompiler
x WantedCompiler
y) =
    StyleDoc
"[S-287]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Specified compiler for a snapshot"
         , StyleDoc -> StyleDoc
parens (Style -> StyleDoc -> StyleDoc
style Style
Shell ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Text
forall a. Display a => a -> Text
textDisplay WantedCompiler
x))
         , [Char] -> StyleDoc
flow [Char]
"but also specified an override compiler"
         , StyleDoc -> StyleDoc
parens (Style -> StyleDoc -> StyleDoc
style Style
Shell ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Text
forall a. Display a => a -> Text
textDisplay WantedCompiler
y)) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
  pretty (InvalidFilePathSnapshot Text
t) =
    StyleDoc
"[S-617]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Specified snapshot as file path with"
         , Style -> StyleDoc -> StyleDoc
style Style
File ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
         , [Char] -> StyleDoc
flow [Char]
"but not reading from a local file."
         ]
  pretty (InvalidSnapshot RawSnapshotLocation
loc SomeException
err) =
    StyleDoc
"[S-775]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Exception while reading snapshot from"
         , RawSnapshotLocation -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty RawSnapshotLocation
loc StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string (SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException SomeException
err)
  pretty (InvalidGlobalHintsLocation Path Abs Dir
dir Text
t) =
    StyleDoc
"[S-926]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Invalid global hints location"
         , Style -> StyleDoc -> StyleDoc
style Style
Current ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t)
         , [Char] -> StyleDoc
flow [Char]
"relative to directory"
         , Path Abs Dir -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
dir StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
  pretty (InvalidFilePathGlobalHints Text
t) =
    StyleDoc
"[S-832]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Specified global hints as file path with"
         , Style -> StyleDoc -> StyleDoc
style Style
File ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
         , [Char] -> StyleDoc
flow [Char]
"but not reading from a local file."
         ]
  pretty (MismatchedPackageMetadata RawPackageLocationImmutable
loc RawPackageMetadata
pm Maybe TreeKey
mtreeKey PackageIdentifier
foundIdent) =
    StyleDoc
"[S-427]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Mismatched package metadata for"
         , RawPackageLocationImmutable -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty RawPackageLocationImmutable
loc StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Expected:"
         , let t :: Text
t = RawPackageMetadata -> Text
forall a. Display a => a -> Text
textDisplay RawPackageMetadata
pm
           in  if Text -> Bool
T.null Text
t
                 then StyleDoc
"nothing."
                 else [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
         ])
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Found:   "
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
foundIdent [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> case Maybe TreeKey
mtreeKey of
             Maybe TreeKey
Nothing -> [Char]
"."
             Maybe TreeKey
_ -> [Char]
forall a. Monoid a => a
mempty
         , case Maybe TreeKey
mtreeKey of
             Maybe TreeKey
Nothing -> StyleDoc
forall a. Monoid a => a
mempty
             Just TreeKey
treeKey -> [StyleDoc] -> StyleDoc
fillSep
               [ StyleDoc
"with tree"
               , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ TreeKey -> Text
forall a. Display a => a -> Text
textDisplay TreeKey
treeKey Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
               ]
         ])
  pretty (Non200ResponseStatus Status
status) =
    StyleDoc
"[S-571]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Unexpected non-200 HTTP status code:"
         , ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Int -> [Char]) -> Int -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> StyleDoc) -> Int -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Status -> Int
statusCode Status
status) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
  pretty (InvalidBlobKey Mismatch{BlobKey
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: BlobKey
mismatchActual :: BlobKey
..}) =
    StyleDoc
"[S-236]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Invalid blob key found, expected:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ BlobKey -> Text
forall a. Display a => a -> Text
textDisplay BlobKey
mismatchExpected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
","
         , StyleDoc
"actual:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ BlobKey -> Text
forall a. Display a => a -> Text
textDisplay BlobKey
mismatchActual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ]
  pretty (Couldn'tParseSnapshot RawSnapshotLocation
sl [Char]
err) =
    StyleDoc
"[S-645]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Couldn't parse snapshot from"
         , RawSnapshotLocation -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty RawSnapshotLocation
sl StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string [Char]
err
  pretty (WrongCabalFileName RawPackageLocationImmutable
loc SafeFilePath
sfp PackageName
name) =
    StyleDoc
"[S-575]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Wrong Cabal file name for package"
         , RawPackageLocationImmutable -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty RawPackageLocationImmutable
loc StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         , [Char] -> StyleDoc
flow [Char]
"The Cabal file is named"
         , Style -> StyleDoc -> StyleDoc
style Style
File ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ SafeFilePath -> Text
forall a. Display a => a -> Text
textDisplay SafeFilePath
sfp) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
         , [Char] -> StyleDoc
flow [Char]
"but package name is"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
packageNameString PackageName
name) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         , [Char] -> StyleDoc
flow [Char]
"For more information, see"
         , Style -> StyleDoc -> StyleDoc
style Style
Url StyleDoc
"https://github.com/commercialhaskell/stack/issues/317"
         , StyleDoc
"and"
         , Style -> StyleDoc -> StyleDoc
style Style
Url StyleDoc
"https://github.com/commercialhaskell/stack/issues/895" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
  pretty (DownloadInvalidSHA256 Text
url Mismatch {SHA256
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: SHA256
mismatchActual :: SHA256
..}) =
    StyleDoc
"[S-394]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Mismatched SHA256 hash from"
         , Style -> StyleDoc -> StyleDoc
style Style
Url ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Expected:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ SHA256 -> Text
forall a. Display a => a -> Text
textDisplay SHA256
mismatchExpected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ])
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Actual:  "
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ SHA256 -> Text
forall a. Display a => a -> Text
textDisplay SHA256
mismatchActual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ])
  pretty (DownloadInvalidSize Text
url Mismatch {FileSize
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: FileSize
mismatchActual :: FileSize
..}) =
    StyleDoc
"[S-401]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Mismatched download size from"
         , Style -> StyleDoc -> StyleDoc
style Style
Url ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Expected:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FileSize -> Text
forall a. Display a => a -> Text
textDisplay FileSize
mismatchExpected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ])
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Actual:  "
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FileSize -> Text
forall a. Display a => a -> Text
textDisplay FileSize
mismatchActual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ])
  pretty (DownloadTooLarge Text
url Mismatch {FileSize
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: FileSize
mismatchActual :: FileSize
..}) =
    StyleDoc
"[S-113]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Download from"
         , Style -> StyleDoc -> StyleDoc
style Style
Url ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url)
         , [Char] -> StyleDoc
flow [Char]
"was too large. Expected:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FileSize -> Text
forall a. Display a => a -> Text
textDisplay FileSize
mismatchExpected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
","
         , [Char] -> StyleDoc
flow [Char]
"stopped after receiving:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FileSize -> Text
forall a. Display a => a -> Text
textDisplay FileSize
mismatchActual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ]
  pretty (LocalNoArchiveFileFound Path Abs File
path) =
    StyleDoc
"[S-628]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Stack looks for packages in the archive files configured in"
         , StyleDoc
"the"
         , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"extra-deps"
         , [Char] -> StyleDoc
flow [Char]
"field defined in its project-level configuration file"
         , StyleDoc -> StyleDoc
parens ([StyleDoc] -> StyleDoc
fillSep [StyleDoc
"usually", Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"stack.yaml"]) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         , [Char] -> StyleDoc
flow [Char]
"An entry points to"
         , Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
path
         , [Char] -> StyleDoc
flow [Char]
"but no such archive file could be found."
         ]
  pretty (LocalInvalidSHA256 Path Abs File
path Mismatch {SHA256
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: SHA256
mismatchActual :: SHA256
..}) =
    StyleDoc
"[S-834]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Mismatched SHA256 hash from"
         , Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
path StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Expected:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ SHA256 -> Text
forall a. Display a => a -> Text
textDisplay SHA256
mismatchExpected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ])
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Actual:  "
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ SHA256 -> Text
forall a. Display a => a -> Text
textDisplay SHA256
mismatchActual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ])
  pretty (LocalInvalidSize Path Abs File
path Mismatch {FileSize
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: FileSize
mismatchActual :: FileSize
..}) =
    StyleDoc
"[S-713]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Mismatched file size from"
         , Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
path StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Expected:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FileSize -> Text
forall a. Display a => a -> Text
textDisplay FileSize
mismatchExpected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ])
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Actual:  "
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FileSize -> Text
forall a. Display a => a -> Text
textDisplay FileSize
mismatchActual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ])
  pretty (UnknownArchiveType ArchiveLocation
loc) =
    StyleDoc
"[S-372]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Unable to determine archive type of:"
         , ArchiveLocation -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty ArchiveLocation
loc StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
  pretty (InvalidTarFileType ArchiveLocation
loc [Char]
fp FileType
x) =
    StyleDoc
"[S-950]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Unsupported tar file type in archive"
         , ArchiveLocation -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty ArchiveLocation
loc
         , [Char] -> StyleDoc
flow [Char]
"at file"
         , Style -> StyleDoc -> StyleDoc
style Style
File ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString [Char]
fp) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FileType -> [Char]
forall a. Show a => a -> [Char]
show FileType
x [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
         ]
  pretty (UnsupportedTarball ArchiveLocation
loc Text
err) =
    StyleDoc
"[S-760]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Unsupported tarball from"
         , ArchiveLocation -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty ArchiveLocation
loc StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string (Text -> [Char]
T.unpack Text
err)
  pretty (NoHackageCryptographicHash PackageIdentifier
ident) =
    StyleDoc
"[S-922]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"No cryptographic hash found for Hackage package"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
ident) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
  pretty (FailedToCloneRepo SimpleRepo
repo) =
    StyleDoc
"[S-109]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Failed to clone repository"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ SimpleRepo -> Text
forall a. Display a => a -> Text
textDisplay SimpleRepo
repo
         ]
  pretty (TreeReferencesMissingBlob RawPackageLocationImmutable
loc SafeFilePath
sfp BlobKey
key) =
    StyleDoc
"[S-237]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"The package"
         , RawPackageLocationImmutable -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty RawPackageLocationImmutable
loc
         , [Char] -> StyleDoc
flow [Char]
"needs blob"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ BlobKey -> Text
forall a. Display a => a -> Text
textDisplay BlobKey
key
         , [Char] -> StyleDoc
flow [Char]
"for file path"
         , Style -> StyleDoc -> StyleDoc
style Style
File ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ SafeFilePath -> Text
forall a. Display a => a -> Text
textDisplay SafeFilePath
sfp) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
         , [Char] -> StyleDoc
flow [Char]
"but the blob is not available."
         ]
  pretty (CompletePackageMetadataMismatch RawPackageLocationImmutable
loc PackageMetadata
pm) =
    StyleDoc
"[S-984]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"When completing package metadata for"
         , RawPackageLocationImmutable -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty RawPackageLocationImmutable
loc StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
         , [Char] -> StyleDoc
flow [Char]
"some values changed in the new package metadata:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ PackageMetadata -> Text
forall a. Display a => a -> Text
textDisplay PackageMetadata
pm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ]
  pretty (CRC32Mismatch ArchiveLocation
loc [Char]
fp Mismatch {Word32
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: Word32
mismatchActual :: Word32
..}) =
    StyleDoc
"[S-607]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"CRC32 mismatch in Zip file from"
         , ArchiveLocation -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty ArchiveLocation
loc
         , [Char] -> StyleDoc
flow [Char]
"on internal file"
         , Style -> StyleDoc -> StyleDoc
style Style
File ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString [Char]
fp)
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Expected:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Word32 -> Text
forall a. Display a => a -> Text
textDisplay Word32
mismatchExpected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ])
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Actual:  "
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Word32 -> Text
forall a. Display a => a -> Text
textDisplay Word32
mismatchActual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ])
  pretty (UnknownHackagePackage PackageIdentifierRevision
pir FuzzyResults
fuzzy) =
    StyleDoc
"[S-476]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Could not find"
         , Style -> StyleDoc -> StyleDoc
style Style
Error ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ PackageIdentifierRevision -> Text
forall a. Display a => a -> Text
textDisplay PackageIdentifierRevision
pir)
         , [Char] -> StyleDoc
flow [Char]
"on Hackage."
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> FuzzyResults -> StyleDoc
prettyFuzzy FuzzyResults
fuzzy
  pretty (CannotCompleteRepoNonSHA1 Repo
repo) =
    StyleDoc
"[S-112]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Cannot complete repo information for a non SHA1 commit due to"
         , StyleDoc
"non-reproducibility:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Repo -> Text
forall a. Display a => a -> Text
textDisplay Repo
repo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
         ]
  pretty (MutablePackageLocationFromUrl Text
t) =
    StyleDoc
"[S-321]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Cannot refer to a mutable package location from a URL:"
         , Style -> StyleDoc -> StyleDoc
style Style
Url ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
  pretty (MismatchedCabalFileForHackage PackageIdentifierRevision
pir Mismatch{PackageIdentifier
mismatchExpected :: forall a. Mismatch a -> a
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: PackageIdentifier
mismatchActual :: PackageIdentifier
..}) =
    StyleDoc
"[S-377]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"When processing Cabal file for Hackage package"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ PackageIdentifierRevision -> Text
forall a. Display a => a -> Text
textDisplay PackageIdentifierRevision
pir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
","
         , [Char] -> StyleDoc
flow [Char]
"mismatched package identifier."
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Expected:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
mismatchExpected) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ])
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
hang Int
10 ([StyleDoc] -> StyleDoc
fillSep
         [ StyleDoc
"Actual:  "
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString PackageIdentifier
mismatchActual) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ])
  pretty (PackageNameParseFail Text
t) =
    StyleDoc
"[S-580]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Invalid package name:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
         ]
  pretty (PackageVersionParseFail Text
t) =
    StyleDoc
"[S-479]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Invalid version:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
         ]
  pretty (InvalidCabalFilePath Path Abs File
fp) =
    StyleDoc
"[S-824]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"File path contains a name which is not a valid package name:"
         , Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
fp StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         ]
  pretty (DuplicatePackageNames Utf8Builder
source [(PackageName, [RawPackageLocationImmutable])]
pairs') =
    StyleDoc
"[S-674]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Duplicate package names"
         , StyleDoc -> StyleDoc
parens ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> Text
forall a. Display a => a -> Text
textDisplay Utf8Builder
source) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> ((PackageName, [RawPackageLocationImmutable]) -> StyleDoc)
-> [(PackageName, [RawPackageLocationImmutable])] -> StyleDoc
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
         ( \(PackageName
name, [RawPackageLocationImmutable]
locs) ->
                [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
packageNameString PackageName
name) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
             StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
             StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList ((RawPackageLocationImmutable -> StyleDoc)
-> [RawPackageLocationImmutable] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map RawPackageLocationImmutable -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty [RawPackageLocationImmutable]
locs)
             StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
         )
         [(PackageName, [RawPackageLocationImmutable])]
pairs'
  pretty (MigrationFailure Text
desc Path Abs File
fp SomeException
err) =
    StyleDoc
"[S-536]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Encountered error while migrating database"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
desc
         , [Char] -> StyleDoc
flow [Char]
"located at"
         , Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
fp StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string (SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException SomeException
err)
  pretty (ParseSnapNameException Text
t) =
    StyleDoc
"[S-994]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Invalid snapshot name:"
         , [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
         ]
  pretty (HpackLibraryException Path Abs File
file [Char]
err) =
    StyleDoc
"[S-305]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Failed to generate a Cabal file using the Hpack library on"
         , StyleDoc
"file:"
         , Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
file StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         , [Char] -> StyleDoc
flow [Char]
"The error encountered was:"
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string [Char]
err
  pretty (HpackExeException [Char]
fp Path Abs Dir
dir SomeException
err) =
    StyleDoc
"[S-720]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
         [ [Char] -> StyleDoc
flow [Char]
"Failed to generate a Cabal file using the Hpack executable:"
         , Style -> StyleDoc -> StyleDoc
style Style
File ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString [Char]
fp)
         , [Char] -> StyleDoc
flow [Char]
"in directory:"
         , Path Abs Dir -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
dir StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
         , [Char] -> StyleDoc
flow [Char]
"The error encountered was:"
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [Char] -> StyleDoc
string (SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException SomeException
err)

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 ([Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString ([Char] -> Utf8Builder)
-> (PackageName -> [Char]) -> PackageName -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> [Char]
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
"."

prettyFuzzy :: FuzzyResults -> StyleDoc
prettyFuzzy :: FuzzyResults -> StyleDoc
prettyFuzzy (FRNameNotFound [PackageName]
names) =
  case [PackageName] -> Maybe (NonEmpty PackageName)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [PackageName]
names of
    Maybe (NonEmpty PackageName)
Nothing -> StyleDoc
forall a. Monoid a => a
mempty
    Just NonEmpty PackageName
names' ->
         StyleDoc
line
      StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
           ( [Char] -> StyleDoc
flow [Char]
"Perhaps you meant one of"
           StyleDoc -> [StyleDoc] -> [StyleDoc]
forall a. a -> [a] -> [a]
: Maybe Style -> Bool -> [StyleDoc] -> [StyleDoc]
forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList Maybe Style
forall a. Maybe a
Nothing Bool
False
               (NonEmpty StyleDoc -> [StyleDoc]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty StyleDoc -> [StyleDoc])
-> NonEmpty StyleDoc -> [StyleDoc]
forall a b. (a -> b) -> a -> b
$ (PackageName -> StyleDoc)
-> NonEmpty PackageName -> NonEmpty StyleDoc
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc)
-> (PackageName -> [Char]) -> PackageName -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> [Char]
packageNameString) NonEmpty PackageName
names' :: [StyleDoc])
           )
prettyFuzzy (FRVersionNotFound NonEmpty PackageIdentifierRevision
pirs) =
     StyleDoc
line
  StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
       ( [Char] -> StyleDoc
flow [Char]
"Possible candidates:"
       StyleDoc -> [StyleDoc] -> [StyleDoc]
forall a. a -> [a] -> [a]
: Maybe Style -> Bool -> [StyleDoc] -> [StyleDoc]
forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList Maybe Style
forall a. Maybe a
Nothing Bool
False
           (NonEmpty StyleDoc -> [StyleDoc]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty StyleDoc -> [StyleDoc])
-> NonEmpty StyleDoc -> [StyleDoc]
forall a b. (a -> b) -> a -> b
$ (PackageIdentifierRevision -> StyleDoc)
-> NonEmpty PackageIdentifierRevision -> NonEmpty StyleDoc
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc)
-> (PackageIdentifierRevision -> [Char])
-> PackageIdentifierRevision
-> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> [Char])
-> (PackageIdentifierRevision -> Text)
-> PackageIdentifierRevision
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifierRevision -> Text
forall a. Display a => a -> Text
textDisplay) NonEmpty PackageIdentifierRevision
pirs :: [StyleDoc])
       )
prettyFuzzy (FRRevisionNotFound NonEmpty PackageIdentifierRevision
pirs) =
     StyleDoc
line
  StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
       ( [Char] -> StyleDoc
flow [Char]
"The specified revision was not found. Possible candidates:"
       StyleDoc -> [StyleDoc] -> [StyleDoc]
forall a. a -> [a] -> [a]
: Maybe Style -> Bool -> [StyleDoc] -> [StyleDoc]
forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList Maybe Style
forall a. Maybe a
Nothing Bool
False
           (NonEmpty StyleDoc -> [StyleDoc]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty StyleDoc -> [StyleDoc])
-> NonEmpty StyleDoc -> [StyleDoc]
forall a b. (a -> b) -> a -> b
$ (PackageIdentifierRevision -> StyleDoc)
-> NonEmpty PackageIdentifierRevision -> NonEmpty StyleDoc
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc)
-> (PackageIdentifierRevision -> [Char])
-> PackageIdentifierRevision
-> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> [Char])
-> (PackageIdentifierRevision -> Text)
-> PackageIdentifierRevision
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifierRevision -> Text
forall a. Display a => a -> Text
textDisplay) NonEmpty PackageIdentifierRevision
pirs :: [StyleDoc])
       )

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 m. Monoid m => [m] -> m
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 m. Monoid m => NonEmpty m -> m
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 = [Int] -> Version
mkVersion ([Int] -> Version) -> [Int] -> Version
forall a b. (a -> b) -> a -> b
$ CabalSpecVersion -> [Int]
cabalSpecToVersionDigits CabalSpecVersion
cabalSpecLatest

#if !MIN_VERSION_Cabal(3,4,0)
cabalSpecToVersionDigits :: CabalSpecVersion -> [Int]
cabalSpecToVersionDigits CabalSpecV3_0   = [3,0]
cabalSpecToVersionDigits CabalSpecV2_4   = [2,4]
cabalSpecToVersionDigits CabalSpecV2_2   = [2,2]
cabalSpecToVersionDigits CabalSpecV2_0   = [2,0]
cabalSpecToVersionDigits CabalSpecV1_24  = [1,24]
cabalSpecToVersionDigits CabalSpecV1_22  = [1,22]
cabalSpecToVersionDigits CabalSpecV1_20  = [1,20]
cabalSpecToVersionDigits CabalSpecV1_18  = [1,18]
cabalSpecToVersionDigits CabalSpecV1_12  = [1,12]
cabalSpecToVersionDigits CabalSpecV1_10  = [1,10]
cabalSpecToVersionDigits CabalSpecV1_8   = [1,8]
cabalSpecToVersionDigits CabalSpecV1_6   = [1,6]
cabalSpecToVersionDigits CabalSpecV1_4   = [1,4]
cabalSpecToVersionDigits CabalSpecV1_2   = [1,2]
cabalSpecToVersionDigits CabalSpecV1_0   = [1,0]
#endif

data BuildFile
  = BFCabal !SafeFilePath !TreeEntry
  | BFHpack !TreeEntry
    -- We don't need SafeFilePath for Hpack since it has to be package.yaml file

  deriving (Int -> BuildFile -> ShowS
[BuildFile] -> ShowS
BuildFile -> [Char]
(Int -> BuildFile -> ShowS)
-> (BuildFile -> [Char])
-> ([BuildFile] -> ShowS)
-> Show BuildFile
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildFile -> ShowS
showsPrec :: Int -> BuildFile -> ShowS
$cshow :: BuildFile -> [Char]
show :: BuildFile -> [Char]
$cshowList :: [BuildFile] -> ShowS
showList :: [BuildFile] -> ShowS
Show, BuildFile -> BuildFile -> Bool
(BuildFile -> BuildFile -> Bool)
-> (BuildFile -> BuildFile -> Bool) -> Eq BuildFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildFile -> BuildFile -> Bool
== :: BuildFile -> BuildFile -> Bool
$c/= :: BuildFile -> BuildFile -> Bool
/= :: BuildFile -> BuildFile -> Bool
Eq)

data FileType = FTNormal | FTExecutable
  deriving (Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> [Char]
(Int -> FileType -> ShowS)
-> (FileType -> [Char]) -> ([FileType] -> ShowS) -> Show FileType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileType -> ShowS
showsPrec :: Int -> FileType -> ShowS
$cshow :: FileType -> [Char]
show :: FileType -> [Char]
$cshowList :: [FileType] -> ShowS
showList :: [FileType] -> ShowS
Show, FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
/= :: 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
$csucc :: FileType -> FileType
succ :: FileType -> FileType
$cpred :: FileType -> FileType
pred :: FileType -> FileType
$ctoEnum :: Int -> FileType
toEnum :: Int -> FileType
$cfromEnum :: FileType -> Int
fromEnum :: FileType -> Int
$cenumFrom :: FileType -> [FileType]
enumFrom :: FileType -> [FileType]
$cenumFromThen :: FileType -> FileType -> [FileType]
enumFromThen :: FileType -> FileType -> [FileType]
$cenumFromTo :: FileType -> FileType -> [FileType]
enumFromTo :: FileType -> FileType -> [FileType]
$cenumFromThenTo :: FileType -> FileType -> FileType -> [FileType]
enumFromThenTo :: FileType -> FileType -> FileType -> [FileType]
Enum, FileType
FileType -> FileType -> Bounded FileType
forall a. a -> a -> Bounded a
$cminBound :: FileType
minBound :: FileType
$cmaxBound :: FileType
maxBound :: FileType
Bounded, Eq FileType
Eq FileType =>
(FileType -> FileType -> Ordering)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> FileType)
-> (FileType -> FileType -> FileType)
-> Ord FileType
FileType -> FileType -> Bool
FileType -> FileType -> Ordering
FileType -> FileType -> FileType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FileType -> FileType -> Ordering
compare :: FileType -> FileType -> Ordering
$c< :: FileType -> FileType -> Bool
< :: FileType -> FileType -> Bool
$c<= :: FileType -> FileType -> Bool
<= :: FileType -> FileType -> Bool
$c> :: FileType -> FileType -> Bool
> :: FileType -> FileType -> Bool
$c>= :: FileType -> FileType -> Bool
>= :: FileType -> FileType -> Bool
$cmax :: FileType -> FileType -> FileType
max :: FileType -> FileType -> FileType
$cmin :: FileType -> FileType -> FileType
min :: FileType -> FileType -> FileType
Ord)

instance PersistField FileType where
  toPersistValue :: FileType -> PersistValue
toPersistValue FileType
FTNormal = Int64 -> PersistValue
PersistInt64 Int64
1
  toPersistValue FileType
FTExecutable = Int64 -> PersistValue
PersistInt64 Int64
2

  fromPersistValue :: PersistValue -> Either Text FileType
fromPersistValue PersistValue
v = do
    Int64
i <- 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 -> [Char]
(Int -> TreeEntry -> ShowS)
-> (TreeEntry -> [Char])
-> ([TreeEntry] -> ShowS)
-> Show TreeEntry
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TreeEntry -> ShowS
showsPrec :: Int -> TreeEntry -> ShowS
$cshow :: TreeEntry -> [Char]
show :: TreeEntry -> [Char]
$cshowList :: [TreeEntry] -> ShowS
showList :: [TreeEntry] -> ShowS
Show, TreeEntry -> TreeEntry -> Bool
(TreeEntry -> TreeEntry -> Bool)
-> (TreeEntry -> TreeEntry -> Bool) -> Eq TreeEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TreeEntry -> TreeEntry -> Bool
== :: TreeEntry -> TreeEntry -> Bool
$c/= :: TreeEntry -> TreeEntry -> Bool
/= :: TreeEntry -> TreeEntry -> Bool
Eq, Eq TreeEntry
Eq TreeEntry =>
(TreeEntry -> TreeEntry -> Ordering)
-> (TreeEntry -> TreeEntry -> Bool)
-> (TreeEntry -> TreeEntry -> Bool)
-> (TreeEntry -> TreeEntry -> Bool)
-> (TreeEntry -> TreeEntry -> Bool)
-> (TreeEntry -> TreeEntry -> TreeEntry)
-> (TreeEntry -> TreeEntry -> TreeEntry)
-> Ord TreeEntry
TreeEntry -> TreeEntry -> Bool
TreeEntry -> TreeEntry -> Ordering
TreeEntry -> TreeEntry -> TreeEntry
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TreeEntry -> TreeEntry -> Ordering
compare :: TreeEntry -> TreeEntry -> Ordering
$c< :: TreeEntry -> TreeEntry -> Bool
< :: TreeEntry -> TreeEntry -> Bool
$c<= :: TreeEntry -> TreeEntry -> Bool
<= :: TreeEntry -> TreeEntry -> Bool
$c> :: TreeEntry -> TreeEntry -> Bool
> :: TreeEntry -> TreeEntry -> Bool
$c>= :: TreeEntry -> TreeEntry -> Bool
>= :: TreeEntry -> TreeEntry -> Bool
$cmax :: TreeEntry -> TreeEntry -> TreeEntry
max :: TreeEntry -> TreeEntry -> TreeEntry
$cmin :: TreeEntry -> TreeEntry -> TreeEntry
min :: TreeEntry -> TreeEntry -> TreeEntry
Ord)

newtype SafeFilePath = SafeFilePath Text
  deriving (Int -> SafeFilePath -> ShowS
[SafeFilePath] -> ShowS
SafeFilePath -> [Char]
(Int -> SafeFilePath -> ShowS)
-> (SafeFilePath -> [Char])
-> ([SafeFilePath] -> ShowS)
-> Show SafeFilePath
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SafeFilePath -> ShowS
showsPrec :: Int -> SafeFilePath -> ShowS
$cshow :: SafeFilePath -> [Char]
show :: SafeFilePath -> [Char]
$cshowList :: [SafeFilePath] -> ShowS
showList :: [SafeFilePath] -> ShowS
Show, SafeFilePath -> SafeFilePath -> Bool
(SafeFilePath -> SafeFilePath -> Bool)
-> (SafeFilePath -> SafeFilePath -> Bool) -> Eq SafeFilePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SafeFilePath -> SafeFilePath -> Bool
== :: SafeFilePath -> SafeFilePath -> Bool
$c/= :: SafeFilePath -> SafeFilePath -> Bool
/= :: 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
$ccompare :: SafeFilePath -> SafeFilePath -> Ordering
compare :: SafeFilePath -> SafeFilePath -> Ordering
$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
>= :: SafeFilePath -> SafeFilePath -> Bool
$cmax :: SafeFilePath -> SafeFilePath -> SafeFilePath
max :: SafeFilePath -> SafeFilePath -> SafeFilePath
$cmin :: SafeFilePath -> SafeFilePath -> SafeFilePath
min :: SafeFilePath -> SafeFilePath -> SafeFilePath
Ord, SafeFilePath -> Text
SafeFilePath -> Utf8Builder
(SafeFilePath -> Utf8Builder)
-> (SafeFilePath -> Text) -> Display SafeFilePath
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
$cdisplay :: SafeFilePath -> Utf8Builder
display :: SafeFilePath -> Utf8Builder
$ctextDisplay :: SafeFilePath -> Text
textDisplay :: SafeFilePath -> Text
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 :: forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir -> SafeFilePath -> m (Path Abs File)
safeFilePathToPath Path Abs Dir
dir (SafeFilePath Text
path) = do
  Path Rel File
fpath <- [Char] -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile (Text -> [Char]
T.unpack Text
path)
  Path Abs File -> m (Path Abs File)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
$ (Bool -> Bool
not (Bool -> Bool) -> ([Text] -> Bool) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((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

-- | SafeFilePath for `package.yaml` file.

hpackSafeFilePath :: SafeFilePath
hpackSafeFilePath :: SafeFilePath
hpackSafeFilePath =
    let fpath :: Maybe SafeFilePath
fpath = Text -> Maybe SafeFilePath
mkSafeFilePath ([Char] -> Text
T.pack [Char]
Hpack.packageConfig)
    in case Maybe SafeFilePath
fpath of
         Maybe SafeFilePath
Nothing -> [Char] -> SafeFilePath
forall a. HasCallStack => [Char] -> a
error ([Char] -> SafeFilePath) -> [Char] -> SafeFilePath
forall a b. (a -> b) -> a -> b
$
           [Char]
"hpackSafeFilePath: Not able to encode " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
Hpack.packageConfig
         Just SafeFilePath
sfp -> SafeFilePath
sfp

-- | The hash of the binary representation of a 'Tree'.

--

-- @since 0.1.0.0

newtype TreeKey = TreeKey BlobKey
  deriving (Int -> TreeKey -> ShowS
[TreeKey] -> ShowS
TreeKey -> [Char]
(Int -> TreeKey -> ShowS)
-> (TreeKey -> [Char]) -> ([TreeKey] -> ShowS) -> Show TreeKey
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TreeKey -> ShowS
showsPrec :: Int -> TreeKey -> ShowS
$cshow :: TreeKey -> [Char]
show :: TreeKey -> [Char]
$cshowList :: [TreeKey] -> ShowS
showList :: [TreeKey] -> ShowS
Show, TreeKey -> TreeKey -> Bool
(TreeKey -> TreeKey -> Bool)
-> (TreeKey -> TreeKey -> Bool) -> Eq TreeKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TreeKey -> TreeKey -> Bool
== :: TreeKey -> TreeKey -> Bool
$c/= :: TreeKey -> TreeKey -> Bool
/= :: 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
$ccompare :: TreeKey -> TreeKey -> Ordering
compare :: TreeKey -> TreeKey -> Ordering
$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
>= :: TreeKey -> TreeKey -> Bool
$cmax :: TreeKey -> TreeKey -> TreeKey
max :: TreeKey -> TreeKey -> TreeKey
$cmin :: TreeKey -> TreeKey -> TreeKey
min :: TreeKey -> TreeKey -> 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
$cfrom :: forall x. TreeKey -> Rep TreeKey x
from :: forall x. TreeKey -> Rep TreeKey x
$cto :: forall x. Rep TreeKey x -> TreeKey
to :: forall x. Rep TreeKey x -> TreeKey
Generic, Typeable, [TreeKey] -> Value
[TreeKey] -> Encoding
TreeKey -> Bool
TreeKey -> Value
TreeKey -> Encoding
(TreeKey -> Value)
-> (TreeKey -> Encoding)
-> ([TreeKey] -> Value)
-> ([TreeKey] -> Encoding)
-> (TreeKey -> Bool)
-> ToJSON TreeKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TreeKey -> Value
toJSON :: TreeKey -> Value
$ctoEncoding :: TreeKey -> Encoding
toEncoding :: TreeKey -> Encoding
$ctoJSONList :: [TreeKey] -> Value
toJSONList :: [TreeKey] -> Value
$ctoEncodingList :: [TreeKey] -> Encoding
toEncodingList :: [TreeKey] -> Encoding
$comitField :: TreeKey -> Bool
omitField :: TreeKey -> Bool
ToJSON, Maybe TreeKey
Value -> Parser [TreeKey]
Value -> Parser TreeKey
(Value -> Parser TreeKey)
-> (Value -> Parser [TreeKey]) -> Maybe TreeKey -> FromJSON TreeKey
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TreeKey
parseJSON :: Value -> Parser TreeKey
$cparseJSONList :: Value -> Parser [TreeKey]
parseJSONList :: Value -> Parser [TreeKey]
$comittedField :: Maybe TreeKey
omittedField :: Maybe TreeKey
FromJSON, TreeKey -> ()
(TreeKey -> ()) -> NFData TreeKey
forall a. (a -> ()) -> NFData a
$crnf :: TreeKey -> ()
rnf :: TreeKey -> ()
NFData, TreeKey -> Text
TreeKey -> Utf8Builder
(TreeKey -> Utf8Builder) -> (TreeKey -> Text) -> Display TreeKey
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
$cdisplay :: TreeKey -> Utf8Builder
display :: TreeKey -> Utf8Builder
$ctextDisplay :: TreeKey -> Text
textDisplay :: TreeKey -> Text
Display)

-- | Represents the contents of a tree, which is a mapping from

-- relative file paths to 'TreeEntry's.

--

-- @since 0.1.0.0

newtype Tree
  = TreeMap (Map SafeFilePath TreeEntry)
  -- In the future, consider allowing more lax parsing

  -- See: https://www.fpcomplete.com/blog/2018/07/pantry-part-2-trees-keys

  -- TreeTarball !PackageTarball

  deriving (Int -> Tree -> ShowS
[Tree] -> ShowS
Tree -> [Char]
(Int -> Tree -> ShowS)
-> (Tree -> [Char]) -> ([Tree] -> ShowS) -> Show Tree
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tree -> ShowS
showsPrec :: Int -> Tree -> ShowS
$cshow :: Tree -> [Char]
show :: Tree -> [Char]
$cshowList :: [Tree] -> ShowS
showList :: [Tree] -> ShowS
Show, Tree -> Tree -> Bool
(Tree -> Tree -> Bool) -> (Tree -> Tree -> Bool) -> Eq Tree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tree -> Tree -> Bool
== :: Tree -> Tree -> Bool
$c/= :: Tree -> Tree -> Bool
/= :: Tree -> Tree -> Bool
Eq, Eq Tree
Eq Tree =>
(Tree -> Tree -> Ordering)
-> (Tree -> Tree -> Bool)
-> (Tree -> Tree -> Bool)
-> (Tree -> Tree -> Bool)
-> (Tree -> Tree -> Bool)
-> (Tree -> Tree -> Tree)
-> (Tree -> Tree -> Tree)
-> Ord Tree
Tree -> Tree -> Bool
Tree -> Tree -> Ordering
Tree -> Tree -> Tree
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Tree -> Tree -> Ordering
compare :: Tree -> Tree -> Ordering
$c< :: Tree -> Tree -> Bool
< :: Tree -> Tree -> Bool
$c<= :: Tree -> Tree -> Bool
<= :: Tree -> Tree -> Bool
$c> :: Tree -> Tree -> Bool
> :: Tree -> Tree -> Bool
$c>= :: Tree -> Tree -> Bool
>= :: Tree -> Tree -> Bool
$cmax :: Tree -> Tree -> Tree
max :: Tree -> Tree -> Tree
$cmin :: Tree -> Tree -> Tree
min :: Tree -> Tree -> Tree
Ord)

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 :: forall (m :: * -> *).
MonadThrow m =>
(BlobKey, ByteString) -> m (TreeKey, Tree)
parseTreeM (BlobKey
blobKey, ByteString
blob) =
  case ByteString -> Maybe Tree
parseTree ByteString
blob of
    Maybe Tree
Nothing -> PantryException -> m (TreeKey, Tree)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (BlobKey -> ByteString -> PantryException
InvalidTreeFromCasa BlobKey
blobKey ByteString
blob)
    Just Tree
tree -> (TreeKey, Tree) -> m (TreeKey, Tree)
forall a. a -> m a
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 a. a -> Maybe a
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 -- 'N'

            Word8
88 -> FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
FTExecutable -- 'X'

            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 a. a -> Maybe a
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

    {-
data PackageTarball = PackageTarball
  { ptBlob :: !BlobKey
  -- ^ Contains the tarball itself
  , ptCabal :: !BlobKey
  -- ^ Contains the cabal file contents
  , ptSubdir :: !FilePath
  -- ^ Subdir containing the files we want for this package.
  --
  -- There must be precisely one file with a @.cabal@ file extension
  -- located there. Thanks to Hackage revisions, its contents will be
  -- overwritten by the value of @ptCabal@.
  }
  deriving Show
    -}

-- | This is almost a copy of Cabal's parser for package identifiers,

-- the main difference is in the fact that Stack requires version to be

-- present while Cabal uses "null version" as a default value

--

-- @since 0.1.0.0

parsePackageIdentifier :: String -> Maybe PackageIdentifier
parsePackageIdentifier :: [Char] -> Maybe PackageIdentifier
parsePackageIdentifier = ([Char] -> Maybe PackageIdentifier)
-> (PackageIdentifier -> Maybe PackageIdentifier)
-> Either [Char] PackageIdentifier
-> Maybe PackageIdentifier
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe PackageIdentifier -> [Char] -> 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 [Char] PackageIdentifier -> Maybe PackageIdentifier)
-> ([Char] -> Either [Char] PackageIdentifier)
-> [Char]
-> Maybe PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecParser PackageIdentifier
-> [Char] -> Either [Char] PackageIdentifier
forall a. ParsecParser a -> [Char] -> Either [Char] a
explicitEitherParsec (ParsecParser PackageIdentifier
packageIdentifierParsec ParsecParser PackageIdentifier
-> ParsecParser () -> ParsecParser PackageIdentifier
forall a b. ParsecParser a -> ParsecParser b -> ParsecParser a
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
forall (m :: * -> *). CabalParsing m => m PackageIdentifier
parsec

  -- version is a required component of a package identifier for Stack

  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 a. a -> ParsecParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageIdentifier
ident

-- | Parse a package name from a 'String'.

--

-- @since 0.1.0.0

parsePackageName :: String -> Maybe PackageName
parsePackageName :: [Char] -> Maybe PackageName
parsePackageName = [Char] -> Maybe PackageName
forall a. Parsec a => [Char] -> Maybe a
Distribution.Text.simpleParse

-- | Parse a package name from a 'String' throwing on failure

--

-- @since 0.1.0.0

parsePackageNameThrowing :: MonadThrow m => String -> m PackageName
parsePackageNameThrowing :: forall (m :: * -> *). MonadThrow m => [Char] -> m PackageName
parsePackageNameThrowing [Char]
str =
  case [Char] -> Maybe PackageName
parsePackageName [Char]
str of
    Maybe PackageName
Nothing -> PantryException -> m PackageName
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, 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
$ [Char] -> Text
T.pack [Char]
str
    Just PackageName
pn -> PackageName -> m PackageName
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageName
pn

-- | Parse a version from a 'String'.

--

-- @since 0.1.0.0

parseVersion :: String -> Maybe Version
parseVersion :: [Char] -> Maybe Version
parseVersion = [Char] -> Maybe Version
forall a. Parsec a => [Char] -> Maybe a
Distribution.Text.simpleParse

-- | Parse a package version from a 'String' throwing on failure

--

-- @since 0.1.0.0

parseVersionThrowing :: MonadThrow m => String -> m Version
parseVersionThrowing :: forall (m :: * -> *). MonadThrow m => [Char] -> m Version
parseVersionThrowing [Char]
str =
  case [Char] -> Maybe Version
parseVersion [Char]
str of
    Maybe Version
Nothing -> PantryException -> m Version
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, 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
$ [Char] -> Text
T.pack [Char]
str
    Just Version
v -> Version -> m Version
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v

-- | Parse a version range from a 'String'.

--

-- @since 0.1.0.0

parseVersionRange :: String -> Maybe VersionRange
parseVersionRange :: [Char] -> Maybe VersionRange
parseVersionRange = [Char] -> Maybe VersionRange
forall a. Parsec a => [Char] -> Maybe a
Distribution.Text.simpleParse

-- | Parse a module name from a 'String'.

--

-- @since 0.1.0.0

parseModuleName :: String -> Maybe ModuleName
parseModuleName :: [Char] -> Maybe ModuleName
parseModuleName = [Char] -> Maybe ModuleName
forall a. Parsec a => [Char] -> Maybe a
Distribution.Text.simpleParse

-- | Parse a flag name from a 'String'.

--

-- @since 0.1.0.0

parseFlagName :: String -> Maybe FlagName
parseFlagName :: [Char] -> Maybe FlagName
parseFlagName = [Char] -> Maybe FlagName
forall a. Parsec a => [Char] -> Maybe a
Distribution.Text.simpleParse

-- | Render a package name as a 'String'.

--

-- @since 0.1.0.0

packageNameString :: PackageName -> String
packageNameString :: PackageName -> [Char]
packageNameString = PackageName -> [Char]
unPackageName

-- | Render a package identifier as a 'String'.

--

-- @since 0.1.0.0

packageIdentifierString :: PackageIdentifier -> String
packageIdentifierString :: PackageIdentifier -> [Char]
packageIdentifierString = PackageIdentifier -> [Char]
forall a. Pretty a => a -> [Char]
Distribution.Text.display

-- | Render a version as a 'String'.

--

-- @since 0.1.0.0

versionString :: Version -> String
versionString :: Version -> [Char]
versionString = Version -> [Char]
forall a. Pretty a => a -> [Char]
Distribution.Text.display

-- | Render a flag name as a 'String'.

--

-- @since 0.1.0.0

flagNameString :: FlagName -> String
flagNameString :: FlagName -> [Char]
flagNameString = FlagName -> [Char]
unFlagName

-- | Render a module name as a 'String'.

--

-- @since 0.1.0.0

moduleNameString :: ModuleName -> String
moduleNameString :: ModuleName -> [Char]
moduleNameString = ModuleName -> [Char]
forall a. Pretty a => a -> [Char]
Distribution.Text.display

data OptionalSubdirs
  = OSSubdirs !(NonEmpty Text)
  | OSPackageMetadata !Text !RawPackageMetadata
  -- ^ subdirectory and package metadata

  deriving (Int -> OptionalSubdirs -> ShowS
[OptionalSubdirs] -> ShowS
OptionalSubdirs -> [Char]
(Int -> OptionalSubdirs -> ShowS)
-> (OptionalSubdirs -> [Char])
-> ([OptionalSubdirs] -> ShowS)
-> Show OptionalSubdirs
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptionalSubdirs -> ShowS
showsPrec :: Int -> OptionalSubdirs -> ShowS
$cshow :: OptionalSubdirs -> [Char]
show :: OptionalSubdirs -> [Char]
$cshowList :: [OptionalSubdirs] -> ShowS
showList :: [OptionalSubdirs] -> ShowS
Show, OptionalSubdirs -> OptionalSubdirs -> Bool
(OptionalSubdirs -> OptionalSubdirs -> Bool)
-> (OptionalSubdirs -> OptionalSubdirs -> Bool)
-> Eq OptionalSubdirs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptionalSubdirs -> OptionalSubdirs -> Bool
== :: OptionalSubdirs -> OptionalSubdirs -> Bool
$c/= :: OptionalSubdirs -> OptionalSubdirs -> Bool
/= :: 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
$cfrom :: forall x. OptionalSubdirs -> Rep OptionalSubdirs x
from :: forall x. OptionalSubdirs -> Rep OptionalSubdirs x
$cto :: forall x. Rep OptionalSubdirs x -> OptionalSubdirs
to :: forall x. Rep OptionalSubdirs x -> OptionalSubdirs
Generic)

instance NFData OptionalSubdirs

-- | Metadata provided by a config file for archives and repos. This information

-- can be used for optimized lookups of information like package identifiers, or

-- for validating that the user configuration has the expected information.

--

-- @since 0.1.0.0

data RawPackageMetadata = RawPackageMetadata
  { RawPackageMetadata -> Maybe PackageName
rpmName :: !(Maybe PackageName)
    -- ^ Package name in the cabal file

    --

    -- @since 0.1.0.0

  , RawPackageMetadata -> Maybe Version
rpmVersion :: !(Maybe Version)
    -- ^ Package version in the cabal file

    --

    -- @since 0.1.0.0

  , RawPackageMetadata -> Maybe TreeKey
rpmTreeKey :: !(Maybe TreeKey)
    -- ^ Tree key of the loaded up package

    --

    -- @since 0.1.0.0

  }
  deriving (Int -> RawPackageMetadata -> ShowS
[RawPackageMetadata] -> ShowS
RawPackageMetadata -> [Char]
(Int -> RawPackageMetadata -> ShowS)
-> (RawPackageMetadata -> [Char])
-> ([RawPackageMetadata] -> ShowS)
-> Show RawPackageMetadata
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawPackageMetadata -> ShowS
showsPrec :: Int -> RawPackageMetadata -> ShowS
$cshow :: RawPackageMetadata -> [Char]
show :: RawPackageMetadata -> [Char]
$cshowList :: [RawPackageMetadata] -> ShowS
showList :: [RawPackageMetadata] -> ShowS
Show, RawPackageMetadata -> RawPackageMetadata -> Bool
(RawPackageMetadata -> RawPackageMetadata -> Bool)
-> (RawPackageMetadata -> RawPackageMetadata -> Bool)
-> Eq RawPackageMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawPackageMetadata -> RawPackageMetadata -> Bool
== :: RawPackageMetadata -> RawPackageMetadata -> Bool
$c/= :: RawPackageMetadata -> RawPackageMetadata -> Bool
/= :: 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
$ccompare :: RawPackageMetadata -> RawPackageMetadata -> Ordering
compare :: RawPackageMetadata -> RawPackageMetadata -> Ordering
$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
>= :: RawPackageMetadata -> RawPackageMetadata -> Bool
$cmax :: RawPackageMetadata -> RawPackageMetadata -> RawPackageMetadata
max :: RawPackageMetadata -> RawPackageMetadata -> RawPackageMetadata
$cmin :: RawPackageMetadata -> RawPackageMetadata -> RawPackageMetadata
min :: RawPackageMetadata -> RawPackageMetadata -> 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
$cfrom :: forall x. RawPackageMetadata -> Rep RawPackageMetadata x
from :: forall x. RawPackageMetadata -> Rep RawPackageMetadata x
$cto :: forall x. Rep RawPackageMetadata x -> RawPackageMetadata
to :: forall x. Rep RawPackageMetadata x -> RawPackageMetadata
Generic, Typeable)

instance NFData RawPackageMetadata

instance Display RawPackageMetadata where
  display :: RawPackageMetadata -> Utf8Builder
display RawPackageMetadata
rpm = [Utf8Builder] -> Utf8Builder
forall m. Monoid m => [m] -> m
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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (PackageName -> [Char]
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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
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
    ]

-- | Exact metadata specifying concrete package

--

-- @since 0.1.0.0

data PackageMetadata = PackageMetadata
  { PackageMetadata -> PackageIdentifier
pmIdent :: !PackageIdentifier
    -- ^ Package identifier in the cabal file

    --

    -- @since 0.1.0.0

  , PackageMetadata -> TreeKey
pmTreeKey :: !TreeKey
    -- ^ Tree key of the loaded up package

    --

    -- @since 0.1.0.0

  }
  deriving (Int -> PackageMetadata -> ShowS
[PackageMetadata] -> ShowS
PackageMetadata -> [Char]
(Int -> PackageMetadata -> ShowS)
-> (PackageMetadata -> [Char])
-> ([PackageMetadata] -> ShowS)
-> Show PackageMetadata
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageMetadata -> ShowS
showsPrec :: Int -> PackageMetadata -> ShowS
$cshow :: PackageMetadata -> [Char]
show :: PackageMetadata -> [Char]
$cshowList :: [PackageMetadata] -> ShowS
showList :: [PackageMetadata] -> ShowS
Show, PackageMetadata -> PackageMetadata -> Bool
(PackageMetadata -> PackageMetadata -> Bool)
-> (PackageMetadata -> PackageMetadata -> Bool)
-> Eq PackageMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageMetadata -> PackageMetadata -> Bool
== :: PackageMetadata -> PackageMetadata -> Bool
$c/= :: PackageMetadata -> PackageMetadata -> Bool
/= :: 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
$ccompare :: PackageMetadata -> PackageMetadata -> Ordering
compare :: PackageMetadata -> PackageMetadata -> Ordering
$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
>= :: PackageMetadata -> PackageMetadata -> Bool
$cmax :: PackageMetadata -> PackageMetadata -> PackageMetadata
max :: PackageMetadata -> PackageMetadata -> PackageMetadata
$cmin :: PackageMetadata -> PackageMetadata -> PackageMetadata
min :: PackageMetadata -> PackageMetadata -> 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
$cfrom :: forall x. PackageMetadata -> Rep PackageMetadata x
from :: forall x. PackageMetadata -> Rep PackageMetadata x
$cto :: forall x. Rep PackageMetadata x -> PackageMetadata
to :: forall x. Rep PackageMetadata x -> PackageMetadata
Generic, Typeable)

-- i PackageMetadata

instance NFData PackageMetadata

instance Display PackageMetadata where
  display :: PackageMetadata -> Utf8Builder
display PackageMetadata
pm = [Utf8Builder] -> Utf8Builder
forall m. Monoid m => [m] -> m
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
"ident == " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (PackageIdentifier -> [Char]
packageIdentifierString (PackageIdentifier -> [Char]) -> PackageIdentifier -> [Char]
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 {Version
PackageName
pkgName :: PackageName
pkgName :: PackageName
pkgVersion :: Version
pkgVersion :: Version
..}
  PackageMetadata -> WarningParser PackageMetadata
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageMetadata {PackageIdentifier
TreeKey
pmIdent :: PackageIdentifier
pmTreeKey :: TreeKey
pmTreeKey :: TreeKey
pmIdent :: PackageIdentifier
..}


-- | Convert package metadata to its "raw" equivalent.

--

-- @since 0.1.0.0

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

-- | File path relative to the configuration file it was parsed from

--

-- @since 0.1.0.0

newtype RelFilePath = RelFilePath Text
  deriving (Int -> RelFilePath -> ShowS
[RelFilePath] -> ShowS
RelFilePath -> [Char]
(Int -> RelFilePath -> ShowS)
-> (RelFilePath -> [Char])
-> ([RelFilePath] -> ShowS)
-> Show RelFilePath
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelFilePath -> ShowS
showsPrec :: Int -> RelFilePath -> ShowS
$cshow :: RelFilePath -> [Char]
show :: RelFilePath -> [Char]
$cshowList :: [RelFilePath] -> ShowS
showList :: [RelFilePath] -> ShowS
Show, [RelFilePath] -> Value
[RelFilePath] -> Encoding
RelFilePath -> Bool
RelFilePath -> Value
RelFilePath -> Encoding
(RelFilePath -> Value)
-> (RelFilePath -> Encoding)
-> ([RelFilePath] -> Value)
-> ([RelFilePath] -> Encoding)
-> (RelFilePath -> Bool)
-> ToJSON RelFilePath
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RelFilePath -> Value
toJSON :: RelFilePath -> Value
$ctoEncoding :: RelFilePath -> Encoding
toEncoding :: RelFilePath -> Encoding
$ctoJSONList :: [RelFilePath] -> Value
toJSONList :: [RelFilePath] -> Value
$ctoEncodingList :: [RelFilePath] -> Encoding
toEncodingList :: [RelFilePath] -> Encoding
$comitField :: RelFilePath -> Bool
omitField :: RelFilePath -> Bool
ToJSON, Maybe RelFilePath
Value -> Parser [RelFilePath]
Value -> Parser RelFilePath
(Value -> Parser RelFilePath)
-> (Value -> Parser [RelFilePath])
-> Maybe RelFilePath
-> FromJSON RelFilePath
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RelFilePath
parseJSON :: Value -> Parser RelFilePath
$cparseJSONList :: Value -> Parser [RelFilePath]
parseJSONList :: Value -> Parser [RelFilePath]
$comittedField :: Maybe RelFilePath
omittedField :: Maybe RelFilePath
FromJSON, RelFilePath -> RelFilePath -> Bool
(RelFilePath -> RelFilePath -> Bool)
-> (RelFilePath -> RelFilePath -> Bool) -> Eq RelFilePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelFilePath -> RelFilePath -> Bool
== :: RelFilePath -> RelFilePath -> Bool
$c/= :: RelFilePath -> RelFilePath -> Bool
/= :: 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
$ccompare :: RelFilePath -> RelFilePath -> Ordering
compare :: RelFilePath -> RelFilePath -> Ordering
$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
>= :: RelFilePath -> RelFilePath -> Bool
$cmax :: RelFilePath -> RelFilePath -> RelFilePath
max :: RelFilePath -> RelFilePath -> RelFilePath
$cmin :: RelFilePath -> RelFilePath -> RelFilePath
min :: RelFilePath -> RelFilePath -> 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
$cfrom :: forall x. RelFilePath -> Rep RelFilePath x
from :: forall x. RelFilePath -> Rep RelFilePath x
$cto :: forall x. Rep RelFilePath x -> RelFilePath
to :: forall x. Rep RelFilePath x -> RelFilePath
Generic, Typeable, RelFilePath -> ()
(RelFilePath -> ()) -> NFData RelFilePath
forall a. (a -> ()) -> NFData a
$crnf :: RelFilePath -> ()
rnf :: RelFilePath -> ()
NFData, RelFilePath -> Text
RelFilePath -> Utf8Builder
(RelFilePath -> Utf8Builder)
-> (RelFilePath -> Text) -> Display RelFilePath
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
$cdisplay :: RelFilePath -> Utf8Builder
display :: RelFilePath -> Utf8Builder
$ctextDisplay :: RelFilePath -> Text
textDisplay :: RelFilePath -> Text
Display)

-- | Location that an archive is stored at

--

-- @since 0.1.0.0

data ArchiveLocation
  = ALUrl !Text
    -- ^ Archive stored at an HTTP(S) URL

    --

    -- @since 0.1.0.0

  | ALFilePath !(ResolvedPath File)
    -- ^ Archive stored at a local file path

    --

    -- @since 0.1.0.0

  deriving (Int -> ArchiveLocation -> ShowS
[ArchiveLocation] -> ShowS
ArchiveLocation -> [Char]
(Int -> ArchiveLocation -> ShowS)
-> (ArchiveLocation -> [Char])
-> ([ArchiveLocation] -> ShowS)
-> Show ArchiveLocation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArchiveLocation -> ShowS
showsPrec :: Int -> ArchiveLocation -> ShowS
$cshow :: ArchiveLocation -> [Char]
show :: ArchiveLocation -> [Char]
$cshowList :: [ArchiveLocation] -> ShowS
showList :: [ArchiveLocation] -> ShowS
Show, ArchiveLocation -> ArchiveLocation -> Bool
(ArchiveLocation -> ArchiveLocation -> Bool)
-> (ArchiveLocation -> ArchiveLocation -> Bool)
-> Eq ArchiveLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArchiveLocation -> ArchiveLocation -> Bool
== :: ArchiveLocation -> ArchiveLocation -> Bool
$c/= :: ArchiveLocation -> ArchiveLocation -> Bool
/= :: 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
$ccompare :: ArchiveLocation -> ArchiveLocation -> Ordering
compare :: ArchiveLocation -> ArchiveLocation -> Ordering
$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
>= :: ArchiveLocation -> ArchiveLocation -> Bool
$cmax :: ArchiveLocation -> ArchiveLocation -> ArchiveLocation
max :: ArchiveLocation -> ArchiveLocation -> ArchiveLocation
$cmin :: ArchiveLocation -> ArchiveLocation -> ArchiveLocation
min :: ArchiveLocation -> ArchiveLocation -> 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
$cfrom :: forall x. ArchiveLocation -> Rep ArchiveLocation x
from :: forall x. ArchiveLocation -> Rep ArchiveLocation x
$cto :: forall x. Rep ArchiveLocation x -> ArchiveLocation
to :: forall x. Rep ArchiveLocation x -> ArchiveLocation
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) =
    [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString ([Char] -> Utf8Builder) -> [Char] -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath (Path Abs File -> [Char]) -> Path Abs File -> [Char]
forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> Path Abs File
forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute ResolvedPath File
resolved

instance Pretty ArchiveLocation where
  pretty :: ArchiveLocation -> StyleDoc
pretty (ALUrl Text
url) = Style -> StyleDoc -> StyleDoc
style Style
Url ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url)
  pretty (ALFilePath ResolvedPath File
resolved) = Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty (Path Abs File -> StyleDoc) -> Path Abs File -> StyleDoc
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 a b.
WriterT WarningParserMonoid Parser a
-> (a -> WriterT WarningParserMonoid Parser b)
-> WriterT WarningParserMonoid Parser b
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 ([Char] -> WarningParser (Unresolved ArchiveLocation)
forall a. [Char] -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> [Char])
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation)
forall a. a -> WriterT WarningParserMonoid Parser a
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 a.
WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
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 a b.
WriterT WarningParserMonoid Parser a
-> (a -> WriterT WarningParserMonoid Parser b)
-> WriterT WarningParserMonoid Parser b
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 ([Char] -> WarningParser (Unresolved ArchiveLocation)
forall a. [Char] -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> [Char])
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation)
forall a. a -> WriterT WarningParserMonoid Parser a
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 a.
WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
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 a b.
WriterT WarningParserMonoid Parser a
-> (a -> WriterT WarningParserMonoid Parser b)
-> WriterT WarningParserMonoid Parser b
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 ([Char] -> WarningParser (Unresolved ArchiveLocation)
forall a. [Char] -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> [Char])
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation)
forall a. a -> WriterT WarningParserMonoid Parser a
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 a.
WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
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 a b.
WriterT WarningParserMonoid Parser a
-> (a -> WriterT WarningParserMonoid Parser b)
-> WriterT WarningParserMonoid Parser b
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 ([Char] -> WarningParser (Unresolved ArchiveLocation)
forall a. [Char] -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> [Char])
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation)
forall a. a -> WriterT WarningParserMonoid Parser a
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 [Char] -> Either SomeException Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest ([Char] -> Either SomeException Request)
-> [Char] -> Either SomeException Request
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
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 a. a -> Either Text a
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 a. a -> Unresolved a
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 -> Text -> Bool
`T.isSuffixOf` Text
t) (Text -> [Text]
T.words Text
".zip .tar .tar.gz")
    then Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
forall a. a -> Either Text a
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
$ \case
      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 -> [Char] -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> [Char] -> m (Path Abs File)
resolveFile Path Abs Dir
dir ([Char] -> IO (Path Abs File)) -> [Char] -> IO (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t
        ArchiveLocation -> IO ArchiveLocation
forall a. a -> IO a
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 a b. (a -> b) -> Parser a -> Parser b
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 a b. (a -> b) -> WithJSONWarnings a -> WithJSONWarnings b
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 a b. (a -> b) -> Unresolved a -> Unresolved b
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 a b. (a -> b) -> NonEmpty a -> NonEmpty b
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 a. Parser a -> Parser a -> Parser a
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 -> [Char] -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> [Char] -> m (Path Abs Dir)
resolveDir Path Abs Dir
dir ([Char] -> IO (Path Abs Dir)) -> [Char] -> IO (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t
          NonEmpty RawPackageLocation -> IO (NonEmpty RawPackageLocation)
forall a. a -> IO a
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 a. a -> NonEmpty a
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) = [(AesonKey, Value)] -> Value
object ([(AesonKey, Value)] -> Value) -> [(AesonKey, Value)] -> Value
forall a b. (a -> b) -> a -> b
$
    (AesonKey
"hackage" AesonKey -> PackageIdentifierRevision -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= PackageIdentifierRevision
pir) (AesonKey, Value) -> [(AesonKey, Value)] -> [(AesonKey, Value)]
forall a. a -> [a] -> [a]
: [(AesonKey, Value)]
-> (TreeKey -> [(AesonKey, Value)])
-> Maybe TreeKey
-> [(AesonKey, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\TreeKey
tree -> [AesonKey
"pantry-tree" AesonKey -> TreeKey -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= TreeKey
tree]) Maybe TreeKey
mtree
  toJSON (RPLIArchive (RawArchive ArchiveLocation
loc Maybe SHA256
msha Maybe FileSize
msize Text
subdir) RawPackageMetadata
rpm) = [(AesonKey, Value)] -> Value
object ([(AesonKey, Value)] -> Value) -> [(AesonKey, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(AesonKey, Value)]] -> [(AesonKey, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ case ArchiveLocation
loc of
        ALUrl Text
url -> [AesonKey
"url" AesonKey -> Text -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= Text
url]
        ALFilePath ResolvedPath File
resolved -> [AesonKey
"filepath" AesonKey -> RelFilePath -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved]
    , [(AesonKey, Value)]
-> (SHA256 -> [(AesonKey, Value)])
-> Maybe SHA256
-> [(AesonKey, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\SHA256
sha -> [AesonKey
"sha256" AesonKey -> SHA256 -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= SHA256
sha]) Maybe SHA256
msha
    , [(AesonKey, Value)]
-> (FileSize -> [(AesonKey, Value)])
-> Maybe FileSize
-> [(AesonKey, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FileSize
size' -> [AesonKey
"size" AesonKey -> FileSize -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= FileSize
size']) Maybe FileSize
msize
    , [ AesonKey
"subdir" AesonKey -> Text -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= Text
subdir | Bool -> Bool
not (Text -> Bool
T.null Text
subdir) ]
    , RawPackageMetadata -> [(AesonKey, Value)]
rpmToPairs RawPackageMetadata
rpm
    ]
  toJSON (RPLIRepo (Repo Text
url Text
commit RepoType
typ Text
subdir) RawPackageMetadata
rpm) = [(AesonKey, Value)] -> Value
object ([(AesonKey, Value)] -> Value) -> [(AesonKey, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(AesonKey, Value)]] -> [(AesonKey, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [ AesonKey
urlKey AesonKey -> Text -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= Text
url
      , AesonKey
"commit" AesonKey -> Text -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= Text
commit
      ]
    , [AesonKey
"subdir" AesonKey -> Text -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= Text
subdir | Bool -> Bool
not (Text -> Bool
T.null Text
subdir) ]
    , RawPackageMetadata -> [(AesonKey, Value)]
rpmToPairs RawPackageMetadata
rpm
    ]
   where
    urlKey :: AesonKey
urlKey =
      case RepoType
typ of
        RepoType
RepoGit -> AesonKey
"git"
        RepoType
RepoHg  -> AesonKey
"hg"

rpmToPairs :: RawPackageMetadata -> [(AesonKey, Value)]
rpmToPairs :: RawPackageMetadata -> [(AesonKey, Value)]
rpmToPairs (RawPackageMetadata Maybe PackageName
mname Maybe Version
mversion Maybe TreeKey
mtree) = [[(AesonKey, Value)]] -> [(AesonKey, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [(AesonKey, Value)]
-> (PackageName -> [(AesonKey, Value)])
-> Maybe PackageName
-> [(AesonKey, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PackageName
name -> [AesonKey
"name" AesonKey -> CabalString PackageName -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString PackageName
name]) Maybe PackageName
mname
  , [(AesonKey, Value)]
-> (Version -> [(AesonKey, Value)])
-> Maybe Version
-> [(AesonKey, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Version
version -> [AesonKey
"version" AesonKey -> CabalString Version -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= Version -> CabalString Version
forall a. a -> CabalString a
CabalString Version
version]) Maybe Version
mversion
  , [(AesonKey, Value)]
-> (TreeKey -> [(AesonKey, Value)])
-> Maybe TreeKey
-> [(AesonKey, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\TreeKey
tree -> [AesonKey
"pantry-tree" AesonKey -> TreeKey -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= TreeKey
tree]) Maybe TreeKey
mtree
  ]

instance FromJSON (WithJSONWarnings (Unresolved PackageLocationImmutable)) where
  parseJSON :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
parseJSON Value
v =
        Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
repoObject Value
v
    Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a. Parser a -> Parser a -> Parser a
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 a. Parser a -> Parser a -> Parser a
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 a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
github Value
v
    Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char]
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Could not parse a UnresolvedPackageLocationImmutable from: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v)
   where
    repoObject ::
         Value
      -> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
    repoObject :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
repoObject =
      [Char]
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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 a b.
WriterT WarningParserMonoid Parser a
-> (a -> WriterT WarningParserMonoid Parser b)
-> WriterT WarningParserMonoid Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
url -> (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall a. a -> WriterT WarningParserMonoid Parser a
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 a.
WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
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 a b.
WriterT WarningParserMonoid Parser a
-> (a -> WriterT WarningParserMonoid Parser b)
-> WriterT WarningParserMonoid Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
url -> (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RepoType
RepoHg, Text
url))
        Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall a. a -> WriterT WarningParserMonoid Parser a
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 a. a -> Unresolved a
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
RepoType
repoUrl :: Text
repoCommit :: Text
repoSubdir :: Text
repoType :: RepoType
repoSubdir :: Text
repoCommit :: Text
repoType :: RepoType
repoUrl :: Text
..} PackageMetadata
pm

    archiveObject :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
archiveObject =
      [Char]
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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 a. a -> WriterT WarningParserMonoid Parser a
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 a. a -> IO a
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 {Text
SHA256
ArchiveLocation
FileSize
archiveLocation :: ArchiveLocation
archiveSubdir :: Text
archiveHash :: SHA256
archiveSize :: FileSize
archiveHash :: SHA256
archiveSize :: FileSize
archiveSubdir :: Text
archiveLocation :: ArchiveLocation
..} PackageMetadata
pm

    hackageObject :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
hackageObject =
      [Char]
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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 -> [Char] -> WarningParser (Unresolved PackageLocationImmutable)
forall a. [Char] -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> WarningParser (Unresolved PackageLocationImmutable))
-> [Char] -> WarningParser (Unresolved PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ PantryException -> [Char]
forall a. Show a => a -> [Char]
show PantryException
e
          Right (PackageIdentifier
pkgIdentifier, BlobKey
blobKey) ->
            Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall a. a -> WriterT WarningParserMonoid Parser a
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 a. a -> Unresolved a
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 (Unresolved PackageLocationImmutable))
github =
      [Char]
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"UnresolvedPackagelocationimmutable.PLIArchive:github" (\Object
o -> do
        PackageMetadata
pm <- Object -> WarningParser PackageMetadata
parsePackageMetadata Object
o
        GitHubRepo Text
ghRepo <- Object
o 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
""
        Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall a. a -> WriterT WarningParserMonoid Parser a
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 a. a -> Unresolved a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageLocationImmutable -> Unresolved PackageLocationImmutable)
-> PackageLocationImmutable -> Unresolved PackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ Archive -> PackageMetadata -> PackageLocationImmutable
PLIArchive Archive {Text
SHA256
ArchiveLocation
FileSize
archiveLocation :: ArchiveLocation
archiveSubdir :: Text
archiveHash :: SHA256
archiveSize :: FileSize
archiveLocation :: ArchiveLocation
archiveHash :: SHA256
archiveSize :: FileSize
archiveSubdir :: Text
..} PackageMetadata
pm)

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 a. Parser a -> Parser a -> Parser a
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 a. Parser a -> Parser a -> Parser a
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 a. Parser a -> Parser a -> Parser a
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 a. Parser a -> Parser a -> Parser a
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 a. Parser a -> Parser a -> Parser a
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 a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char]
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Could not parse a UnresolvedRawPackageLocationImmutable from: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v)
   where
    http :: Value -> Parser (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable)))
    http :: Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
http = [Char]
-> (Text
    -> Parser
         (WithJSONWarnings
            (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"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
_ -> [Char]
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> [Char]
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid archive location: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t
        Right (Unresolved Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation) ->
          WithJSONWarnings
  (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. a -> Parser a
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 a. a -> IO a
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 a. a -> NonEmpty a
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 {Maybe SHA256
Maybe FileSize
Text
ArchiveLocation
forall a. Maybe a
raLocation :: ArchiveLocation
raSubdir :: Text
raHash :: Maybe SHA256
raSize :: Maybe FileSize
raLocation :: ArchiveLocation
raHash :: forall a. Maybe a
raSize :: forall a. Maybe a
raSubdir :: Text
..} RawPackageMetadata
rpmEmpty

    hackageText :: Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
hackageText = [Char]
-> (Text
    -> Parser
         (WithJSONWarnings
            (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"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 -> [Char]
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> [Char]
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ PantryException -> [Char]
forall a. Show a => a -> [Char]
show PantryException
e
        Right PackageIdentifierRevision
pir -> WithJSONWarnings
  (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. a -> Parser a
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 a. a -> Unresolved a
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 a. a -> NonEmpty a
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 = [Char]
-> (Object
    -> WarningParser
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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 a. a -> Unresolved a
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 a. a -> NonEmpty a
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 a b.
WriterT WarningParserMonoid Parser (a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
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 =
      -- if subdirs exists, it needs to be valid

      case AesonKey -> Object -> Maybe Value
forall v. AesonKey -> KeyMap v -> Maybe v
HM.lookup AesonKey
"subdirs" Object
o of
        Just Value
v' -> do
          Text -> WarningParser ()
tellJSONField Text
"subdirs"
          [Text]
subdirs <- Parser [Text] -> WarningParser [Text]
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT WarningParserMonoid m a
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 -> [Char] -> WarningParser OptionalSubdirs
forall a. [Char] -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid empty subdirs"
            Just NonEmpty Text
x -> OptionalSubdirs -> WarningParser OptionalSubdirs
forall a. a -> WriterT WarningParserMonoid Parser a
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 a b.
WriterT WarningParserMonoid Parser (a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b.
WriterT WarningParserMonoid Parser (a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((CabalString Version -> Version)
-> Maybe (CabalString Version) -> Maybe Version
forall a b. (a -> b) -> Maybe a -> Maybe b
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 a b.
WriterT WarningParserMonoid Parser (a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
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 a b.
WriterT WarningParserMonoid Parser (a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
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 = [Char]
-> (Object
    -> WarningParser
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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 a.
WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
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 a. a -> WriterT WarningParserMonoid Parser a
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 a. a -> Unresolved a
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
RepoType
repoUrl :: Text
repoCommit :: Text
repoSubdir :: Text
repoType :: RepoType
repoType :: RepoType
repoUrl :: Text
repoCommit :: Text
repoSubdir :: Text
..} RawPackageMetadata
pm) (OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
osToRpms OptionalSubdirs
os)

    archiveObject :: Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
archiveObject = [Char]
-> (Object
    -> WarningParser
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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 a. a -> WriterT WarningParserMonoid Parser a
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 a. a -> IO a
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 {Maybe SHA256
Maybe FileSize
Text
ArchiveLocation
raLocation :: ArchiveLocation
raSubdir :: Text
raHash :: Maybe SHA256
raSize :: Maybe FileSize
raHash :: Maybe SHA256
raSize :: Maybe FileSize
raLocation :: ArchiveLocation
raSubdir :: Text
..} RawPackageMetadata
pm) (OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
osToRpms OptionalSubdirs
os)

    github :: Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
github = [Char]
-> (Object
    -> WarningParser
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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 a. a -> WriterT WarningParserMonoid Parser a
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 a. a -> Unresolved a
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 {Maybe SHA256
Maybe FileSize
Text
ArchiveLocation
raLocation :: ArchiveLocation
raSubdir :: Text
raHash :: Maybe SHA256
raSize :: Maybe FileSize
raLocation :: ArchiveLocation
raHash :: Maybe SHA256
raSize :: Maybe FileSize
raSubdir :: Text
..} RawPackageMetadata
pm) (OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
osToRpms OptionalSubdirs
os)

-- | Returns pairs of subdirectory and 'PackageMetadata'.

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 a. a -> NonEmpty a
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 wrapper for easier JSON integration with Cabal types.

--

-- @since 0.1.0.0

newtype CabalString a = CabalString { forall a. CabalString a -> a
unCabalString :: a }
  deriving (Int -> CabalString a -> ShowS
[CabalString a] -> ShowS
CabalString a -> [Char]
(Int -> CabalString a -> ShowS)
-> (CabalString a -> [Char])
-> ([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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CabalString a -> ShowS
showsPrec :: Int -> CabalString a -> ShowS
$cshow :: forall a. Show a => CabalString a -> [Char]
show :: CabalString a -> [Char]
$cshowList :: forall a. Show a => [CabalString a] -> ShowS
showList :: [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
$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
/= :: 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
$ccompare :: forall a. Ord a => CabalString a -> CabalString a -> Ordering
compare :: CabalString a -> CabalString a -> Ordering
$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
>= :: CabalString a -> CabalString a -> Bool
$cmax :: forall a. Ord a => CabalString a -> CabalString a -> CabalString a
max :: CabalString a -> CabalString a -> CabalString a
$cmin :: forall a. Ord a => CabalString a -> CabalString a -> CabalString a
min :: CabalString a -> CabalString a -> CabalString a
Ord, Typeable)

-- I'd like to use coerce here, but can't due to roles. unsafeCoerce

-- could work, but let's avoid unsafe code.


-- | Wrap the keys in a 'Map' with a 'CabalString' to get a 'ToJSON'

-- instance.

--

-- @since 0.1.0.0

toCabalStringMap :: Map a v -> Map (CabalString a) v
toCabalStringMap :: forall a v. 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

-- | Unwrap the 'CabalString' from the keys in a 'Map' to use a

-- 'FromJSON' instance.

--

-- @since 0.1.0.0

unCabalStringMap :: Map (CabalString a) v -> Map a v
unCabalStringMap :: forall a v. 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 = [Char] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Char] -> Value)
-> (CabalString a -> [Char]) -> CabalString a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Pretty a => a -> [Char]
Distribution.Text.display (a -> [Char]) -> (CabalString a -> a) -> CabalString a -> [Char]
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
$ [Char] -> Text
T.pack ([Char] -> Text)
-> (CabalString a -> [Char]) -> CabalString a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Pretty a => a -> [Char]
Distribution.Text.display (a -> [Char]) -> (CabalString a -> a) -> CabalString a -> [Char]
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 = [Char]
-> (Text -> Parser (CabalString a))
-> Value
-> Parser (CabalString a)
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
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 [Char] -> Maybe a
forall a. IsCabalString a => [Char] -> Maybe a
cabalStringParser ([Char] -> Maybe a) -> [Char] -> Maybe a
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t of
      Maybe a
Nothing -> [Char] -> Parser (CabalString a)
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser (CabalString a))
-> [Char] -> Parser (CabalString a)
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t
      Just a
x -> CabalString a -> Parser (CabalString a)
forall a. a -> Parser 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 :: [Char]
name = Maybe a -> [Char]
forall a (proxy :: * -> *). IsCabalString a => proxy a -> [Char]
forall (proxy :: * -> *). proxy a -> [Char]
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 [Char] -> Maybe a
forall a. IsCabalString a => [Char] -> Maybe a
cabalStringParser ([Char] -> Maybe a) -> [Char] -> Maybe a
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t of
      Maybe a
Nothing -> [Char] -> Parser (CabalString a)
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser (CabalString a))
-> [Char] -> Parser (CabalString a)
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t
      Just a
x -> CabalString a -> Parser (CabalString a)
forall a. a -> Parser 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 :: [Char]
name = Maybe a -> [Char]
forall a (proxy :: * -> *). IsCabalString a => proxy a -> [Char]
forall (proxy :: * -> *). proxy a -> [Char]
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 :: forall (proxy :: * -> *). proxy PackageName -> [Char]
cabalStringName proxy PackageName
_ = [Char]
"package name"
  cabalStringParser :: [Char] -> Maybe PackageName
cabalStringParser = [Char] -> Maybe PackageName
parsePackageName

instance IsCabalString Version where
  cabalStringName :: forall (proxy :: * -> *). proxy Version -> [Char]
cabalStringName proxy Version
_ = [Char]
"version"
  cabalStringParser :: [Char] -> Maybe Version
cabalStringParser = [Char] -> Maybe Version
parseVersion

instance IsCabalString VersionRange where
  cabalStringName :: forall (proxy :: * -> *). proxy VersionRange -> [Char]
cabalStringName proxy VersionRange
_ = [Char]
"version range"
  cabalStringParser :: [Char] -> Maybe VersionRange
cabalStringParser = [Char] -> Maybe VersionRange
parseVersionRange

instance IsCabalString PackageIdentifier where
  cabalStringName :: forall (proxy :: * -> *). proxy PackageIdentifier -> [Char]
cabalStringName proxy PackageIdentifier
_ = [Char]
"package identifier"
  cabalStringParser :: [Char] -> Maybe PackageIdentifier
cabalStringParser = [Char] -> Maybe PackageIdentifier
parsePackageIdentifier

instance IsCabalString FlagName where
  cabalStringName :: forall (proxy :: * -> *). proxy FlagName -> [Char]
cabalStringName proxy FlagName
_ = [Char]
"flag name"
  cabalStringParser :: [Char] -> Maybe FlagName
cabalStringParser = [Char] -> Maybe FlagName
parseFlagName

-- | What to use for running hpack

--

-- @since 0.1.0.0

data HpackExecutable
  = HpackBundled
    -- ^ Compiled in library

  | HpackCommand !FilePath
    -- ^ Executable at the provided path

  deriving (Int -> HpackExecutable -> ShowS
[HpackExecutable] -> ShowS
HpackExecutable -> [Char]
(Int -> HpackExecutable -> ShowS)
-> (HpackExecutable -> [Char])
-> ([HpackExecutable] -> ShowS)
-> Show HpackExecutable
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HpackExecutable -> ShowS
showsPrec :: Int -> HpackExecutable -> ShowS
$cshow :: HpackExecutable -> [Char]
show :: HpackExecutable -> [Char]
$cshowList :: [HpackExecutable] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS HpackExecutable
readsPrec :: Int -> ReadS HpackExecutable
$creadList :: ReadS [HpackExecutable]
readList :: ReadS [HpackExecutable]
$creadPrec :: ReadPrec HpackExecutable
readPrec :: ReadPrec HpackExecutable
$creadListPrec :: ReadPrec [HpackExecutable]
readListPrec :: ReadPrec [HpackExecutable]
Read, HpackExecutable -> HpackExecutable -> Bool
(HpackExecutable -> HpackExecutable -> Bool)
-> (HpackExecutable -> HpackExecutable -> Bool)
-> Eq HpackExecutable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HpackExecutable -> HpackExecutable -> Bool
== :: HpackExecutable -> HpackExecutable -> Bool
$c/= :: HpackExecutable -> HpackExecutable -> Bool
/= :: 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
$ccompare :: HpackExecutable -> HpackExecutable -> Ordering
compare :: HpackExecutable -> HpackExecutable -> Ordering
$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
>= :: HpackExecutable -> HpackExecutable -> Bool
$cmax :: HpackExecutable -> HpackExecutable -> HpackExecutable
max :: HpackExecutable -> HpackExecutable -> HpackExecutable
$cmin :: HpackExecutable -> HpackExecutable -> HpackExecutable
min :: HpackExecutable -> HpackExecutable -> HpackExecutable
Ord)


-- | Which compiler a snapshot wants to use. The build tool may elect to do some

-- fuzzy matching of versions (e.g., allowing different patch versions).

--

-- @since 0.1.0.0

data WantedCompiler
  = WCGhc !Version
  | WCGhcGit !Text !Text
  | WCGhcjs
      !Version
      !Version
    -- ^ GHCJS version followed by GHC version

  deriving (Int -> WantedCompiler -> ShowS
[WantedCompiler] -> ShowS
WantedCompiler -> [Char]
(Int -> WantedCompiler -> ShowS)
-> (WantedCompiler -> [Char])
-> ([WantedCompiler] -> ShowS)
-> Show WantedCompiler
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WantedCompiler -> ShowS
showsPrec :: Int -> WantedCompiler -> ShowS
$cshow :: WantedCompiler -> [Char]
show :: WantedCompiler -> [Char]
$cshowList :: [WantedCompiler] -> ShowS
showList :: [WantedCompiler] -> ShowS
Show, WantedCompiler -> WantedCompiler -> Bool
(WantedCompiler -> WantedCompiler -> Bool)
-> (WantedCompiler -> WantedCompiler -> Bool) -> Eq WantedCompiler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WantedCompiler -> WantedCompiler -> Bool
== :: WantedCompiler -> WantedCompiler -> Bool
$c/= :: WantedCompiler -> WantedCompiler -> Bool
/= :: 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
$ccompare :: WantedCompiler -> WantedCompiler -> Ordering
compare :: WantedCompiler -> WantedCompiler -> Ordering
$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
>= :: WantedCompiler -> WantedCompiler -> Bool
$cmax :: WantedCompiler -> WantedCompiler -> WantedCompiler
max :: WantedCompiler -> WantedCompiler -> WantedCompiler
$cmin :: WantedCompiler -> WantedCompiler -> WantedCompiler
min :: WantedCompiler -> WantedCompiler -> 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
$cfrom :: forall x. WantedCompiler -> Rep WantedCompiler x
from :: forall x. WantedCompiler -> Rep WantedCompiler x
$cto :: forall x. Rep WantedCompiler x -> WantedCompiler
to :: forall x. Rep WantedCompiler x -> WantedCompiler
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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
versionString Version
vghc)
  display (WCGhcjs Version
vghcjs Version
vghc) =
       Utf8Builder
"ghcjs-"
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
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
<> [Char] -> Utf8Builder
forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
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 =
    [Char]
-> (Text -> Parser WantedCompiler)
-> Value
-> Parser WantedCompiler
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"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 ([Char] -> Parser WantedCompiler
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser WantedCompiler)
-> (PantryException -> [Char])
-> PantryException
-> Parser WantedCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PantryException -> [Char]
forall a. Show a => a -> [Char]
show) WantedCompiler -> Parser WantedCompiler
forall a. a -> Parser a
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 -> [Char] -> Parser WantedCompiler
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser WantedCompiler)
-> [Char] -> Parser WantedCompiler
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid WantedCompiler " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PantryException -> [Char]
forall a. Show a => a -> [Char]
show PantryException
e
      Right WantedCompiler
x -> WantedCompiler -> Parser WantedCompiler
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WantedCompiler
x

-- | Parse a 'Text' into a 'WantedCompiler' value.

--

-- @since 0.1.0.0

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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 <- [Char] -> Maybe Version
parseVersion ([Char] -> Maybe Version) -> [Char] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
ghcjsVT
    Text
ghcVT <- Text -> Text -> Maybe Text
T.stripPrefix Text
"_ghc-" Text
t2
    Version
ghcV <- [Char] -> Maybe Version
parseVersion ([Char] -> Maybe Version) -> [Char] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
ghcVT
    WantedCompiler -> Maybe WantedCompiler
forall a. a -> Maybe a
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 a. a -> f a
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 a b. (a -> b) -> Maybe a -> Maybe b
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
. [Char] -> Maybe Version
parseVersion ([Char] -> Maybe Version)
-> (Text -> [Char]) -> Text -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

instance FromJSON (WithJSONWarnings (Unresolved RawSnapshotLocation)) where
  parseJSON :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
parseJSON Value
v = Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
text Value
v Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall a. Parser a -> Parser a -> Parser a
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 =
      [Char]
-> (Text
    -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"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 a. a -> Parser a
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 = [Char]
-> (Object -> WarningParser (Unresolved RawSnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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 a. a -> Unresolved a
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 a.
WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      ((\Text
x Maybe BlobKey
y -> RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall a. a -> Unresolved a
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 a b.
WriterT WarningParserMonoid Parser (a -> b)
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
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 a.
WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
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 a. a -> WriterT WarningParserMonoid Parser a
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 a. a -> WriterT WarningParserMonoid Parser a
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) -> [Char] -> WarningParser (Maybe BlobKey)
forall a. [Char] -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"You must also specify the file size"
        (Maybe SHA256
Nothing, Just FileSize
_) -> [Char] -> WarningParser (Maybe BlobKey)
forall a. [Char] -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"You must also specify the file's SHA256"

instance Display SnapshotLocation where
  display :: SnapshotLocation -> Utf8Builder
display (SLCompiler WantedCompiler
compiler) = 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)

-- | Parse a 'Text' into an 'Unresolved' 'RawSnapshotLocation'.

--

-- @since 0.1.0.0

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 a. a -> Unresolved a
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 a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall a. a -> Unresolved a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> Unresolved RawSnapshotLocation)
-> (SnapName -> RawSnapshotLocation)
-> SnapName
-> Unresolved RawSnapshotLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
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 a. a -> Unresolved a
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 = [Char] -> Maybe Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest (Text -> [Char]
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 a. a -> Unresolved a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe BlobKey -> RawSnapshotLocation
RSLUrl Text
t0 Maybe BlobKey
forall a. Maybe a
Nothing)

parseLocationPath ::
     (Text -> PantryException)
  -> (Path Abs Dir -> Text -> PantryException)
  -> (ResolvedPath File -> a)
  -> Text
  -> Unresolved a
parseLocationPath :: forall a.
(Text -> PantryException)
-> (Path Abs Dir -> Text -> PantryException)
-> (ResolvedPath File -> a)
-> Text
-> Unresolved a
parseLocationPath Text -> PantryException
invalidPath Path Abs Dir -> Text -> PantryException
invalidLocation ResolvedPath File -> a
resolver Text
t =
  (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)
-> (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
forall a b. (a -> b) -> a -> b
$ \case
    Maybe (Path Abs Dir)
Nothing -> PantryException -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PantryException -> IO a) -> PantryException -> IO a
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
invalidPath Text
t
    Just Path Abs Dir
dir -> do
      Path Abs File
abs' <- Path Abs Dir -> [Char] -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> [Char] -> m (Path Abs File)
resolveFile Path Abs Dir
dir (Text -> [Char]
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
invalidLocation Path Abs Dir
dir Text
t)
      a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> a
resolver (ResolvedPath File -> a) -> ResolvedPath File -> a
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'

parseRawSnapshotLocationPath :: Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath :: Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath = (Text -> PantryException)
-> (Path Abs Dir -> Text -> PantryException)
-> (ResolvedPath File -> RawSnapshotLocation)
-> Text
-> Unresolved RawSnapshotLocation
forall a.
(Text -> PantryException)
-> (Path Abs Dir -> Text -> PantryException)
-> (ResolvedPath File -> a)
-> Text
-> Unresolved a
parseLocationPath
  Text -> PantryException
InvalidFilePathSnapshot
  Path Abs Dir -> Text -> PantryException
InvalidSnapshotLocation
  ResolvedPath File -> RawSnapshotLocation
RSLFilePath

githubLocation :: Text -> Text -> Text -> Text
githubLocation :: Text -> Text -> Text -> Text
githubLocation Text
user Text
repo Text
path =[Text] -> Text
T.concat
  [ Text
"https://raw.githubusercontent.com/"
  , Text
user
  , Text
"/"
  , Text
repo
  , Text
"/master/"
  , Text
path
  ]

githubSnapshotLocation :: Text -> Text -> Text -> RawSnapshotLocation
githubSnapshotLocation :: Text -> Text -> Text -> RawSnapshotLocation
githubSnapshotLocation Text
user Text
repo Text
path =
  Text -> Maybe BlobKey -> RawSnapshotLocation
RSLUrl (Text -> Text -> Text -> Text
githubLocation Text
user Text
repo Text
path) Maybe BlobKey
forall a. Maybe a
Nothing

-- | Parse a 'Text' into an 'Unresolved' 'GlobalHintsLocation'.

--

-- @since 0.9.4

parseGlobalHintsLocation :: Text -> Unresolved GlobalHintsLocation
parseGlobalHintsLocation :: Text -> Unresolved GlobalHintsLocation
parseGlobalHintsLocation Text
t0 = Unresolved GlobalHintsLocation
-> Maybe (Unresolved GlobalHintsLocation)
-> Unresolved GlobalHintsLocation
forall a. a -> Maybe a -> a
fromMaybe (Text -> Unresolved GlobalHintsLocation
parseGlobalHintsLocationPath Text
t0) (Maybe (Unresolved GlobalHintsLocation)
 -> Unresolved GlobalHintsLocation)
-> Maybe (Unresolved GlobalHintsLocation)
-> Unresolved GlobalHintsLocation
forall a b. (a -> b) -> a -> b
$
  Maybe (Unresolved GlobalHintsLocation)
parseGitHub Maybe (Unresolved GlobalHintsLocation)
-> Maybe (Unresolved GlobalHintsLocation)
-> Maybe (Unresolved GlobalHintsLocation)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Unresolved GlobalHintsLocation)
parseUrl
 where
  parseGitHub :: Maybe (Unresolved GlobalHintsLocation)
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 GlobalHintsLocation
-> Maybe (Unresolved GlobalHintsLocation)
forall a. a -> Maybe a
Just (Unresolved GlobalHintsLocation
 -> Maybe (Unresolved GlobalHintsLocation))
-> Unresolved GlobalHintsLocation
-> Maybe (Unresolved GlobalHintsLocation)
forall a b. (a -> b) -> a -> b
$ GlobalHintsLocation -> Unresolved GlobalHintsLocation
forall a. a -> Unresolved a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GlobalHintsLocation -> Unresolved GlobalHintsLocation)
-> GlobalHintsLocation -> Unresolved GlobalHintsLocation
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> GlobalHintsLocation
githubGlobalHintsLocation Text
user Text
repo Text
path

  parseUrl :: Maybe (Unresolved GlobalHintsLocation)
parseUrl = [Char] -> Maybe Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest (Text -> [Char]
T.unpack Text
t0) Maybe Request
-> Unresolved GlobalHintsLocation
-> Maybe (Unresolved GlobalHintsLocation)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> GlobalHintsLocation -> Unresolved GlobalHintsLocation
forall a. a -> Unresolved a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> GlobalHintsLocation
GHLUrl Text
t0)

parseGlobalHintsLocationPath :: Text -> Unresolved GlobalHintsLocation
parseGlobalHintsLocationPath :: Text -> Unresolved GlobalHintsLocation
parseGlobalHintsLocationPath = (Text -> PantryException)
-> (Path Abs Dir -> Text -> PantryException)
-> (ResolvedPath File -> GlobalHintsLocation)
-> Text
-> Unresolved GlobalHintsLocation
forall a.
(Text -> PantryException)
-> (Path Abs Dir -> Text -> PantryException)
-> (ResolvedPath File -> a)
-> Text
-> Unresolved a
parseLocationPath
  Text -> PantryException
InvalidFilePathGlobalHints
  Path Abs Dir -> Text -> PantryException
InvalidGlobalHintsLocation
  ResolvedPath File -> GlobalHintsLocation
GHLFilePath

githubGlobalHintsLocation :: Text -> Text -> Text -> GlobalHintsLocation
githubGlobalHintsLocation :: Text -> Text -> Text -> GlobalHintsLocation
githubGlobalHintsLocation Text
user Text
repo Text
path =
  Text -> GlobalHintsLocation
GHLUrl (Text -> Text -> Text -> Text
githubLocation Text
user Text
repo Text
path)

defUser :: Text
defUser :: Text
defUser = Text
"commercialhaskell"

defRepo :: Text
defRepo :: Text
defRepo = Text
"stackage-snapshots"

defGlobalHintsRepo :: Text
defGlobalHintsRepo :: Text
defGlobalHintsRepo = Text
"stackage-content"

-- | Default location of snapshot synonyms, i.e. commercialhaskell's GitHub

-- repository.

--

-- @since 0.5.0.0

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
<> Year -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Year
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
  (Year
year, Int
month, Int
day) = Day -> (Year, Int, Int)
toGregorian Day
date

-- | Default location of global hints, i.e. commercialhaskell's GitHub

-- repository.

--

-- @since 0.9.4

defaultGlobalHintsLocation ::
     WantedCompiler
  -> GlobalHintsLocation
defaultGlobalHintsLocation :: WantedCompiler -> GlobalHintsLocation
defaultGlobalHintsLocation WantedCompiler
_ =
  Text -> Text -> Text -> GlobalHintsLocation
githubGlobalHintsLocation Text
defUser Text
defGlobalHintsRepo (Text -> GlobalHintsLocation) -> Text -> GlobalHintsLocation
forall a b. (a -> b) -> a -> b
$
    Utf8Builder -> Text
utf8BuilderToText Utf8Builder
"stack/global-hints.yaml"

-- | A snapshot synonym. It is expanded according to the field

-- 'snapshotLocation' of a 'PantryConfig'.

--

-- @ since 0.5.0.0

data SnapName
    = LTS
        !Int -- ^ Major version

        !Int -- ^ Minor version

      -- ^ LTS Haskell snapshot, displayed as @"lts-maj.min"@.

      --

      -- @since 0.5.0.0

    | Nightly !Day
      -- ^ Stackage Nightly snapshot, displayed as @"nighly-YYYY-MM-DD"@.

      --

      -- @since 0.5.0.0

    deriving (SnapName -> SnapName -> Bool
(SnapName -> SnapName -> Bool)
-> (SnapName -> SnapName -> Bool) -> Eq SnapName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapName -> SnapName -> Bool
== :: SnapName -> SnapName -> Bool
$c/= :: SnapName -> SnapName -> Bool
/= :: 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
$ccompare :: SnapName -> SnapName -> Ordering
compare :: SnapName -> SnapName -> Ordering
$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
>= :: SnapName -> SnapName -> Bool
$cmax :: SnapName -> SnapName -> SnapName
max :: SnapName -> SnapName -> SnapName
$cmin :: SnapName -> SnapName -> SnapName
min :: SnapName -> SnapName -> 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
$cfrom :: forall x. SnapName -> Rep SnapName x
from :: forall x. SnapName -> Rep SnapName x
$cto :: forall x. Rep SnapName x -> SnapName
to :: forall x. Rep SnapName x -> SnapName
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 -> [Char]
show = Text -> [Char]
T.unpack (Text -> [Char]) -> (SnapName -> Text) -> SnapName -> [Char]
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

-- | Parse the short representation of a 'SnapName'.

--

-- @since 0.5.0.0

parseSnapName :: MonadThrow m => Text -> m SnapName
parseSnapName :: forall (m :: * -> *). MonadThrow m => Text -> m SnapName
parseSnapName Text
t0 =
  case Maybe SnapName
lts Maybe SnapName -> Maybe SnapName -> Maybe SnapName
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SnapName
nightly of
    Maybe SnapName
Nothing -> PantryException -> m SnapName
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, 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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 [Char] (Int, Text) -> Maybe (Either [Char] (Int, Text))
forall a. a -> Maybe a
Just (Either [Char] (Int, Text) -> Maybe (Either [Char] (Int, Text)))
-> Either [Char] (Int, Text) -> Maybe (Either [Char] (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 [Char] (Int, Text) -> Maybe (Either [Char] (Int, Text))
forall a. a -> Maybe a
Just (Either [Char] (Int, Text) -> Maybe (Either [Char] (Int, Text)))
-> Either [Char] (Int, Text) -> Maybe (Either [Char] (Int, Text))
forall a b. (a -> b) -> a -> b
$ Reader Int
forall a. Integral a => Reader a
decimal Text
t3
    SnapName -> Maybe SnapName
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
<$> [Char] -> Maybe Day
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
t1)

-- | Where to load a snapshot from in raw form (RSUrl could have a missing

-- BlobKey)

--

-- @since 0.1.0.0

data RawSnapshotLocation
  = RSLCompiler !WantedCompiler
    -- ^ Don't use an actual snapshot, just a version of the compiler with its

    -- shipped packages.

    --

    -- @since 0.1.0.0

  | RSLUrl !Text !(Maybe BlobKey)
    -- ^ Download the snapshot from the given URL. The optional 'BlobKey' is

    -- used for reproducibility.

    --

    -- @since 0.1.0.0

  | RSLFilePath !(ResolvedPath File)
    -- ^ Snapshot at a local file path.

    --

    -- @since 0.1.0.0

  | RSLSynonym !SnapName
    -- ^ Snapshot synonym (LTS/Nightly).

    --

    -- @since 0.5.0.0

  deriving (Int -> RawSnapshotLocation -> ShowS
[RawSnapshotLocation] -> ShowS
RawSnapshotLocation -> [Char]
(Int -> RawSnapshotLocation -> ShowS)
-> (RawSnapshotLocation -> [Char])
-> ([RawSnapshotLocation] -> ShowS)
-> Show RawSnapshotLocation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawSnapshotLocation -> ShowS
showsPrec :: Int -> RawSnapshotLocation -> ShowS
$cshow :: RawSnapshotLocation -> [Char]
show :: RawSnapshotLocation -> [Char]
$cshowList :: [RawSnapshotLocation] -> ShowS
showList :: [RawSnapshotLocation] -> ShowS
Show, RawSnapshotLocation -> RawSnapshotLocation -> Bool
(RawSnapshotLocation -> RawSnapshotLocation -> Bool)
-> (RawSnapshotLocation -> RawSnapshotLocation -> Bool)
-> Eq RawSnapshotLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
== :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
$c/= :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
/= :: 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
$ccompare :: RawSnapshotLocation -> RawSnapshotLocation -> Ordering
compare :: RawSnapshotLocation -> RawSnapshotLocation -> Ordering
$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
>= :: RawSnapshotLocation -> RawSnapshotLocation -> Bool
$cmax :: RawSnapshotLocation -> RawSnapshotLocation -> RawSnapshotLocation
max :: RawSnapshotLocation -> RawSnapshotLocation -> RawSnapshotLocation
$cmin :: RawSnapshotLocation -> RawSnapshotLocation -> RawSnapshotLocation
min :: RawSnapshotLocation -> RawSnapshotLocation -> 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
$cfrom :: forall x. RawSnapshotLocation -> Rep RawSnapshotLocation x
from :: forall x. RawSnapshotLocation -> Rep RawSnapshotLocation x
$cto :: forall x. Rep RawSnapshotLocation x -> RawSnapshotLocation
to :: forall x. Rep RawSnapshotLocation x -> RawSnapshotLocation
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 Pretty RawSnapshotLocation where
  pretty :: RawSnapshotLocation -> StyleDoc
pretty (RSLCompiler WantedCompiler
compiler) = [Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Text
forall a. Display a => a -> Text
textDisplay WantedCompiler
compiler
  pretty (RSLUrl Text
url Maybe BlobKey
Nothing) = Style -> StyleDoc -> StyleDoc
style Style
Url ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url)
  pretty (RSLUrl Text
url (Just BlobKey
blob)) = [StyleDoc] -> StyleDoc
fillSep
    [ Style -> StyleDoc -> StyleDoc
style Style
Url ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack  Text
url)
    , StyleDoc -> StyleDoc
parens ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ BlobKey -> Text
forall a. Display a => a -> Text
textDisplay BlobKey
blob)
    ]
  pretty (RSLFilePath ResolvedPath File
resolved) =
    Style -> StyleDoc -> StyleDoc
style Style
File ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ RelFilePath -> Text
forall a. Display a => a -> Text
textDisplay (ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved))
  pretty (RSLSynonym SnapName
syn) =
    Style -> StyleDoc -> StyleDoc
style Style
Shell ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ SnapName -> Text
forall a. Display a => a -> Text
textDisplay SnapName
syn)

instance ToJSON RawSnapshotLocation where
  toJSON :: RawSnapshotLocation -> Value
toJSON (RSLCompiler WantedCompiler
compiler) = [(AesonKey, Value)] -> Value
object [AesonKey
"compiler" AesonKey -> WantedCompiler -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= WantedCompiler
compiler]
  toJSON (RSLUrl Text
url Maybe BlobKey
mblob) = [(AesonKey, Value)] -> Value
object
    ([(AesonKey, Value)] -> Value) -> [(AesonKey, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ AesonKey
"url" AesonKey -> Text -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= Text
url
    (AesonKey, Value) -> [(AesonKey, Value)] -> [(AesonKey, Value)]
forall a. a -> [a] -> [a]
: [(AesonKey, Value)]
-> (BlobKey -> [(AesonKey, Value)])
-> Maybe BlobKey
-> [(AesonKey, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] BlobKey -> [(AesonKey, Value)]
blobKeyPairs Maybe BlobKey
mblob
  toJSON (RSLFilePath ResolvedPath File
resolved) =
    [(AesonKey, Value)] -> Value
object [AesonKey
"filepath" AesonKey -> RelFilePath -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> 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

-- | Where to load a snapshot from.

--

-- @since 0.1.0.0

data SnapshotLocation
  = SLCompiler !WantedCompiler
    -- ^ Don't use an actual snapshot, just a version of the compiler

    -- with its shipped packages.

    --

    -- @since 0.1.0.0

  | SLUrl !Text !BlobKey
    -- ^ Download the snapshot from the given URL. The optional

    -- 'BlobKey' is used for reproducibility.

    --

    -- @since 0.1.0.0

  | SLFilePath !(ResolvedPath File)
    -- ^ Snapshot at a local file path.

    --

    -- @since 0.1.0.0

  deriving (Int -> SnapshotLocation -> ShowS
[SnapshotLocation] -> ShowS
SnapshotLocation -> [Char]
(Int -> SnapshotLocation -> ShowS)
-> (SnapshotLocation -> [Char])
-> ([SnapshotLocation] -> ShowS)
-> Show SnapshotLocation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotLocation -> ShowS
showsPrec :: Int -> SnapshotLocation -> ShowS
$cshow :: SnapshotLocation -> [Char]
show :: SnapshotLocation -> [Char]
$cshowList :: [SnapshotLocation] -> ShowS
showList :: [SnapshotLocation] -> ShowS
Show, SnapshotLocation -> SnapshotLocation -> Bool
(SnapshotLocation -> SnapshotLocation -> Bool)
-> (SnapshotLocation -> SnapshotLocation -> Bool)
-> Eq SnapshotLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotLocation -> SnapshotLocation -> Bool
== :: SnapshotLocation -> SnapshotLocation -> Bool
$c/= :: SnapshotLocation -> SnapshotLocation -> Bool
/= :: 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
$ccompare :: SnapshotLocation -> SnapshotLocation -> Ordering
compare :: SnapshotLocation -> SnapshotLocation -> Ordering
$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
>= :: SnapshotLocation -> SnapshotLocation -> Bool
$cmax :: SnapshotLocation -> SnapshotLocation -> SnapshotLocation
max :: SnapshotLocation -> SnapshotLocation -> SnapshotLocation
$cmin :: SnapshotLocation -> SnapshotLocation -> SnapshotLocation
min :: SnapshotLocation -> SnapshotLocation -> 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
$cfrom :: forall x. SnapshotLocation -> Rep SnapshotLocation x
from :: forall x. SnapshotLocation -> Rep SnapshotLocation x
$cto :: forall x. Rep SnapshotLocation x -> SnapshotLocation
to :: forall x. Rep SnapshotLocation x -> SnapshotLocation
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 a. Parser a -> Parser a -> Parser a
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 a. Parser a -> Parser a -> Parser a
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 = [Char]
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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 a. a -> WriterT WarningParserMonoid Parser a
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
$ \case
        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 -> [Char] -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> [Char] -> m (Path Abs File)
resolveFile Path Abs Dir
dir (Text -> [Char]
T.unpack Text
ufp)
          let fp :: ResolvedPath File
fp = 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 a. a -> IO a
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 = [Char]
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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 a. a -> WriterT WarningParserMonoid Parser a
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 a. a -> IO a
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 = [Char]
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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 a. a -> WriterT WarningParserMonoid Parser a
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 a. a -> IO a
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

-- | Convert snapshot location to its "raw" equivalent.

--

-- @since 0.1.0.0

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

-- | A flattened representation of all the layers in a snapshot.

--

-- @since 0.1.0.0

data RawSnapshot = RawSnapshot
  { RawSnapshot -> WantedCompiler
rsCompiler :: !WantedCompiler
    -- ^ The compiler wanted for this snapshot.

  , RawSnapshot -> Map PackageName RawSnapshotPackage
rsPackages :: !(Map PackageName RawSnapshotPackage)
    -- ^ Packages available in this snapshot for installation. This will be

    -- applied on top of any globally available packages.

  , RawSnapshot -> Set PackageName
rsDrop :: !(Set PackageName)
    -- ^ Global packages that should be dropped/ignored.

  }

-- | A flattened representation of all the layers in a snapshot.

--

-- @since 0.1.0.0

data Snapshot = Snapshot
  { Snapshot -> WantedCompiler
snapshotCompiler :: !WantedCompiler
    -- ^ The compiler wanted for this snapshot.

  , Snapshot -> Map PackageName SnapshotPackage
snapshotPackages :: !(Map PackageName SnapshotPackage)
    -- ^ Packages available in this snapshot for installation. This will be

    -- applied on top of any globally available packages.

  , Snapshot -> Set PackageName
snapshotDrop :: !(Set PackageName)
    -- ^ Global packages that should be dropped/ignored.

  }

-- | Settings for a package found in a snapshot.

--

-- @since 0.1.0.0

data RawSnapshotPackage = RawSnapshotPackage
  { RawSnapshotPackage -> RawPackageLocationImmutable
rspLocation :: !RawPackageLocationImmutable
    -- ^ Where to get the package from

  , RawSnapshotPackage -> Map FlagName Bool
rspFlags :: !(Map FlagName Bool)
    -- ^ Same as 'slFlags'

  , RawSnapshotPackage -> Bool
rspHidden :: !Bool
    -- ^ Same as 'slHidden'

  , RawSnapshotPackage -> [Text]
rspGhcOptions :: ![Text]
    -- ^ Same as 'slGhcOptions'

  }

-- | Settings for a package found in a snapshot.

--

-- @since 0.1.0.0

data SnapshotPackage = SnapshotPackage
  { SnapshotPackage -> PackageLocationImmutable
spLocation :: !PackageLocationImmutable
    -- ^ Where to get the package from

  , SnapshotPackage -> Map FlagName Bool
spFlags :: !(Map FlagName Bool)
    -- ^ Same as 'slFlags'

  , SnapshotPackage -> Bool
spHidden :: !Bool
    -- ^ Same as 'slHidden'

  , SnapshotPackage -> [Text]
spGhcOptions :: ![Text]
    -- ^ Same as 'slGhcOptions'

  }
  deriving Int -> SnapshotPackage -> ShowS
[SnapshotPackage] -> ShowS
SnapshotPackage -> [Char]
(Int -> SnapshotPackage -> ShowS)
-> (SnapshotPackage -> [Char])
-> ([SnapshotPackage] -> ShowS)
-> Show SnapshotPackage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotPackage -> ShowS
showsPrec :: Int -> SnapshotPackage -> ShowS
$cshow :: SnapshotPackage -> [Char]
show :: SnapshotPackage -> [Char]
$cshowList :: [SnapshotPackage] -> ShowS
showList :: [SnapshotPackage] -> ShowS
Show

-- | A single layer of a snapshot, i.e. a specific YAML configuration file.

--

-- @since 0.1.0.0

data RawSnapshotLayer = RawSnapshotLayer
  { RawSnapshotLayer -> RawSnapshotLocation
rslParent :: !RawSnapshotLocation
    -- ^ The sl to extend from. This is either a specific compiler, or a

    -- @SnapshotLocation@ which gives us more information (like packages).

    -- Ultimately, we'll end up with a @CompilerVersion@.

    --

    -- @since 0.1.0.0

  , RawSnapshotLayer -> Maybe WantedCompiler
rslCompiler :: !(Maybe WantedCompiler)
    -- ^ Override the compiler specified in 'slParent'. Must be 'Nothing' if

    -- using 'SLCompiler'.

    --

    -- @since 0.1.0.0

  , RawSnapshotLayer -> [RawPackageLocationImmutable]
rslLocations :: ![RawPackageLocationImmutable]
    -- ^ Where to grab all of the packages from.

    --

    -- @since 0.1.0.0

  , RawSnapshotLayer -> Set PackageName
rslDropPackages :: !(Set PackageName)
    -- ^ Packages present in the parent which should not be included here.

    --

    -- @since 0.1.0.0

  , RawSnapshotLayer -> Map PackageName (Map FlagName Bool)
rslFlags :: !(Map PackageName (Map FlagName Bool))
    -- ^ Flag values to override from the defaults

    --

    -- @since 0.1.0.0

  , RawSnapshotLayer -> Map PackageName Bool
rslHidden :: !(Map PackageName Bool)
    -- ^ Packages which should be hidden when registering. This will affect, for

    -- example, the import parser in the script command. We use a 'Map' instead

    -- of just a 'Set' to allow overriding the hidden settings in a parent sl.

    --

    -- @since 0.1.0.0

  , RawSnapshotLayer -> Map PackageName [Text]
rslGhcOptions :: !(Map PackageName [Text])
    -- ^ GHC options per package

    --

    -- @since 0.1.0.0

  , RawSnapshotLayer -> Maybe UTCTime
rslPublishTime :: !(Maybe UTCTime)
    -- ^ See 'slPublishTime'

    --

    -- @since 0.1.0.0

  }
  deriving (Int -> RawSnapshotLayer -> ShowS
[RawSnapshotLayer] -> ShowS
RawSnapshotLayer -> [Char]
(Int -> RawSnapshotLayer -> ShowS)
-> (RawSnapshotLayer -> [Char])
-> ([RawSnapshotLayer] -> ShowS)
-> Show RawSnapshotLayer
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawSnapshotLayer -> ShowS
showsPrec :: Int -> RawSnapshotLayer -> ShowS
$cshow :: RawSnapshotLayer -> [Char]
show :: RawSnapshotLayer -> [Char]
$cshowList :: [RawSnapshotLayer] -> ShowS
showList :: [RawSnapshotLayer] -> ShowS
Show, RawSnapshotLayer -> RawSnapshotLayer -> Bool
(RawSnapshotLayer -> RawSnapshotLayer -> Bool)
-> (RawSnapshotLayer -> RawSnapshotLayer -> Bool)
-> Eq RawSnapshotLayer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawSnapshotLayer -> RawSnapshotLayer -> Bool
== :: RawSnapshotLayer -> RawSnapshotLayer -> Bool
$c/= :: RawSnapshotLayer -> RawSnapshotLayer -> Bool
/= :: 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
$cfrom :: forall x. RawSnapshotLayer -> Rep RawSnapshotLayer x
from :: forall x. RawSnapshotLayer -> Rep RawSnapshotLayer x
$cto :: forall x. Rep RawSnapshotLayer x -> RawSnapshotLayer
to :: forall x. Rep RawSnapshotLayer x -> RawSnapshotLayer
Generic)

instance NFData RawSnapshotLayer

instance ToJSON RawSnapshotLayer where
  toJSON :: RawSnapshotLayer -> Value
toJSON RawSnapshotLayer
rsnap = [(AesonKey, Value)] -> Value
object ([(AesonKey, Value)] -> Value) -> [(AesonKey, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(AesonKey, Value)]] -> [(AesonKey, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [AesonKey
"resolver" AesonKey -> RawSnapshotLocation -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= RawSnapshotLayer -> RawSnapshotLocation
rslParent RawSnapshotLayer
rsnap]
    , [(AesonKey, Value)]
-> (WantedCompiler -> [(AesonKey, Value)])
-> Maybe WantedCompiler
-> [(AesonKey, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\WantedCompiler
compiler -> [AesonKey
"compiler" AesonKey -> WantedCompiler -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= WantedCompiler
compiler]) (RawSnapshotLayer -> Maybe WantedCompiler
rslCompiler RawSnapshotLayer
rsnap)
    , [AesonKey
"packages" AesonKey -> [RawPackageLocationImmutable] -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= RawSnapshotLayer -> [RawPackageLocationImmutable]
rslLocations RawSnapshotLayer
rsnap]
    , [ AesonKey
"drop-packages" AesonKey -> Set (CabalString PackageName) -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> 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)
      | Bool -> Bool
not (Set PackageName -> Bool
forall a. Set a -> Bool
Set.null (RawSnapshotLayer -> Set PackageName
rslDropPackages RawSnapshotLayer
rsnap))
      ]
    , [ AesonKey
"flags" AesonKey
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= (Map FlagName Bool -> Map (CabalString FlagName) Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
forall a b.
(a -> b)
-> Map (CabalString PackageName) a
-> Map (CabalString PackageName) b
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))
      | Bool -> Bool
not(Map PackageName (Map FlagName Bool) -> Bool
forall k a. Map k a -> Bool
Map.null (RawSnapshotLayer -> Map PackageName (Map FlagName Bool)
rslFlags RawSnapshotLayer
rsnap))
      ]
    , [ AesonKey
"hidden" AesonKey -> Map (CabalString PackageName) Bool -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> 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)
      | Bool -> Bool
not (Map PackageName Bool -> Bool
forall k a. Map k a -> Bool
Map.null (RawSnapshotLayer -> Map PackageName Bool
rslHidden RawSnapshotLayer
rsnap))
      ]
    , [ AesonKey
"ghc-options" AesonKey
-> Map (CabalString PackageName) [Text] -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> 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)
      | Bool -> Bool
not (Map PackageName [Text] -> Bool
forall k a. Map k a -> Bool
Map.null (RawSnapshotLayer -> Map PackageName [Text]
rslGhcOptions RawSnapshotLayer
rsnap))
      ]
    , [(AesonKey, Value)]
-> (UTCTime -> [(AesonKey, Value)])
-> Maybe UTCTime
-> [(AesonKey, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\UTCTime
time -> [AesonKey
"publish-time" AesonKey -> UTCTime -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= UTCTime
time]) (RawSnapshotLayer -> Maybe UTCTime
rslPublishTime RawSnapshotLayer
rsnap)
    ]

instance FromJSON (WithJSONWarnings (Unresolved RawSnapshotLayer)) where
  parseJSON :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
parseJSON = [Char]
-> (Object -> WarningParser (Unresolved RawSnapshotLayer))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"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" -- avoid warnings for old snapshot format

    Maybe WantedCompiler
mCompiler <- Object
o Object -> Text -> WarningParser (Maybe WantedCompiler)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"compiler"
    Maybe (Unresolved RawSnapshotLocation)
mSnapshot <- 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)
mSnapshot) of
        (Maybe WantedCompiler
Nothing, Maybe (Unresolved RawSnapshotLocation)
Nothing) -> [Char]
-> WriterT
     WarningParserMonoid
     Parser
     (Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
forall a. [Char] -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Snapshot must have either a compiler or a snapshot"
        (Just WantedCompiler
compiler, Maybe (Unresolved RawSnapshotLocation)
Nothing) -> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> WriterT
     WarningParserMonoid
     Parser
     (Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
forall a. a -> WriterT WarningParserMonoid Parser a
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 a. a -> Unresolved a
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 a. a -> WriterT WarningParserMonoid Parser a
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 a. a -> IO a
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 a b.
(a -> b)
-> Map (CabalString PackageName) a
-> Map (CabalString PackageName) b
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 a. a -> WriterT WarningParserMonoid Parser a
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 {[RawPackageLocationImmutable]
Maybe UTCTime
Maybe WantedCompiler
Set PackageName
Map PackageName Bool
Map PackageName [Text]
Map PackageName (Map FlagName Bool)
RawSnapshotLocation
rslParent :: RawSnapshotLocation
rslCompiler :: Maybe WantedCompiler
rslLocations :: [RawPackageLocationImmutable]
rslDropPackages :: Set PackageName
rslFlags :: Map PackageName (Map FlagName Bool)
rslHidden :: Map PackageName Bool
rslGhcOptions :: Map PackageName [Text]
rslPublishTime :: Maybe UTCTime
rslDropPackages :: Set PackageName
rslFlags :: Map PackageName (Map FlagName Bool)
rslHidden :: Map PackageName Bool
rslGhcOptions :: Map PackageName [Text]
rslPublishTime :: Maybe UTCTime
rslLocations :: [RawPackageLocationImmutable]
rslParent :: RawSnapshotLocation
rslCompiler :: Maybe WantedCompiler
..})
      ([RawPackageLocationImmutable]
 -> (RawSnapshotLocation, Maybe WantedCompiler) -> RawSnapshotLayer)
-> Unresolved [RawPackageLocationImmutable]
-> Unresolved
     ((RawSnapshotLocation, Maybe WantedCompiler) -> RawSnapshotLayer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((NonEmpty RawPackageLocationImmutable
 -> [RawPackageLocationImmutable])
-> [NonEmpty RawPackageLocationImmutable]
-> [RawPackageLocationImmutable]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [Unresolved (NonEmpty RawPackageLocationImmutable)]
unresolvedLocs)
      Unresolved
  ((RawSnapshotLocation, Maybe WantedCompiler) -> RawSnapshotLayer)
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> Unresolved RawSnapshotLayer
forall a b. Unresolved (a -> b) -> Unresolved a -> Unresolved b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
unresolvedSnapshotParent

-- | A single layer of a snapshot, i.e. a specific YAML configuration file.

--

-- @since 0.1.0.0

data SnapshotLayer = SnapshotLayer
  { SnapshotLayer -> SnapshotLocation
slParent :: !SnapshotLocation
    -- ^ The sl to extend from. This is either a specific compiler, or a

    -- @SnapshotLocation@ which gives us more information (like packages).

    -- Ultimately, we'll end up with a @CompilerVersion@.

    --

    -- @since 0.1.0.0

  , SnapshotLayer -> Maybe WantedCompiler
slCompiler :: !(Maybe WantedCompiler)
    -- ^ Override the compiler specified in 'slParent'. Must be 'Nothing' if

    -- using 'SLCompiler'.

    --

    -- @since 0.1.0.0

  , SnapshotLayer -> [PackageLocationImmutable]
slLocations :: ![PackageLocationImmutable]
    -- ^ Where to grab all of the packages from.

    --

    -- @since 0.1.0.0

  , SnapshotLayer -> Set PackageName
slDropPackages :: !(Set PackageName)
    -- ^ Packages present in the parent which should not be included here.

    --

    -- @since 0.1.0.0

  , SnapshotLayer -> Map PackageName (Map FlagName Bool)
slFlags :: !(Map PackageName (Map FlagName Bool))
    -- ^ Flag values to override from the defaults

    --

    -- @since 0.1.0.0

  , SnapshotLayer -> Map PackageName Bool
slHidden :: !(Map PackageName Bool)
    -- ^ Packages which should be hidden when registering. This will affect, for

    -- example, the import parser in the script command. We use a 'Map' instead

    -- of just a 'Set' to allow overriding the hidden settings in a parent sl.

    --

    -- @since 0.1.0.0

  , SnapshotLayer -> Map PackageName [Text]
slGhcOptions :: !(Map PackageName [Text])
    -- ^ GHC options per package

    --

    -- @since 0.1.0.0

  , SnapshotLayer -> Maybe UTCTime
slPublishTime :: !(Maybe UTCTime)
    -- ^ Publication timestamp for this snapshot. This field is optional, and is

    -- for informational purposes only.

    --

    -- @since 0.1.0.0

  }
  deriving (Int -> SnapshotLayer -> ShowS
[SnapshotLayer] -> ShowS
SnapshotLayer -> [Char]
(Int -> SnapshotLayer -> ShowS)
-> (SnapshotLayer -> [Char])
-> ([SnapshotLayer] -> ShowS)
-> Show SnapshotLayer
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotLayer -> ShowS
showsPrec :: Int -> SnapshotLayer -> ShowS
$cshow :: SnapshotLayer -> [Char]
show :: SnapshotLayer -> [Char]
$cshowList :: [SnapshotLayer] -> ShowS
showList :: [SnapshotLayer] -> ShowS
Show, SnapshotLayer -> SnapshotLayer -> Bool
(SnapshotLayer -> SnapshotLayer -> Bool)
-> (SnapshotLayer -> SnapshotLayer -> Bool) -> Eq SnapshotLayer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotLayer -> SnapshotLayer -> Bool
== :: SnapshotLayer -> SnapshotLayer -> Bool
$c/= :: SnapshotLayer -> SnapshotLayer -> Bool
/= :: 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
$cfrom :: forall x. SnapshotLayer -> Rep SnapshotLayer x
from :: forall x. SnapshotLayer -> Rep SnapshotLayer x
$cto :: forall x. Rep SnapshotLayer x -> SnapshotLayer
to :: forall x. Rep SnapshotLayer x -> SnapshotLayer
Generic)

instance ToJSON SnapshotLayer where
  toJSON :: SnapshotLayer -> Value
toJSON SnapshotLayer
snap = [(AesonKey, Value)] -> Value
object ([(AesonKey, Value)] -> Value) -> [(AesonKey, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(AesonKey, Value)]] -> [(AesonKey, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [AesonKey
"resolver" AesonKey -> SnapshotLocation -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= SnapshotLayer -> SnapshotLocation
slParent SnapshotLayer
snap]
    , [(AesonKey, Value)]
-> (WantedCompiler -> [(AesonKey, Value)])
-> Maybe WantedCompiler
-> [(AesonKey, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\WantedCompiler
compiler -> [AesonKey
"compiler" AesonKey -> WantedCompiler -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= WantedCompiler
compiler]) (SnapshotLayer -> Maybe WantedCompiler
slCompiler SnapshotLayer
snap)
    , [AesonKey
"packages" AesonKey -> [PackageLocationImmutable] -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= SnapshotLayer -> [PackageLocationImmutable]
slLocations SnapshotLayer
snap]
    , [ AesonKey
"drop-packages" AesonKey -> Set (CabalString PackageName) -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> 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)
      | Bool -> Bool
not (Set PackageName -> Bool
forall a. Set a -> Bool
Set.null (SnapshotLayer -> Set PackageName
slDropPackages SnapshotLayer
snap))
      ]
    , [ AesonKey
"flags" AesonKey
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= (Map FlagName Bool -> Map (CabalString FlagName) Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
forall a b.
(a -> b)
-> Map (CabalString PackageName) a
-> Map (CabalString PackageName) b
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))
      | Bool -> Bool
not (Map PackageName (Map FlagName Bool) -> Bool
forall k a. Map k a -> Bool
Map.null (SnapshotLayer -> Map PackageName (Map FlagName Bool)
slFlags SnapshotLayer
snap))
      ]
    , [ AesonKey
"hidden" AesonKey -> Map (CabalString PackageName) Bool -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> 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)
      | Bool -> Bool
not (Map PackageName Bool -> Bool
forall k a. Map k a -> Bool
Map.null (SnapshotLayer -> Map PackageName Bool
slHidden SnapshotLayer
snap))
      ]
    , [ AesonKey
"ghc-options" AesonKey
-> Map (CabalString PackageName) [Text] -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> 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)
      | Bool -> Bool
not (Map PackageName [Text] -> Bool
forall k a. Map k a -> Bool
Map.null (SnapshotLayer -> Map PackageName [Text]
slGhcOptions SnapshotLayer
snap))
      ]
    , [(AesonKey, Value)]
-> (UTCTime -> [(AesonKey, Value)])
-> Maybe UTCTime
-> [(AesonKey, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\UTCTime
time -> [AesonKey
"publish-time" AesonKey -> UTCTime -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= UTCTime
time]) (SnapshotLayer -> Maybe UTCTime
slPublishTime SnapshotLayer
snap)
    ]

-- | Convert snapshot layer into its "raw" equivalent.

--

-- @since 0.1.0.0

toRawSnapshotLayer :: SnapshotLayer -> RawSnapshotLayer
toRawSnapshotLayer :: SnapshotLayer -> RawSnapshotLayer
toRawSnapshotLayer SnapshotLayer
sl = RawSnapshotLayer
  { rslParent :: RawSnapshotLocation
rslParent = SnapshotLocation -> RawSnapshotLocation
toRawSL (SnapshotLayer -> SnapshotLocation
slParent SnapshotLayer
sl)
  , rslCompiler :: Maybe WantedCompiler
rslCompiler = SnapshotLayer -> Maybe WantedCompiler
slCompiler SnapshotLayer
sl
  , rslLocations :: [RawPackageLocationImmutable]
rslLocations = (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
  }

-- | An arbitrary hash for a snapshot, used for finding module names in a

-- snapshot. Mostly intended for Stack's usage.

--

-- @since 0.1.0.0

newtype SnapshotCacheHash = SnapshotCacheHash { SnapshotCacheHash -> SHA256
unSnapshotCacheHash :: SHA256}
  deriving (Int -> SnapshotCacheHash -> ShowS
[SnapshotCacheHash] -> ShowS
SnapshotCacheHash -> [Char]
(Int -> SnapshotCacheHash -> ShowS)
-> (SnapshotCacheHash -> [Char])
-> ([SnapshotCacheHash] -> ShowS)
-> Show SnapshotCacheHash
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotCacheHash -> ShowS
showsPrec :: Int -> SnapshotCacheHash -> ShowS
$cshow :: SnapshotCacheHash -> [Char]
show :: SnapshotCacheHash -> [Char]
$cshowList :: [SnapshotCacheHash] -> ShowS
showList :: [SnapshotCacheHash] -> ShowS
Show)

-- | Get the path to the global hints cache file

getGlobalHintsFile :: HasPantryConfig env => RIO env (Path Abs File)
getGlobalHintsFile :: forall env. HasPantryConfig env => 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
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 <- [Char] -> RIO env (Path Rel File)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile [Char]
"global-hints-cache.yaml"
  Path Abs File -> RIO env (Path Abs File)
forall a. a -> RIO env a
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

-- | Creates BlobKey for an input ByteString

--

-- @since 0.1.0.0

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)))

-- | Warn if the package uses 'PCHpack'.

--

-- @since 0.4.0.0

warnMissingCabalFile :: HasLogFunc env => RawPackageLocationImmutable -> RIO env ()
warnMissingCabalFile :: forall env.
HasLogFunc env =>
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 "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"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"

-- | Where to load global hints from.

--

-- @since 0.9.4

data GlobalHintsLocation
  = GHLUrl !Text
    -- ^ Download the global hints from the given URL.

  | GHLFilePath !(ResolvedPath File)
    -- ^ Global hints at a local file path.

  deriving (Int -> GlobalHintsLocation -> ShowS
[GlobalHintsLocation] -> ShowS
GlobalHintsLocation -> [Char]
(Int -> GlobalHintsLocation -> ShowS)
-> (GlobalHintsLocation -> [Char])
-> ([GlobalHintsLocation] -> ShowS)
-> Show GlobalHintsLocation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlobalHintsLocation -> ShowS
showsPrec :: Int -> GlobalHintsLocation -> ShowS
$cshow :: GlobalHintsLocation -> [Char]
show :: GlobalHintsLocation -> [Char]
$cshowList :: [GlobalHintsLocation] -> ShowS
showList :: [GlobalHintsLocation] -> ShowS
Show, GlobalHintsLocation -> GlobalHintsLocation -> Bool
(GlobalHintsLocation -> GlobalHintsLocation -> Bool)
-> (GlobalHintsLocation -> GlobalHintsLocation -> Bool)
-> Eq GlobalHintsLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlobalHintsLocation -> GlobalHintsLocation -> Bool
== :: GlobalHintsLocation -> GlobalHintsLocation -> Bool
$c/= :: GlobalHintsLocation -> GlobalHintsLocation -> Bool
/= :: GlobalHintsLocation -> GlobalHintsLocation -> Bool
Eq, Eq GlobalHintsLocation
Eq GlobalHintsLocation =>
(GlobalHintsLocation -> GlobalHintsLocation -> Ordering)
-> (GlobalHintsLocation -> GlobalHintsLocation -> Bool)
-> (GlobalHintsLocation -> GlobalHintsLocation -> Bool)
-> (GlobalHintsLocation -> GlobalHintsLocation -> Bool)
-> (GlobalHintsLocation -> GlobalHintsLocation -> Bool)
-> (GlobalHintsLocation
    -> GlobalHintsLocation -> GlobalHintsLocation)
-> (GlobalHintsLocation
    -> GlobalHintsLocation -> GlobalHintsLocation)
-> Ord GlobalHintsLocation
GlobalHintsLocation -> GlobalHintsLocation -> Bool
GlobalHintsLocation -> GlobalHintsLocation -> Ordering
GlobalHintsLocation -> GlobalHintsLocation -> GlobalHintsLocation
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
$ccompare :: GlobalHintsLocation -> GlobalHintsLocation -> Ordering
compare :: GlobalHintsLocation -> GlobalHintsLocation -> Ordering
$c< :: GlobalHintsLocation -> GlobalHintsLocation -> Bool
< :: GlobalHintsLocation -> GlobalHintsLocation -> Bool
$c<= :: GlobalHintsLocation -> GlobalHintsLocation -> Bool
<= :: GlobalHintsLocation -> GlobalHintsLocation -> Bool
$c> :: GlobalHintsLocation -> GlobalHintsLocation -> Bool
> :: GlobalHintsLocation -> GlobalHintsLocation -> Bool
$c>= :: GlobalHintsLocation -> GlobalHintsLocation -> Bool
>= :: GlobalHintsLocation -> GlobalHintsLocation -> Bool
$cmax :: GlobalHintsLocation -> GlobalHintsLocation -> GlobalHintsLocation
max :: GlobalHintsLocation -> GlobalHintsLocation -> GlobalHintsLocation
$cmin :: GlobalHintsLocation -> GlobalHintsLocation -> GlobalHintsLocation
min :: GlobalHintsLocation -> GlobalHintsLocation -> GlobalHintsLocation
Ord, (forall x. GlobalHintsLocation -> Rep GlobalHintsLocation x)
-> (forall x. Rep GlobalHintsLocation x -> GlobalHintsLocation)
-> Generic GlobalHintsLocation
forall x. Rep GlobalHintsLocation x -> GlobalHintsLocation
forall x. GlobalHintsLocation -> Rep GlobalHintsLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GlobalHintsLocation -> Rep GlobalHintsLocation x
from :: forall x. GlobalHintsLocation -> Rep GlobalHintsLocation x
$cto :: forall x. Rep GlobalHintsLocation x -> GlobalHintsLocation
to :: forall x. Rep GlobalHintsLocation x -> GlobalHintsLocation
Generic)

instance NFData GlobalHintsLocation

instance Display GlobalHintsLocation where
  display :: GlobalHintsLocation -> Utf8Builder
display (GHLUrl Text
url) = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url
  display (GHLFilePath ResolvedPath File
resolved) = RelFilePath -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved)

instance Pretty GlobalHintsLocation where
  pretty :: GlobalHintsLocation -> StyleDoc
pretty (GHLUrl Text
url) = Style -> StyleDoc -> StyleDoc
style Style
Url ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> [Char] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
url)
  pretty (GHLFilePath ResolvedPath File
resolved) =
    Style -> StyleDoc -> StyleDoc
style Style
File ([Char] -> StyleDoc
forall a. IsString a => [Char] -> a
fromString ([Char] -> StyleDoc) -> (Text -> [Char]) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ RelFilePath -> Text
forall a. Display a => a -> Text
textDisplay (ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved))

instance ToJSON GlobalHintsLocation where
  toJSON :: GlobalHintsLocation -> Value
toJSON (GHLUrl Text
url) = [(AesonKey, Value)] -> Value
object [AesonKey
"url" AesonKey -> Text -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= Text
url]
  toJSON (GHLFilePath ResolvedPath File
resolved) =
    [(AesonKey, Value)] -> Value
object [AesonKey
"filepath" AesonKey -> RelFilePath -> (AesonKey, Value)
forall v. ToJSON v => AesonKey -> v -> (AesonKey, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => AesonKey -> v -> kv
.= ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved]

instance FromJSON (WithJSONWarnings (Unresolved GlobalHintsLocation)) where
  parseJSON :: Value -> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation))
parseJSON Value
v = Value -> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation))
file Value
v Parser (WithJSONWarnings (Unresolved GlobalHintsLocation))
-> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation))
-> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation))
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation))
url Value
v
   where
    file :: Value -> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation))
file = [Char]
-> (Object -> WarningParser (Unresolved GlobalHintsLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"GHLFilepath" ((Object -> WarningParser (Unresolved GlobalHintsLocation))
 -> Value
 -> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation)))
-> (Object -> WarningParser (Unresolved GlobalHintsLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation))
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 GlobalHintsLocation
-> WarningParser (Unresolved GlobalHintsLocation)
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved GlobalHintsLocation
 -> WarningParser (Unresolved GlobalHintsLocation))
-> Unresolved GlobalHintsLocation
-> WarningParser (Unresolved GlobalHintsLocation)
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO GlobalHintsLocation)
-> Unresolved GlobalHintsLocation
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO GlobalHintsLocation)
 -> Unresolved GlobalHintsLocation)
-> (Maybe (Path Abs Dir) -> IO GlobalHintsLocation)
-> Unresolved GlobalHintsLocation
forall a b. (a -> b) -> a -> b
$ \case
        Maybe (Path Abs Dir)
Nothing -> PantryException -> IO GlobalHintsLocation
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PantryException -> IO GlobalHintsLocation)
-> PantryException -> IO GlobalHintsLocation
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
InvalidFilePathGlobalHints Text
ufp
        Just Path Abs Dir
dir -> do
          Path Abs File
absolute <- Path Abs Dir -> [Char] -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> [Char] -> m (Path Abs File)
resolveFile Path Abs Dir
dir (Text -> [Char]
T.unpack Text
ufp)
          let fp :: ResolvedPath File
fp = RelFilePath -> Path Abs File -> ResolvedPath File
forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath Text
ufp) Path Abs File
absolute
          GlobalHintsLocation -> IO GlobalHintsLocation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GlobalHintsLocation -> IO GlobalHintsLocation)
-> GlobalHintsLocation -> IO GlobalHintsLocation
forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> GlobalHintsLocation
GHLFilePath ResolvedPath File
fp
    url :: Value -> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation))
url = [Char]
-> (Object -> WarningParser (Unresolved GlobalHintsLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation))
forall a.
[Char]
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings [Char]
"GHLUrl" ((Object -> WarningParser (Unresolved GlobalHintsLocation))
 -> Value
 -> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation)))
-> (Object -> WarningParser (Unresolved GlobalHintsLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved GlobalHintsLocation))
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"
      Unresolved GlobalHintsLocation
-> WarningParser (Unresolved GlobalHintsLocation)
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved GlobalHintsLocation
 -> WarningParser (Unresolved GlobalHintsLocation))
-> Unresolved GlobalHintsLocation
-> WarningParser (Unresolved GlobalHintsLocation)
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO GlobalHintsLocation)
-> Unresolved GlobalHintsLocation
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO GlobalHintsLocation)
 -> Unresolved GlobalHintsLocation)
-> (Maybe (Path Abs Dir) -> IO GlobalHintsLocation)
-> Unresolved GlobalHintsLocation
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
_ -> GlobalHintsLocation -> IO GlobalHintsLocation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GlobalHintsLocation -> IO GlobalHintsLocation)
-> GlobalHintsLocation -> IO GlobalHintsLocation
forall a b. (a -> b) -> a -> b
$ Text -> GlobalHintsLocation
GHLUrl Text
url'