{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
module Pantry.Types
  ( PantryConfig (..)
  , HackageSecurityConfig (..)
  , Storage (..)
  , HasPantryConfig (..)
  , BlobKey (..)
  , PackageName
  , Version
  , PackageIdentifier (..)
  , Revision (..)
  , ModuleName
  , CabalFileInfo (..)
  , PrintWarnings (..)
  , PackageNameP (..)
  , VersionP (..)
  , ModuleNameP (..)
  , PackageIdentifierRevision (..)
  , pirForHash
  , FileType (..)
  , BuildFile (..)
  , FileSize (..)
  , TreeEntry (..)
  , SafeFilePath
  , unSafeFilePath
  , mkSafeFilePath
  , safeFilePathtoPath
  , hpackSafeFilePath
  , TreeKey (..)
  , Tree (..)
  , renderTree
  , parseTree
  , parseTreeM
  , SHA256
  , Unresolved
  , resolvePaths
  , Package (..)
  , PackageCabal (..)
  , PHpack (..)
  -- , 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
  , SnapName (..)
  , parseSnapName
  , RawSnapshotLocation (..)
  , SnapshotLocation (..)
  , toRawSL
  , parseHackageText
  , parseRawSnapshotLocation
  , RawSnapshotLayer (..)
  , SnapshotLayer (..)
  , toRawSnapshotLayer
  , RawSnapshot (..)
  , Snapshot (..)
  , RawSnapshotPackage (..)
  , SnapshotPackage (..)
  , parseWantedCompiler
  , RawPackageMetadata (..)
  , PackageMetadata (..)
  , toRawPM
  , cabalFileName
  , SnapshotCacheHash (..)
  , getGlobalHintsFile
  , bsToBlobKey
  , warnMissingCabalFile
  , connRDBMS
  ) where

import RIO
import qualified Data.Conduit.Tar as Tar
import qualified RIO.Text as T
import qualified RIO.ByteString as B
import qualified RIO.ByteString.Lazy as BL
import RIO.List (intersperse, groupBy)
import RIO.Time (toGregorian, Day, UTCTime)
import qualified RIO.Map as Map
import qualified RIO.HashMap as HM
import qualified Data.Map.Strict as Map (mapKeysMonotonic)
import qualified RIO.Set as Set
import Data.Aeson.Types (toJSONKeyText, Parser)
import Pantry.Internal.AesonExtended
import Data.Aeson.Encoding.Internal (unsafeToEncoding)
import Data.ByteString.Builder (toLazyByteString, byteString, wordDec)
import Database.Persist
import Database.Persist.Sql
import Pantry.SHA256 (SHA256)
import qualified Pantry.SHA256 as SHA256
import qualified Distribution.Compat.CharParsing as Parse
import Distribution.CabalSpecVersion (CabalSpecVersion (..), cabalSpecLatest)
import Distribution.Parsec (PError (..), PWarning (..), showPos, parsec, explicitEitherParsec, ParsecParser)
import Distribution.Types.PackageName (PackageName, unPackageName, mkPackageName)
import Distribution.Types.VersionRange (VersionRange)
import Distribution.PackageDescription (FlagName, unFlagName, GenericPackageDescription)
import Distribution.Types.PackageId (PackageIdentifier (..))
import qualified Distribution.Pretty
import qualified Distribution.Text
import qualified Hpack.Config as Hpack
import Distribution.ModuleName (ModuleName)
import Distribution.Types.Version (Version, mkVersion, nullVersion)
import Network.HTTP.Client (parseRequest)
import Network.HTTP.Types (Status, statusCode)
import Data.Text.Read (decimal)
import Path (Path, Abs, Dir, File, toFilePath, filename, (</>), parseRelFile)
import Path.IO (resolveFile, resolveDir)
import qualified Data.List.NonEmpty as NE
import Casa.Client (CasaRepoPrefix)

#if MIN_VERSION_persistent(2, 13, 0)
import Database.Persist.SqlBackend.Internal (connRDBMS)
#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 -> String
(Int -> Package -> ShowS)
-> (Package -> String) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Package] -> ShowS
$cshowList :: [Package] -> ShowS
show :: Package -> String
$cshow :: Package -> String
showsPrec :: Int -> Package -> ShowS
$cshowsPrec :: Int -> Package -> ShowS
Show, Package -> Package -> Bool
(Package -> Package -> Bool)
-> (Package -> Package -> Bool) -> Eq Package
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c== :: Package -> Package -> Bool
Eq, 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
min :: Package -> Package -> Package
$cmin :: Package -> Package -> Package
max :: Package -> Package -> Package
$cmax :: Package -> Package -> Package
>= :: Package -> Package -> Bool
$c>= :: Package -> Package -> Bool
> :: Package -> Package -> Bool
$c> :: Package -> Package -> Bool
<= :: Package -> Package -> Bool
$c<= :: Package -> Package -> Bool
< :: Package -> Package -> Bool
$c< :: Package -> Package -> Bool
compare :: Package -> Package -> Ordering
$ccompare :: Package -> Package -> Ordering
$cp1Ord :: Eq 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 -> String
(Int -> PHpack -> ShowS)
-> (PHpack -> String) -> ([PHpack] -> ShowS) -> Show PHpack
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PHpack] -> ShowS
$cshowList :: [PHpack] -> ShowS
show :: PHpack -> String
$cshow :: PHpack -> String
showsPrec :: Int -> PHpack -> ShowS
$cshowsPrec :: Int -> PHpack -> ShowS
Show, PHpack -> PHpack -> Bool
(PHpack -> PHpack -> Bool)
-> (PHpack -> PHpack -> Bool) -> Eq PHpack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PHpack -> PHpack -> Bool
$c/= :: PHpack -> PHpack -> Bool
== :: PHpack -> PHpack -> Bool
$c== :: PHpack -> PHpack -> Bool
Eq, 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
min :: PHpack -> PHpack -> PHpack
$cmin :: PHpack -> PHpack -> PHpack
max :: PHpack -> PHpack -> PHpack
$cmax :: PHpack -> PHpack -> PHpack
>= :: PHpack -> PHpack -> Bool
$c>= :: PHpack -> PHpack -> Bool
> :: PHpack -> PHpack -> Bool
$c> :: PHpack -> PHpack -> Bool
<= :: PHpack -> PHpack -> Bool
$c<= :: PHpack -> PHpack -> Bool
< :: PHpack -> PHpack -> Bool
$c< :: PHpack -> PHpack -> Bool
compare :: PHpack -> PHpack -> Ordering
$ccompare :: PHpack -> PHpack -> Ordering
$cp1Ord :: Eq PHpack
Ord)

data PackageCabal = PCCabalFile !TreeEntry -- ^ TreeEntry of Cabal file
                  | PCHpack !PHpack
                  deriving (Int -> PackageCabal -> ShowS
[PackageCabal] -> ShowS
PackageCabal -> String
(Int -> PackageCabal -> ShowS)
-> (PackageCabal -> String)
-> ([PackageCabal] -> ShowS)
-> Show PackageCabal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageCabal] -> ShowS
$cshowList :: [PackageCabal] -> ShowS
show :: PackageCabal -> String
$cshow :: PackageCabal -> String
showsPrec :: Int -> PackageCabal -> ShowS
$cshowsPrec :: Int -> PackageCabal -> ShowS
Show, PackageCabal -> PackageCabal -> Bool
(PackageCabal -> PackageCabal -> Bool)
-> (PackageCabal -> PackageCabal -> Bool) -> Eq PackageCabal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageCabal -> PackageCabal -> Bool
$c/= :: PackageCabal -> PackageCabal -> Bool
== :: PackageCabal -> PackageCabal -> Bool
$c== :: PackageCabal -> PackageCabal -> Bool
Eq, 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
min :: PackageCabal -> PackageCabal -> PackageCabal
$cmin :: PackageCabal -> PackageCabal -> PackageCabal
max :: PackageCabal -> PackageCabal -> PackageCabal
$cmax :: PackageCabal -> PackageCabal -> PackageCabal
>= :: PackageCabal -> PackageCabal -> Bool
$c>= :: PackageCabal -> PackageCabal -> Bool
> :: PackageCabal -> PackageCabal -> Bool
$c> :: PackageCabal -> PackageCabal -> Bool
<= :: PackageCabal -> PackageCabal -> Bool
$c<= :: PackageCabal -> PackageCabal -> Bool
< :: PackageCabal -> PackageCabal -> Bool
$c< :: PackageCabal -> PackageCabal -> Bool
compare :: PackageCabal -> PackageCabal -> Ordering
$ccompare :: PackageCabal -> PackageCabal -> Ordering
$cp1Ord :: Eq 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
$ String -> Text
T.pack (PackageName -> String
packageNameString PackageName
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".cabal" of
    Maybe SafeFilePath
Nothing -> String -> SafeFilePath
forall a. HasCallStack => String -> a
error (String -> SafeFilePath) -> String -> SafeFilePath
forall a b. (a -> b) -> a -> b
$ String
"cabalFileName: failed for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Show a => a -> String
show PackageName
name
    Just SafeFilePath
sfp -> SafeFilePath
sfp

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

-- | 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@. See also @PantryApp@ for a convenience
-- approach to using pantry.
--
-- @since 0.1.0.0
data PantryConfig = PantryConfig
  { PantryConfig -> HackageSecurityConfig
pcHackageSecurity :: !HackageSecurityConfig
  , PantryConfig -> HpackExecutable
pcHpackExecutable :: !HpackExecutable
  , PantryConfig -> Path Abs Dir
pcRootDir :: !(Path Abs Dir)
  , PantryConfig -> Storage
pcStorage :: !Storage
  , PantryConfig -> MVar Bool
pcUpdateRef :: !(MVar Bool)
  -- ^ 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 -> CasaRepoPrefix
pcCasaRepoPrefix :: !CasaRepoPrefix
  -- ^ The pull URL e.g. @https://casa.fpcomplete.com/v1/pull@
  , PantryConfig -> Int
pcCasaMaxPerRequest :: !Int
  -- ^ Maximum blobs sent per pull request.
  , PantryConfig -> SnapName -> RawSnapshotLocation
pcSnapshotLocation :: SnapName -> RawSnapshotLocation
  -- ^ The location of snapshot synonyms
  }

-- | Get the location of a snapshot synonym from the 'PantryConfig'.
--
-- @since 0.5.0.0
snapshotLocation :: HasPantryConfig env => SnapName -> RIO env RawSnapshotLocation
snapshotLocation :: SnapName -> RIO env RawSnapshotLocation
snapshotLocation SnapName
name = do
  SnapName -> RawSnapshotLocation
loc <- Getting
  (SnapName -> RawSnapshotLocation)
  env
  (SnapName -> RawSnapshotLocation)
-> RIO env (SnapName -> RawSnapshotLocation)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting
   (SnapName -> RawSnapshotLocation)
   env
   (SnapName -> RawSnapshotLocation)
 -> RIO env (SnapName -> RawSnapshotLocation))
-> Getting
     (SnapName -> RawSnapshotLocation)
     env
     (SnapName -> RawSnapshotLocation)
-> RIO env (SnapName -> RawSnapshotLocation)
forall a b. (a -> b) -> a -> b
$ (PantryConfig
 -> Const (SnapName -> RawSnapshotLocation) PantryConfig)
-> env -> Const (SnapName -> RawSnapshotLocation) env
forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigL((PantryConfig
  -> Const (SnapName -> RawSnapshotLocation) PantryConfig)
 -> env -> Const (SnapName -> RawSnapshotLocation) env)
-> (((SnapName -> RawSnapshotLocation)
     -> Const
          (SnapName -> RawSnapshotLocation)
          (SnapName -> RawSnapshotLocation))
    -> PantryConfig
    -> Const (SnapName -> RawSnapshotLocation) PantryConfig)
-> Getting
     (SnapName -> RawSnapshotLocation)
     env
     (SnapName -> RawSnapshotLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PantryConfig -> SnapName -> RawSnapshotLocation)
-> SimpleGetter PantryConfig (SnapName -> RawSnapshotLocation)
forall s a. (s -> a) -> SimpleGetter s a
to PantryConfig -> SnapName -> RawSnapshotLocation
pcSnapshotLocation
  RawSnapshotLocation -> RIO env RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> RIO env RawSnapshotLocation)
-> RawSnapshotLocation -> RIO env RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ SnapName -> RawSnapshotLocation
loc SnapName
name

-- | 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 a -> Unresolved b -> Unresolved a
(a -> b) -> Unresolved a -> Unresolved b
(forall a b. (a -> b) -> Unresolved a -> Unresolved b)
-> (forall a b. a -> Unresolved b -> Unresolved a)
-> Functor Unresolved
forall a b. a -> Unresolved b -> Unresolved a
forall a b. (a -> b) -> Unresolved a -> Unresolved b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Unresolved b -> Unresolved a
$c<$ :: forall a b. a -> Unresolved b -> Unresolved a
fmap :: (a -> b) -> Unresolved a -> Unresolved b
$cfmap :: forall a b. (a -> b) -> Unresolved a -> Unresolved b
Functor
instance Applicative Unresolved where
  pure :: a -> Unresolved a
pure = (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO a) -> Unresolved a)
-> (a -> Maybe (Path Abs Dir) -> IO a) -> a -> Unresolved a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Maybe (Path Abs Dir) -> IO a
forall a b. a -> b -> a
const (IO a -> Maybe (Path Abs Dir) -> IO a)
-> (a -> IO a) -> a -> Maybe (Path Abs Dir) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Unresolved Maybe (Path Abs Dir) -> IO (a -> b)
f <*> :: Unresolved (a -> b) -> Unresolved a -> Unresolved b
<*> Unresolved Maybe (Path Abs Dir) -> IO a
x = (Maybe (Path Abs Dir) -> IO b) -> Unresolved b
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO b) -> Unresolved b)
-> (Maybe (Path Abs Dir) -> IO b) -> Unresolved b
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir -> Maybe (Path Abs Dir) -> IO (a -> b)
f Maybe (Path Abs Dir)
mdir IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Path Abs Dir) -> IO a
x Maybe (Path Abs Dir)
mdir

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

-- | 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
  { ResolvedPath t -> RelFilePath
resolvedRelative :: !RelFilePath
  -- ^ Original value parsed from a config file.
  , 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 -> String
(Int -> ResolvedPath t -> ShowS)
-> (ResolvedPath t -> String)
-> ([ResolvedPath t] -> ShowS)
-> Show (ResolvedPath t)
forall t. Int -> ResolvedPath t -> ShowS
forall t. [ResolvedPath t] -> ShowS
forall t. ResolvedPath t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedPath t] -> ShowS
$cshowList :: forall t. [ResolvedPath t] -> ShowS
show :: ResolvedPath t -> String
$cshow :: forall t. ResolvedPath t -> String
showsPrec :: Int -> ResolvedPath t -> ShowS
$cshowsPrec :: forall t. Int -> ResolvedPath t -> ShowS
Show, ResolvedPath t -> ResolvedPath t -> Bool
(ResolvedPath t -> ResolvedPath t -> Bool)
-> (ResolvedPath t -> ResolvedPath t -> Bool)
-> Eq (ResolvedPath t)
forall t. ResolvedPath t -> ResolvedPath t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolvedPath t -> ResolvedPath t -> Bool
$c/= :: forall t. ResolvedPath t -> ResolvedPath t -> Bool
== :: ResolvedPath t -> ResolvedPath t -> Bool
$c== :: forall t. ResolvedPath t -> ResolvedPath t -> Bool
Eq, (forall x. ResolvedPath t -> Rep (ResolvedPath t) x)
-> (forall x. Rep (ResolvedPath t) x -> ResolvedPath t)
-> Generic (ResolvedPath t)
forall x. Rep (ResolvedPath t) x -> ResolvedPath t
forall x. ResolvedPath t -> Rep (ResolvedPath t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t x. Rep (ResolvedPath t) x -> ResolvedPath t
forall t x. ResolvedPath t -> Rep (ResolvedPath t) x
$cto :: forall t x. Rep (ResolvedPath t) x -> ResolvedPath t
$cfrom :: forall t x. ResolvedPath t -> Rep (ResolvedPath t) x
Generic, Eq (ResolvedPath t)
Eq (ResolvedPath t)
-> (ResolvedPath t -> ResolvedPath t -> Ordering)
-> (ResolvedPath t -> ResolvedPath t -> Bool)
-> (ResolvedPath t -> ResolvedPath t -> Bool)
-> (ResolvedPath t -> ResolvedPath t -> Bool)
-> (ResolvedPath t -> ResolvedPath t -> Bool)
-> (ResolvedPath t -> ResolvedPath t -> ResolvedPath t)
-> (ResolvedPath t -> ResolvedPath t -> ResolvedPath t)
-> Ord (ResolvedPath t)
ResolvedPath t -> ResolvedPath t -> Bool
ResolvedPath t -> ResolvedPath t -> Ordering
ResolvedPath t -> ResolvedPath t -> ResolvedPath t
forall t. Eq (ResolvedPath t)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. ResolvedPath t -> ResolvedPath t -> Bool
forall t. ResolvedPath t -> ResolvedPath t -> Ordering
forall t. ResolvedPath t -> ResolvedPath t -> ResolvedPath t
min :: ResolvedPath t -> ResolvedPath t -> ResolvedPath t
$cmin :: forall t. ResolvedPath t -> ResolvedPath t -> ResolvedPath t
max :: ResolvedPath t -> ResolvedPath t -> ResolvedPath t
$cmax :: forall t. ResolvedPath t -> ResolvedPath t -> ResolvedPath t
>= :: ResolvedPath t -> ResolvedPath t -> Bool
$c>= :: forall t. ResolvedPath t -> ResolvedPath t -> Bool
> :: ResolvedPath t -> ResolvedPath t -> Bool
$c> :: forall t. ResolvedPath t -> ResolvedPath t -> Bool
<= :: ResolvedPath t -> ResolvedPath t -> Bool
$c<= :: forall t. ResolvedPath t -> ResolvedPath t -> Bool
< :: ResolvedPath t -> ResolvedPath t -> Bool
$c< :: forall t. ResolvedPath t -> ResolvedPath t -> Bool
compare :: ResolvedPath t -> ResolvedPath t -> Ordering
$ccompare :: forall t. ResolvedPath t -> ResolvedPath t -> Ordering
$cp1Ord :: forall t. Eq (ResolvedPath t)
Ord)
instance NFData (ResolvedPath t)

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

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

instance Display PackageLocation where
  display :: PackageLocation -> Utf8Builder
display (PLImmutable PackageLocationImmutable
loc) = PackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display PackageLocationImmutable
loc
  display (PLMutable ResolvedPath Dir
fp) = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder) -> String -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath (Path Abs Dir -> String) -> Path Abs Dir -> String
forall a b. (a -> b) -> a -> b
$ ResolvedPath Dir -> Path Abs Dir
forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute ResolvedPath Dir
fp

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

instance NFData RawPackageLocationImmutable

instance Display RawPackageLocationImmutable where
  display :: RawPackageLocationImmutable -> Utf8Builder
display (RPLIHackage PackageIdentifierRevision
pir Maybe TreeKey
_tree) = PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" (from Hackage)"
  display (RPLIArchive RawArchive
archive RawPackageMetadata
_pm) =
    Utf8Builder
"Archive from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ArchiveLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (RawArchive -> ArchiveLocation
raLocation RawArchive
archive) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    (if Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ RawArchive -> Text
raSubdir RawArchive
archive
       then Utf8Builder
forall a. Monoid a => a
mempty
       else Utf8Builder
" in subdir " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (RawArchive -> Text
raSubdir RawArchive
archive))
  display (RPLIRepo Repo
repo RawPackageMetadata
_pm) =
    Utf8Builder
"Repo from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoUrl Repo
repo) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
", commit " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoCommit Repo
repo) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    (if Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Repo -> Text
repoSubdir Repo
repo
       then Utf8Builder
forall a. Monoid a => a
mempty
       else Utf8Builder
" in subdir " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoSubdir Repo
repo))

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

instance Display PackageLocationImmutable where
  display :: PackageLocationImmutable -> Utf8Builder
display (PLIHackage PackageIdentifier
ident BlobKey
_cabalHash TreeKey
_tree) =
    String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString (PackageName -> String) -> PackageName -> String
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> PackageName
pkgName PackageIdentifier
ident) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" (from Hackage)"
  display (PLIArchive Archive
archive PackageMetadata
_pm) =
    Utf8Builder
"Archive from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ArchiveLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Archive -> ArchiveLocation
archiveLocation Archive
archive) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    (if Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Archive -> Text
archiveSubdir Archive
archive
       then Utf8Builder
forall a. Monoid a => a
mempty
       else Utf8Builder
" in subdir " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Archive -> Text
archiveSubdir Archive
archive))
  display (PLIRepo Repo
repo PackageMetadata
_pm) =
    Utf8Builder
"Repo from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoUrl Repo
repo) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
", commit " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoCommit Repo
repo) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    (if Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Repo -> Text
repoSubdir Repo
repo
       then Utf8Builder
forall a. Monoid a => a
mempty
       else Utf8Builder
" in subdir " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Repo -> Text
repoSubdir Repo
repo))

instance ToJSON PackageLocationImmutable where
  toJSON :: PackageLocationImmutable -> Value
toJSON = RawPackageLocationImmutable -> Value
forall a. ToJSON a => a -> Value
toJSON (RawPackageLocationImmutable -> Value)
-> (PackageLocationImmutable -> RawPackageLocationImmutable)
-> PackageLocationImmutable
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageLocationImmutable -> RawPackageLocationImmutable
toRawPLI

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

instance NFData RawArchive

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

-- | 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
$cto :: forall x. Rep RepoType x -> RepoType
$cfrom :: forall x. RepoType -> Rep RepoType x
Generic, Int -> RepoType -> ShowS
[RepoType] -> ShowS
RepoType -> String
(Int -> RepoType -> ShowS)
-> (RepoType -> String) -> ([RepoType] -> ShowS) -> Show RepoType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoType] -> ShowS
$cshowList :: [RepoType] -> ShowS
show :: RepoType -> String
$cshow :: RepoType -> String
showsPrec :: Int -> RepoType -> ShowS
$cshowsPrec :: Int -> RepoType -> ShowS
Show, RepoType -> RepoType -> Bool
(RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool) -> Eq RepoType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepoType -> RepoType -> Bool
$c/= :: RepoType -> RepoType -> Bool
== :: RepoType -> RepoType -> Bool
$c== :: RepoType -> RepoType -> Bool
Eq, Eq RepoType
Eq RepoType
-> (RepoType -> RepoType -> Ordering)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> RepoType)
-> (RepoType -> RepoType -> RepoType)
-> Ord RepoType
RepoType -> RepoType -> Bool
RepoType -> RepoType -> Ordering
RepoType -> RepoType -> RepoType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RepoType -> RepoType -> RepoType
$cmin :: RepoType -> RepoType -> RepoType
max :: RepoType -> RepoType -> RepoType
$cmax :: RepoType -> RepoType -> RepoType
>= :: RepoType -> RepoType -> Bool
$c>= :: RepoType -> RepoType -> Bool
> :: RepoType -> RepoType -> Bool
$c> :: RepoType -> RepoType -> Bool
<= :: RepoType -> RepoType -> Bool
$c<= :: RepoType -> RepoType -> Bool
< :: RepoType -> RepoType -> Bool
$c< :: RepoType -> RepoType -> Bool
compare :: RepoType -> RepoType -> Ordering
$ccompare :: RepoType -> RepoType -> Ordering
$cp1Ord :: Eq RepoType
Ord, Typeable)
instance NFData RepoType
instance PersistField RepoType where
  toPersistValue :: RepoType -> PersistValue
toPersistValue RepoType
RepoGit = Int32 -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Int32
1 :: Int32)
  toPersistValue RepoType
RepoHg = Int32 -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Int32
2 :: Int32)
  fromPersistValue :: PersistValue -> Either Text RepoType
fromPersistValue PersistValue
v = do
    Int32
i <- PersistValue -> Either Text Int32
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
    case Int32
i :: Int32 of
      Int32
1 -> RepoType -> Either Text RepoType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoType
RepoGit
      Int32
2 -> RepoType -> Either Text RepoType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoType
RepoHg
      Int32
_ -> Text -> Either Text RepoType
forall a b. a -> Either a b
Left (Text -> Either Text RepoType) -> Text -> Either Text RepoType
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Invalid RepoType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
i
instance PersistFieldSql RepoType where
  sqlType :: Proxy RepoType -> SqlType
sqlType Proxy RepoType
_ = SqlType
SqlInt32

-- | 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
$cto :: forall x. Rep Repo x -> Repo
$cfrom :: forall x. Repo -> Rep Repo x
Generic, Repo -> Repo -> Bool
(Repo -> Repo -> Bool) -> (Repo -> Repo -> Bool) -> Eq Repo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repo -> Repo -> Bool
$c/= :: Repo -> Repo -> Bool
== :: Repo -> Repo -> Bool
$c== :: Repo -> Repo -> Bool
Eq, Eq Repo
Eq Repo
-> (Repo -> Repo -> Ordering)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Repo)
-> (Repo -> Repo -> Repo)
-> Ord Repo
Repo -> Repo -> Bool
Repo -> Repo -> Ordering
Repo -> Repo -> Repo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Repo -> Repo -> Repo
$cmin :: Repo -> Repo -> Repo
max :: Repo -> Repo -> Repo
$cmax :: Repo -> Repo -> Repo
>= :: Repo -> Repo -> Bool
$c>= :: Repo -> Repo -> Bool
> :: Repo -> Repo -> Bool
$c> :: Repo -> Repo -> Bool
<= :: Repo -> Repo -> Bool
$c<= :: Repo -> Repo -> Bool
< :: Repo -> Repo -> Bool
$c< :: Repo -> Repo -> Bool
compare :: Repo -> Repo -> Ordering
$ccompare :: Repo -> Repo -> Ordering
$cp1Ord :: Eq Repo
Ord, Typeable)
instance NFData Repo
instance Show Repo where
  show :: Repo -> String
show = Text -> String
T.unpack (Text -> String) -> (Repo -> Text) -> Repo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> (Repo -> Utf8Builder) -> Repo -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repo -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance Display Repo where
  display :: Repo -> Utf8Builder
display (Repo Text
url Text
commit RepoType
typ Text
subdir) =
    (case RepoType
typ of
       RepoType
RepoGit -> Utf8Builder
"Git"
       RepoType
RepoHg -> Utf8Builder
"Mercurial") Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
" repo at " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
", commit " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
commit Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    (if Text -> Bool
T.null Text
subdir
      then Utf8Builder
forall a. Monoid a => a
mempty
      else Utf8Builder
" in subdirectory " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
subdir)

rToSimpleRepo :: Repo -> SimpleRepo
rToSimpleRepo :: Repo -> SimpleRepo
rToSimpleRepo Repo {Text
RepoType
repoSubdir :: Text
repoType :: RepoType
repoCommit :: Text
repoUrl :: Text
repoType :: Repo -> RepoType
repoSubdir :: Repo -> Text
repoCommit :: Repo -> Text
repoUrl :: Repo -> Text
..} = SimpleRepo :: Text -> Text -> RepoType -> SimpleRepo
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 -> String
(Int -> AggregateRepo -> ShowS)
-> (AggregateRepo -> String)
-> ([AggregateRepo] -> ShowS)
-> Show AggregateRepo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AggregateRepo] -> ShowS
$cshowList :: [AggregateRepo] -> ShowS
show :: AggregateRepo -> String
$cshow :: AggregateRepo -> String
showsPrec :: Int -> AggregateRepo -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep AggregateRepo x -> AggregateRepo
$cfrom :: forall x. AggregateRepo -> Rep AggregateRepo x
Generic, AggregateRepo -> AggregateRepo -> Bool
(AggregateRepo -> AggregateRepo -> Bool)
-> (AggregateRepo -> AggregateRepo -> Bool) -> Eq AggregateRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AggregateRepo -> AggregateRepo -> Bool
$c/= :: AggregateRepo -> AggregateRepo -> Bool
== :: AggregateRepo -> AggregateRepo -> Bool
$c== :: AggregateRepo -> AggregateRepo -> Bool
Eq, Eq AggregateRepo
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
min :: AggregateRepo -> AggregateRepo -> AggregateRepo
$cmin :: AggregateRepo -> AggregateRepo -> AggregateRepo
max :: AggregateRepo -> AggregateRepo -> AggregateRepo
$cmax :: AggregateRepo -> AggregateRepo -> AggregateRepo
>= :: AggregateRepo -> AggregateRepo -> Bool
$c>= :: AggregateRepo -> AggregateRepo -> Bool
> :: AggregateRepo -> AggregateRepo -> Bool
$c> :: AggregateRepo -> AggregateRepo -> Bool
<= :: AggregateRepo -> AggregateRepo -> Bool
$c<= :: AggregateRepo -> AggregateRepo -> Bool
< :: AggregateRepo -> AggregateRepo -> Bool
$c< :: AggregateRepo -> AggregateRepo -> Bool
compare :: AggregateRepo -> AggregateRepo -> Ordering
$ccompare :: AggregateRepo -> AggregateRepo -> Ordering
$cp1Ord :: Eq AggregateRepo
Ord, Typeable)


-- | Group input repositories by non-subdir values.
toAggregateRepos :: [(Repo, RawPackageMetadata)] -> [AggregateRepo]
toAggregateRepos :: [(Repo, RawPackageMetadata)] -> [AggregateRepo]
toAggregateRepos =
  ([(Repo, RawPackageMetadata)] -> AggregateRepo)
-> [[(Repo, RawPackageMetadata)]] -> [AggregateRepo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\xs :: [(Repo, RawPackageMetadata)]
xs@((Repo
repo, RawPackageMetadata
_):[(Repo, RawPackageMetadata)]
_) -> SimpleRepo -> [(Text, RawPackageMetadata)] -> AggregateRepo
AggregateRepo (Repo -> SimpleRepo
rToSimpleRepo Repo
repo) (((Repo, RawPackageMetadata) -> (Text, RawPackageMetadata))
-> [(Repo, RawPackageMetadata)] -> [(Text, RawPackageMetadata)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Repo -> Text)
-> (Repo, RawPackageMetadata) -> (Text, RawPackageMetadata)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Repo -> Text
repoSubdir) [(Repo, RawPackageMetadata)]
xs))
  ([[(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 Text
url1 Text
commit1 RepoType
type1 Text
_, RawPackageMetadata
_) (Repo Text
url2 Text
commit2 RepoType
type2 Text
_, RawPackageMetadata
_) -> (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
aRepoSubdirs :: [(Text, RawPackageMetadata)]
aRepo :: SimpleRepo
aRepoSubdirs :: AggregateRepo -> [(Text, RawPackageMetadata)]
aRepo :: AggregateRepo -> SimpleRepo
..} = 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 -> String
(Int -> SimpleRepo -> ShowS)
-> (SimpleRepo -> String)
-> ([SimpleRepo] -> ShowS)
-> Show SimpleRepo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleRepo] -> ShowS
$cshowList :: [SimpleRepo] -> ShowS
show :: SimpleRepo -> String
$cshow :: SimpleRepo -> String
showsPrec :: Int -> SimpleRepo -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep SimpleRepo x -> SimpleRepo
$cfrom :: forall x. SimpleRepo -> Rep SimpleRepo x
Generic, SimpleRepo -> SimpleRepo -> Bool
(SimpleRepo -> SimpleRepo -> Bool)
-> (SimpleRepo -> SimpleRepo -> Bool) -> Eq SimpleRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleRepo -> SimpleRepo -> Bool
$c/= :: SimpleRepo -> SimpleRepo -> Bool
== :: SimpleRepo -> SimpleRepo -> Bool
$c== :: SimpleRepo -> SimpleRepo -> Bool
Eq, Eq SimpleRepo
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
min :: SimpleRepo -> SimpleRepo -> SimpleRepo
$cmin :: SimpleRepo -> SimpleRepo -> SimpleRepo
max :: SimpleRepo -> SimpleRepo -> SimpleRepo
$cmax :: SimpleRepo -> SimpleRepo -> SimpleRepo
>= :: SimpleRepo -> SimpleRepo -> Bool
$c>= :: SimpleRepo -> SimpleRepo -> Bool
> :: SimpleRepo -> SimpleRepo -> Bool
$c> :: SimpleRepo -> SimpleRepo -> Bool
<= :: SimpleRepo -> SimpleRepo -> Bool
$c<= :: SimpleRepo -> SimpleRepo -> Bool
< :: SimpleRepo -> SimpleRepo -> Bool
$c< :: SimpleRepo -> SimpleRepo -> Bool
compare :: SimpleRepo -> SimpleRepo -> Ordering
$ccompare :: SimpleRepo -> SimpleRepo -> Ordering
$cp1Ord :: Eq 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 = String -> (Text -> Parser GitHubRepo) -> Value -> Parser GitHubRepo
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"GitHubRepo" ((Text -> Parser GitHubRepo) -> Value -> Parser GitHubRepo)
-> (Text -> Parser GitHubRepo) -> Value -> Parser GitHubRepo
forall a b. (a -> b) -> a -> b
$ \Text
s -> do
        case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
s of
            [Text
x, Text
y] | Bool -> Bool
not (Text -> Bool
T.null Text
x Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
y) -> GitHubRepo -> Parser GitHubRepo
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> GitHubRepo
GitHubRepo Text
s)
            [Text]
_ -> String -> Parser GitHubRepo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting \"user/repo\""

-- | Configuration for Hackage Security to securely download package
-- metadata and contents from Hackage. 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.1.0.0
data HackageSecurityConfig = HackageSecurityConfig
  { HackageSecurityConfig -> [Text]
hscKeyIds :: ![Text]
  , HackageSecurityConfig -> Int
hscKeyThreshold :: !Int
  , HackageSecurityConfig -> Text
hscDownloadPrefix :: !Text
  , HackageSecurityConfig -> Bool
hscIgnoreExpiry :: !Bool
  }
  deriving Int -> HackageSecurityConfig -> ShowS
[HackageSecurityConfig] -> ShowS
HackageSecurityConfig -> String
(Int -> HackageSecurityConfig -> ShowS)
-> (HackageSecurityConfig -> String)
-> ([HackageSecurityConfig] -> ShowS)
-> Show HackageSecurityConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HackageSecurityConfig] -> ShowS
$cshowList :: [HackageSecurityConfig] -> ShowS
show :: HackageSecurityConfig -> String
$cshow :: HackageSecurityConfig -> String
showsPrec :: Int -> HackageSecurityConfig -> ShowS
$cshowsPrec :: Int -> HackageSecurityConfig -> ShowS
Show
instance FromJSON (WithJSONWarnings HackageSecurityConfig) where
  parseJSON :: Value -> Parser (WithJSONWarnings HackageSecurityConfig)
parseJSON = String
-> (Object -> WarningParser HackageSecurityConfig)
-> Value
-> Parser (WithJSONWarnings HackageSecurityConfig)
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"HackageSecurityConfig" ((Object -> WarningParser HackageSecurityConfig)
 -> Value -> Parser (WithJSONWarnings HackageSecurityConfig))
-> (Object -> WarningParser HackageSecurityConfig)
-> Value
-> Parser (WithJSONWarnings HackageSecurityConfig)
forall a b. (a -> b) -> a -> b
$ \Object
o' -> do
    Text
hscDownloadPrefix <- Object
o' Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"download-prefix"
    Object Object
o <- Object
o' Object -> Text -> WarningParser Value
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hackage-security"
    [Text]
hscKeyIds <- Object
o Object -> Text -> WarningParser [Text]
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"keyids"
    Int
hscKeyThreshold <- Object
o Object -> Text -> WarningParser Int
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"key-threshold"
    Bool
hscIgnoreExpiry <- Object
o Object -> Text -> WarningParser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"ignore-expiry" WarningParser (Maybe Bool) -> Bool -> WarningParser Bool
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Bool
True
    HackageSecurityConfig -> WarningParser HackageSecurityConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure HackageSecurityConfig :: [Text] -> Int -> Text -> Bool -> HackageSecurityConfig
HackageSecurityConfig {Bool
Int
[Text]
Text
hscIgnoreExpiry :: Bool
hscKeyThreshold :: Int
hscKeyIds :: [Text]
hscDownloadPrefix :: Text
hscIgnoreExpiry :: Bool
hscDownloadPrefix :: Text
hscKeyThreshold :: Int
hscKeyIds :: [Text]
..}


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

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

instance Show BlobKey where
  show :: BlobKey -> String
show = Text -> String
T.unpack (Text -> String) -> (BlobKey -> Text) -> BlobKey -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (BlobKey -> Utf8Builder) -> BlobKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance Display BlobKey where
  display :: BlobKey -> Utf8Builder
display (BlobKey SHA256
sha FileSize
size') = SHA256 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SHA256
sha Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"," Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
size'

blobKeyPairs :: BlobKey -> [(Text, Value)]
blobKeyPairs :: BlobKey -> [(Text, Value)]
blobKeyPairs (BlobKey SHA256
sha FileSize
size') =
    [ Text
"sha256" Text -> SHA256 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SHA256
sha
    , Text
"size" Text -> FileSize -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FileSize
size'
    ]

instance ToJSON BlobKey where
  toJSON :: BlobKey -> Value
toJSON = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value)
-> (BlobKey -> [(Text, Value)]) -> BlobKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlobKey -> [(Text, Value)]
blobKeyPairs
instance FromJSON BlobKey where
  parseJSON :: Value -> Parser BlobKey
parseJSON = String -> (Object -> Parser BlobKey) -> Value -> Parser BlobKey
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BlobKey" ((Object -> Parser BlobKey) -> Value -> Parser BlobKey)
-> (Object -> Parser BlobKey) -> Value -> Parser BlobKey
forall a b. (a -> b) -> a -> b
$ \Object
o -> SHA256 -> FileSize -> BlobKey
BlobKey
    (SHA256 -> FileSize -> BlobKey)
-> Parser SHA256 -> Parser (FileSize -> BlobKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser SHA256
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"sha256"
    Parser (FileSize -> BlobKey) -> Parser FileSize -> Parser BlobKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser FileSize
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"size"

newtype PackageNameP = PackageNameP { PackageNameP -> PackageName
unPackageNameP :: PackageName }
  deriving (PackageNameP -> PackageNameP -> Bool
(PackageNameP -> PackageNameP -> Bool)
-> (PackageNameP -> PackageNameP -> Bool) -> Eq PackageNameP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageNameP -> PackageNameP -> Bool
$c/= :: PackageNameP -> PackageNameP -> Bool
== :: PackageNameP -> PackageNameP -> Bool
$c== :: PackageNameP -> PackageNameP -> Bool
Eq, Eq PackageNameP
Eq PackageNameP
-> (PackageNameP -> PackageNameP -> Ordering)
-> (PackageNameP -> PackageNameP -> Bool)
-> (PackageNameP -> PackageNameP -> Bool)
-> (PackageNameP -> PackageNameP -> Bool)
-> (PackageNameP -> PackageNameP -> Bool)
-> (PackageNameP -> PackageNameP -> PackageNameP)
-> (PackageNameP -> PackageNameP -> PackageNameP)
-> Ord PackageNameP
PackageNameP -> PackageNameP -> Bool
PackageNameP -> PackageNameP -> Ordering
PackageNameP -> PackageNameP -> PackageNameP
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageNameP -> PackageNameP -> PackageNameP
$cmin :: PackageNameP -> PackageNameP -> PackageNameP
max :: PackageNameP -> PackageNameP -> PackageNameP
$cmax :: PackageNameP -> PackageNameP -> PackageNameP
>= :: PackageNameP -> PackageNameP -> Bool
$c>= :: PackageNameP -> PackageNameP -> Bool
> :: PackageNameP -> PackageNameP -> Bool
$c> :: PackageNameP -> PackageNameP -> Bool
<= :: PackageNameP -> PackageNameP -> Bool
$c<= :: PackageNameP -> PackageNameP -> Bool
< :: PackageNameP -> PackageNameP -> Bool
$c< :: PackageNameP -> PackageNameP -> Bool
compare :: PackageNameP -> PackageNameP -> Ordering
$ccompare :: PackageNameP -> PackageNameP -> Ordering
$cp1Ord :: Eq PackageNameP
Ord, Int -> PackageNameP -> ShowS
[PackageNameP] -> ShowS
PackageNameP -> String
(Int -> PackageNameP -> ShowS)
-> (PackageNameP -> String)
-> ([PackageNameP] -> ShowS)
-> Show PackageNameP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageNameP] -> ShowS
$cshowList :: [PackageNameP] -> ShowS
show :: PackageNameP -> String
$cshow :: PackageNameP -> String
showsPrec :: Int -> PackageNameP -> ShowS
$cshowsPrec :: Int -> PackageNameP -> ShowS
Show, ReadPrec [PackageNameP]
ReadPrec PackageNameP
Int -> ReadS PackageNameP
ReadS [PackageNameP]
(Int -> ReadS PackageNameP)
-> ReadS [PackageNameP]
-> ReadPrec PackageNameP
-> ReadPrec [PackageNameP]
-> Read PackageNameP
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PackageNameP]
$creadListPrec :: ReadPrec [PackageNameP]
readPrec :: ReadPrec PackageNameP
$creadPrec :: ReadPrec PackageNameP
readList :: ReadS [PackageNameP]
$creadList :: ReadS [PackageNameP]
readsPrec :: Int -> ReadS PackageNameP
$creadsPrec :: Int -> ReadS PackageNameP
Read, PackageNameP -> ()
(PackageNameP -> ()) -> NFData PackageNameP
forall a. (a -> ()) -> NFData a
rnf :: PackageNameP -> ()
$crnf :: PackageNameP -> ()
NFData)
instance Display PackageNameP where
  display :: PackageNameP -> Utf8Builder
display = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder)
-> (PackageNameP -> String) -> PackageNameP -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
packageNameString (PackageName -> String)
-> (PackageNameP -> PackageName) -> PackageNameP -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageNameP -> PackageName
unPackageNameP
instance PersistField PackageNameP where
  toPersistValue :: PackageNameP -> PersistValue
toPersistValue (PackageNameP PackageName
pn) = Text -> PersistValue
PersistText (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PackageName -> String
packageNameString PackageName
pn
  fromPersistValue :: PersistValue -> Either Text PackageNameP
fromPersistValue PersistValue
v = do
    String
str <- PersistValue -> Either Text String
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
    case String -> Maybe PackageName
parsePackageName String
str of
      Maybe PackageName
Nothing -> Text -> Either Text PackageNameP
forall a b. a -> Either a b
Left (Text -> Either Text PackageNameP)
-> Text -> Either Text PackageNameP
forall a b. (a -> b) -> a -> b
$ Text
"Invalid package name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
str
      Just PackageName
pn -> PackageNameP -> Either Text PackageNameP
forall a b. b -> Either a b
Right (PackageNameP -> Either Text PackageNameP)
-> PackageNameP -> Either Text PackageNameP
forall a b. (a -> b) -> a -> b
$ PackageName -> PackageNameP
PackageNameP PackageName
pn
instance PersistFieldSql PackageNameP where
  sqlType :: Proxy PackageNameP -> SqlType
sqlType Proxy PackageNameP
_ = SqlType
SqlString
instance ToJSON PackageNameP where
  toJSON :: PackageNameP -> Value
toJSON (PackageNameP PackageName
pn) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PackageName -> String
packageNameString PackageName
pn
instance FromJSON PackageNameP where
  parseJSON :: Value -> Parser PackageNameP
parseJSON = String
-> (Text -> Parser PackageNameP) -> Value -> Parser PackageNameP
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PackageNameP" ((Text -> Parser PackageNameP) -> Value -> Parser PackageNameP)
-> (Text -> Parser PackageNameP) -> Value -> Parser PackageNameP
forall a b. (a -> b) -> a -> b
$ PackageNameP -> Parser PackageNameP
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageNameP -> Parser PackageNameP)
-> (Text -> PackageNameP) -> Text -> Parser PackageNameP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> PackageNameP
PackageNameP (PackageName -> PackageNameP)
-> (Text -> PackageName) -> Text -> PackageNameP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PackageName
mkPackageName (String -> PackageName) -> (Text -> String) -> Text -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
instance ToJSONKey PackageNameP where
  toJSONKey :: ToJSONKeyFunction PackageNameP
toJSONKey =
    (PackageNameP -> Text)
-> (PackageNameP -> Encoding' Text)
-> ToJSONKeyFunction PackageNameP
forall a.
(a -> Text) -> (a -> Encoding' Text) -> ToJSONKeyFunction a
ToJSONKeyText
      (String -> Text
T.pack (String -> Text)
-> (PackageNameP -> String) -> PackageNameP -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
packageNameString (PackageName -> String)
-> (PackageNameP -> PackageName) -> PackageNameP -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageNameP -> PackageName
unPackageNameP)
      (Builder -> Encoding' Text
forall a. Builder -> Encoding' a
unsafeToEncoding (Builder -> Encoding' Text)
-> (PackageNameP -> Builder) -> PackageNameP -> Encoding' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Builder
getUtf8Builder (Utf8Builder -> Builder)
-> (PackageNameP -> Utf8Builder) -> PackageNameP -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageNameP -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display)
instance FromJSONKey PackageNameP where
  fromJSONKey :: FromJSONKeyFunction PackageNameP
fromJSONKey = (Text -> PackageNameP) -> FromJSONKeyFunction PackageNameP
forall a. (Text -> a) -> FromJSONKeyFunction a
FromJSONKeyText ((Text -> PackageNameP) -> FromJSONKeyFunction PackageNameP)
-> (Text -> PackageNameP) -> FromJSONKeyFunction PackageNameP
forall a b. (a -> b) -> a -> b
$ PackageName -> PackageNameP
PackageNameP (PackageName -> PackageNameP)
-> (Text -> PackageName) -> Text -> PackageNameP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PackageName
mkPackageName (String -> PackageName) -> (Text -> String) -> Text -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

newtype VersionP = VersionP { VersionP -> Version
unVersionP :: Version }
  deriving (VersionP -> VersionP -> Bool
(VersionP -> VersionP -> Bool)
-> (VersionP -> VersionP -> Bool) -> Eq VersionP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionP -> VersionP -> Bool
$c/= :: VersionP -> VersionP -> Bool
== :: VersionP -> VersionP -> Bool
$c== :: VersionP -> VersionP -> Bool
Eq, Eq VersionP
Eq VersionP
-> (VersionP -> VersionP -> Ordering)
-> (VersionP -> VersionP -> Bool)
-> (VersionP -> VersionP -> Bool)
-> (VersionP -> VersionP -> Bool)
-> (VersionP -> VersionP -> Bool)
-> (VersionP -> VersionP -> VersionP)
-> (VersionP -> VersionP -> VersionP)
-> Ord VersionP
VersionP -> VersionP -> Bool
VersionP -> VersionP -> Ordering
VersionP -> VersionP -> VersionP
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VersionP -> VersionP -> VersionP
$cmin :: VersionP -> VersionP -> VersionP
max :: VersionP -> VersionP -> VersionP
$cmax :: VersionP -> VersionP -> VersionP
>= :: VersionP -> VersionP -> Bool
$c>= :: VersionP -> VersionP -> Bool
> :: VersionP -> VersionP -> Bool
$c> :: VersionP -> VersionP -> Bool
<= :: VersionP -> VersionP -> Bool
$c<= :: VersionP -> VersionP -> Bool
< :: VersionP -> VersionP -> Bool
$c< :: VersionP -> VersionP -> Bool
compare :: VersionP -> VersionP -> Ordering
$ccompare :: VersionP -> VersionP -> Ordering
$cp1Ord :: Eq VersionP
Ord, Int -> VersionP -> ShowS
[VersionP] -> ShowS
VersionP -> String
(Int -> VersionP -> ShowS)
-> (VersionP -> String) -> ([VersionP] -> ShowS) -> Show VersionP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionP] -> ShowS
$cshowList :: [VersionP] -> ShowS
show :: VersionP -> String
$cshow :: VersionP -> String
showsPrec :: Int -> VersionP -> ShowS
$cshowsPrec :: Int -> VersionP -> ShowS
Show, ReadPrec [VersionP]
ReadPrec VersionP
Int -> ReadS VersionP
ReadS [VersionP]
(Int -> ReadS VersionP)
-> ReadS [VersionP]
-> ReadPrec VersionP
-> ReadPrec [VersionP]
-> Read VersionP
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VersionP]
$creadListPrec :: ReadPrec [VersionP]
readPrec :: ReadPrec VersionP
$creadPrec :: ReadPrec VersionP
readList :: ReadS [VersionP]
$creadList :: ReadS [VersionP]
readsPrec :: Int -> ReadS VersionP
$creadsPrec :: Int -> ReadS VersionP
Read, VersionP -> ()
(VersionP -> ()) -> NFData VersionP
forall a. (a -> ()) -> NFData a
rnf :: VersionP -> ()
$crnf :: VersionP -> ()
NFData)
instance PersistField VersionP where
  toPersistValue :: VersionP -> PersistValue
toPersistValue (VersionP Version
v) = Text -> PersistValue
PersistText (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
versionString Version
v
  fromPersistValue :: PersistValue -> Either Text VersionP
fromPersistValue PersistValue
v = do
    String
str <- PersistValue -> Either Text String
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
    case String -> Maybe Version
parseVersion String
str of
      Maybe Version
Nothing -> Text -> Either Text VersionP
forall a b. a -> Either a b
Left (Text -> Either Text VersionP) -> Text -> Either Text VersionP
forall a b. (a -> b) -> a -> b
$ Text
"Invalid version number: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
str
      Just Version
ver -> VersionP -> Either Text VersionP
forall a b. b -> Either a b
Right (VersionP -> Either Text VersionP)
-> VersionP -> Either Text VersionP
forall a b. (a -> b) -> a -> b
$ Version -> VersionP
VersionP Version
ver
instance PersistFieldSql VersionP where
  sqlType :: Proxy VersionP -> SqlType
sqlType Proxy VersionP
_ = SqlType
SqlString
instance Display VersionP where
  display :: VersionP -> Utf8Builder
display (VersionP Version
v) = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder) -> String -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Version -> String
versionString Version
v
instance ToJSON VersionP where
  toJSON :: VersionP -> Value
toJSON (VersionP Version
v) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
versionString Version
v
instance FromJSON VersionP where
  parseJSON :: Value -> Parser VersionP
parseJSON =
    String -> (Text -> Parser VersionP) -> Value -> Parser VersionP
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"VersionP" ((Text -> Parser VersionP) -> Value -> Parser VersionP)
-> (Text -> Parser VersionP) -> Value -> Parser VersionP
forall a b. (a -> b) -> a -> b
$
    (SomeException -> Parser VersionP)
-> (Version -> Parser VersionP)
-> Either SomeException Version
-> Parser VersionP
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser VersionP
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser VersionP)
-> (SomeException -> String) -> SomeException -> Parser VersionP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException) (VersionP -> Parser VersionP
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VersionP -> Parser VersionP)
-> (Version -> VersionP) -> Version -> Parser VersionP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> VersionP
VersionP) (Either SomeException Version -> Parser VersionP)
-> (Text -> Either SomeException Version)
-> Text
-> Parser VersionP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either SomeException Version
forall (m :: * -> *). MonadThrow m => String -> m Version
parseVersionThrowing (String -> Either SomeException Version)
-> (Text -> String) -> Text -> Either SomeException Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

newtype ModuleNameP = ModuleNameP
  { ModuleNameP -> ModuleName
unModuleNameP :: ModuleName
  } deriving (ModuleNameP -> ModuleNameP -> Bool
(ModuleNameP -> ModuleNameP -> Bool)
-> (ModuleNameP -> ModuleNameP -> Bool) -> Eq ModuleNameP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleNameP -> ModuleNameP -> Bool
$c/= :: ModuleNameP -> ModuleNameP -> Bool
== :: ModuleNameP -> ModuleNameP -> Bool
$c== :: ModuleNameP -> ModuleNameP -> Bool
Eq, Eq ModuleNameP
Eq ModuleNameP
-> (ModuleNameP -> ModuleNameP -> Ordering)
-> (ModuleNameP -> ModuleNameP -> Bool)
-> (ModuleNameP -> ModuleNameP -> Bool)
-> (ModuleNameP -> ModuleNameP -> Bool)
-> (ModuleNameP -> ModuleNameP -> Bool)
-> (ModuleNameP -> ModuleNameP -> ModuleNameP)
-> (ModuleNameP -> ModuleNameP -> ModuleNameP)
-> Ord ModuleNameP
ModuleNameP -> ModuleNameP -> Bool
ModuleNameP -> ModuleNameP -> Ordering
ModuleNameP -> ModuleNameP -> ModuleNameP
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModuleNameP -> ModuleNameP -> ModuleNameP
$cmin :: ModuleNameP -> ModuleNameP -> ModuleNameP
max :: ModuleNameP -> ModuleNameP -> ModuleNameP
$cmax :: ModuleNameP -> ModuleNameP -> ModuleNameP
>= :: ModuleNameP -> ModuleNameP -> Bool
$c>= :: ModuleNameP -> ModuleNameP -> Bool
> :: ModuleNameP -> ModuleNameP -> Bool
$c> :: ModuleNameP -> ModuleNameP -> Bool
<= :: ModuleNameP -> ModuleNameP -> Bool
$c<= :: ModuleNameP -> ModuleNameP -> Bool
< :: ModuleNameP -> ModuleNameP -> Bool
$c< :: ModuleNameP -> ModuleNameP -> Bool
compare :: ModuleNameP -> ModuleNameP -> Ordering
$ccompare :: ModuleNameP -> ModuleNameP -> Ordering
$cp1Ord :: Eq ModuleNameP
Ord, Int -> ModuleNameP -> ShowS
[ModuleNameP] -> ShowS
ModuleNameP -> String
(Int -> ModuleNameP -> ShowS)
-> (ModuleNameP -> String)
-> ([ModuleNameP] -> ShowS)
-> Show ModuleNameP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleNameP] -> ShowS
$cshowList :: [ModuleNameP] -> ShowS
show :: ModuleNameP -> String
$cshow :: ModuleNameP -> String
showsPrec :: Int -> ModuleNameP -> ShowS
$cshowsPrec :: Int -> ModuleNameP -> ShowS
Show, ModuleNameP -> ()
(ModuleNameP -> ()) -> NFData ModuleNameP
forall a. (a -> ()) -> NFData a
rnf :: ModuleNameP -> ()
$crnf :: ModuleNameP -> ()
NFData)
instance Display ModuleNameP where
  display :: ModuleNameP -> Utf8Builder
display = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder)
-> (ModuleNameP -> String) -> ModuleNameP -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString (ModuleName -> String)
-> (ModuleNameP -> ModuleName) -> ModuleNameP -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleNameP -> ModuleName
unModuleNameP
instance PersistField ModuleNameP where
  toPersistValue :: ModuleNameP -> PersistValue
toPersistValue (ModuleNameP ModuleName
mn) = Text -> PersistValue
PersistText (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
mn
  fromPersistValue :: PersistValue -> Either Text ModuleNameP
fromPersistValue PersistValue
v = do
    String
str <- PersistValue -> Either Text String
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
    case String -> Maybe ModuleName
parseModuleName String
str of
      Maybe ModuleName
Nothing -> Text -> Either Text ModuleNameP
forall a b. a -> Either a b
Left (Text -> Either Text ModuleNameP)
-> Text -> Either Text ModuleNameP
forall a b. (a -> b) -> a -> b
$ Text
"Invalid module name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
str
      Just ModuleName
pn -> ModuleNameP -> Either Text ModuleNameP
forall a b. b -> Either a b
Right (ModuleNameP -> Either Text ModuleNameP)
-> ModuleNameP -> Either Text ModuleNameP
forall a b. (a -> b) -> a -> b
$ ModuleName -> ModuleNameP
ModuleNameP ModuleName
pn
instance PersistFieldSql ModuleNameP where
  sqlType :: Proxy ModuleNameP -> SqlType
sqlType Proxy ModuleNameP
_ = SqlType
SqlString

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

instance Display CabalFileInfo where
  display :: CabalFileInfo -> Utf8Builder
display CabalFileInfo
CFILatest = Utf8Builder
forall a. Monoid a => a
mempty
  display (CFIHash SHA256
hash' Maybe FileSize
msize) =
    Utf8Builder
"@sha256:" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SHA256 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SHA256
hash' Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
-> (FileSize -> Utf8Builder) -> Maybe FileSize -> Utf8Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Utf8Builder
forall a. Monoid a => a
mempty (\FileSize
i -> Utf8Builder
"," Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
i) Maybe FileSize
msize
  display (CFIRevision Revision
rev) = Utf8Builder
"@rev:" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Revision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Revision
rev

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

instance Show PackageIdentifierRevision where
  show :: PackageIdentifierRevision -> String
show = Text -> String
T.unpack (Text -> String)
-> (PackageIdentifierRevision -> Text)
-> PackageIdentifierRevision
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (PackageIdentifierRevision -> Utf8Builder)
-> PackageIdentifierRevision
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display

instance Display PackageIdentifierRevision where
  display :: PackageIdentifierRevision -> Utf8Builder
display (PackageIdentifierRevision PackageName
name Version
version CabalFileInfo
cfi) =
    String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
version) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> CabalFileInfo -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display CabalFileInfo
cfi

instance ToJSON PackageIdentifierRevision where
  toJSON :: PackageIdentifierRevision -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (PackageIdentifierRevision -> Text)
-> PackageIdentifierRevision
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (PackageIdentifierRevision -> Utf8Builder)
-> PackageIdentifierRevision
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance FromJSON PackageIdentifierRevision where
  parseJSON :: Value -> Parser PackageIdentifierRevision
parseJSON = String
-> (Text -> Parser PackageIdentifierRevision)
-> Value
-> Parser PackageIdentifierRevision
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PackageIdentifierRevision" ((Text -> Parser PackageIdentifierRevision)
 -> Value -> Parser PackageIdentifierRevision)
-> (Text -> Parser PackageIdentifierRevision)
-> Value
-> Parser PackageIdentifierRevision
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Text -> Either PantryException PackageIdentifierRevision
parsePackageIdentifierRevision Text
t of
      Left PantryException
e -> String -> Parser PackageIdentifierRevision
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser PackageIdentifierRevision)
-> String -> Parser PackageIdentifierRevision
forall a b. (a -> b) -> a -> b
$ PantryException -> String
forall a. Show a => a -> String
show PantryException
e
      Right PackageIdentifierRevision
pir -> PackageIdentifierRevision -> Parser PackageIdentifierRevision
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageIdentifierRevision
pir

-- | Parse a hackage text.
--
-- @since 0.1.0.0
parseHackageText :: Text -> Either PantryException (PackageIdentifier, BlobKey)
parseHackageText :: Text -> Either PantryException (PackageIdentifier, BlobKey)
parseHackageText Text
t =
  (String -> Either PantryException (PackageIdentifier, BlobKey))
-> ((PackageIdentifier, BlobKey)
    -> Either PantryException (PackageIdentifier, BlobKey))
-> Either String (PackageIdentifier, BlobKey)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
x -> String
-> (Any -> Either PantryException Any)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a. HasCallStack => String -> a
error (ShowS
forall a. Show a => a -> String
show String
x) ((Any -> Either PantryException Any)
 -> Either PantryException (PackageIdentifier, BlobKey))
-> (Any -> Either PantryException Any)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a b. (a -> b) -> a -> b
$ Either PantryException Any -> Any -> Either PantryException Any
forall a b. a -> b -> a
const (Either PantryException Any -> Any -> Either PantryException Any)
-> Either PantryException Any -> Any -> Either PantryException Any
forall a b. (a -> b) -> a -> b
$ PantryException -> Either PantryException Any
forall a b. a -> Either a b
Left (PantryException -> Either PantryException Any)
-> PantryException -> Either PantryException Any
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
PackageIdentifierRevisionParseFail Text
t) (PackageIdentifier, BlobKey)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a b. b -> Either a b
Right (Either String (PackageIdentifier, BlobKey)
 -> Either PantryException (PackageIdentifier, BlobKey))
-> Either String (PackageIdentifier, BlobKey)
-> Either PantryException (PackageIdentifier, BlobKey)
forall a b. (a -> b) -> a -> b
$
  ParsecParser (PackageIdentifier, BlobKey)
-> String -> Either String (PackageIdentifier, BlobKey)
forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec (ParsecParser (PackageIdentifier, BlobKey)
hackageTextParsec ParsecParser (PackageIdentifier, BlobKey)
-> ParsecParser () -> ParsecParser (PackageIdentifier, BlobKey)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecParser ()
forall (m :: * -> *). Parsing m => m ()
Parse.eof) (String -> Either String (PackageIdentifier, BlobKey))
-> String -> Either String (PackageIdentifier, BlobKey)
forall a b. (a -> b) -> a -> b
$
  Text -> String
T.unpack Text
t

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

  String
shaT <- (Char -> Bool) -> ParsecParser String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
Parse.munch (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',')
  SHA256
sha <- (SHA256Exception -> ParsecParser SHA256)
-> (SHA256 -> ParsecParser SHA256)
-> Either SHA256Exception SHA256
-> ParsecParser SHA256
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParsecParser SHA256 -> SHA256Exception -> ParsecParser SHA256
forall a b. a -> b -> a
const ParsecParser SHA256
forall (m :: * -> *) a. MonadPlus m => m a
mzero) SHA256 -> ParsecParser SHA256
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SHA256Exception SHA256 -> ParsecParser SHA256)
-> Either SHA256Exception SHA256 -> ParsecParser SHA256
forall a b. (a -> b) -> a -> b
$ Text -> Either SHA256Exception SHA256
SHA256.fromHexText (Text -> Either SHA256Exception SHA256)
-> Text -> Either SHA256Exception SHA256
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
shaT

  Char
_ <- Char -> ParsecParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Parse.char Char
','
  Word
size' <- ParsecParser Word
forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
Parse.integral -- FIXME probably need to handle overflow, since unfortunately Cabal doesn't
  (PackageIdentifier, BlobKey)
-> ParsecParser (PackageIdentifier, BlobKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageIdentifier
ident, SHA256 -> FileSize -> BlobKey
BlobKey SHA256
sha (Word -> FileSize
FileSize Word
size'))

splitColon :: Text -> Maybe (Text, Text)
splitColon :: Text -> Maybe (Text, Text)
splitColon Text
t' =
    let (Text
x, Text
y) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
t'
     in (Text
x, ) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
T.stripPrefix Text
":" Text
y

-- | 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 <- String -> Maybe PackageIdentifier
parsePackageIdentifier (String -> Maybe PackageIdentifier)
-> String -> Maybe PackageIdentifier
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
identT
  CabalFileInfo
cfi <-
    case Text -> Maybe (Text, Text)
splitColon Text
cfiT of
      Just (Text
"@sha256", Text
shaSizeT) -> do
        let (Text
shaT, Text
sizeT) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
shaSizeT
        SHA256
sha <- (SHA256Exception -> Maybe SHA256)
-> (SHA256 -> Maybe SHA256)
-> Either SHA256Exception SHA256
-> Maybe SHA256
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe SHA256 -> SHA256Exception -> Maybe SHA256
forall a b. a -> b -> a
const Maybe SHA256
forall a. Maybe a
Nothing) SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just (Either SHA256Exception SHA256 -> Maybe SHA256)
-> Either SHA256Exception SHA256 -> Maybe SHA256
forall a b. (a -> b) -> a -> b
$ Text -> Either SHA256Exception SHA256
SHA256.fromHexText Text
shaT
        Maybe FileSize
msize <-
          case Text -> Text -> Maybe Text
T.stripPrefix Text
"," Text
sizeT of
            Maybe Text
Nothing -> Maybe FileSize -> Maybe (Maybe FileSize)
forall a. a -> Maybe a
Just Maybe FileSize
forall a. Maybe a
Nothing
            Just Text
sizeT' ->
              case Reader Word
forall a. Integral a => Reader a
decimal Text
sizeT' of
                Right (Word
size', Text
"") -> Maybe FileSize -> Maybe (Maybe FileSize)
forall a. a -> Maybe a
Just (Maybe FileSize -> Maybe (Maybe FileSize))
-> Maybe FileSize -> Maybe (Maybe FileSize)
forall a b. (a -> b) -> a -> b
$ FileSize -> Maybe FileSize
forall a. a -> Maybe a
Just (FileSize -> Maybe FileSize) -> FileSize -> Maybe FileSize
forall a b. (a -> b) -> a -> b
$ Word -> FileSize
FileSize Word
size'
                Either String (Word, Text)
_ -> Maybe (Maybe FileSize)
forall a. Maybe a
Nothing
        CabalFileInfo -> Maybe CabalFileInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CabalFileInfo -> Maybe CabalFileInfo)
-> CabalFileInfo -> Maybe CabalFileInfo
forall a b. (a -> b) -> a -> b
$ SHA256 -> Maybe FileSize -> CabalFileInfo
CFIHash SHA256
sha Maybe FileSize
msize
      Just (Text
"@rev", Text
revT) ->
        case Reader Word
forall a. Integral a => Reader a
decimal Text
revT of
          Right (Word
rev, Text
"") -> CabalFileInfo -> Maybe CabalFileInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CabalFileInfo -> Maybe CabalFileInfo)
-> CabalFileInfo -> Maybe CabalFileInfo
forall a b. (a -> b) -> a -> b
$ Revision -> CabalFileInfo
CFIRevision (Revision -> CabalFileInfo) -> Revision -> CabalFileInfo
forall a b. (a -> b) -> a -> b
$ Word -> Revision
Revision Word
rev
          Either String (Word, Text)
_ -> Maybe CabalFileInfo
forall a. Maybe a
Nothing
      Maybe (Text, Text)
Nothing -> CabalFileInfo -> Maybe CabalFileInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure CabalFileInfo
CFILatest
      Maybe (Text, Text)
_ -> Maybe CabalFileInfo
forall a. Maybe a
Nothing
  PackageIdentifierRevision -> Maybe PackageIdentifierRevision
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageIdentifierRevision -> Maybe PackageIdentifierRevision)
-> PackageIdentifierRevision -> Maybe PackageIdentifierRevision
forall a b. (a -> b) -> a -> b
$ PackageName
-> Version -> CabalFileInfo -> PackageIdentifierRevision
PackageIdentifierRevision PackageName
name Version
version CabalFileInfo
cfi

data Mismatch a = Mismatch
  { Mismatch a -> a
mismatchExpected :: !a
  , Mismatch a -> a
mismatchActual :: !a
  }

-- | 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
  | NoCabalFileFound !(Path Abs Dir)
  | MultipleCabalFilesFound !(Path Abs Dir) ![Path Abs File]
  | InvalidWantedCompiler !Text
  | InvalidSnapshotLocation !(Path Abs Dir) !Text
  | InvalidOverrideCompiler !WantedCompiler !WantedCompiler
  | InvalidFilePathSnapshot !Text
  | InvalidSnapshot !RawSnapshotLocation !SomeException
  | MismatchedPackageMetadata
      !RawPackageLocationImmutable
      !RawPackageMetadata
      !(Maybe TreeKey)
      !PackageIdentifier
  | Non200ResponseStatus !Status
  | InvalidBlobKey !(Mismatch BlobKey)
  | Couldn'tParseSnapshot !RawSnapshotLocation !String
  | WrongCabalFileName !RawPackageLocationImmutable !SafeFilePath !PackageName
  | DownloadInvalidSHA256 !Text !(Mismatch SHA256)
  | DownloadInvalidSize !Text !(Mismatch FileSize)
  | DownloadTooLarge !Text !(Mismatch FileSize)
  -- ^ Different from 'DownloadInvalidSize' since 'mismatchActual' is
  -- a lower bound on the size from the server.
  | LocalInvalidSHA256 !(Path Abs File) !(Mismatch SHA256)
  | LocalInvalidSize !(Path Abs File) !(Mismatch FileSize)
  | UnknownArchiveType !ArchiveLocation
  | InvalidTarFileType !ArchiveLocation !FilePath !Tar.FileType
  | UnsupportedTarball !ArchiveLocation !Text
  | NoHackageCryptographicHash !PackageIdentifier
  | FailedToCloneRepo !SimpleRepo
  | TreeReferencesMissingBlob !RawPackageLocationImmutable !SafeFilePath !BlobKey
  | CompletePackageMetadataMismatch !RawPackageLocationImmutable !PackageMetadata
  | CRC32Mismatch !ArchiveLocation !FilePath !(Mismatch Word32)
  | UnknownHackagePackage !PackageIdentifierRevision !FuzzyResults
  | CannotCompleteRepoNonSHA1 !Repo
  | MutablePackageLocationFromUrl !Text
  | MismatchedCabalFileForHackage !PackageIdentifierRevision !(Mismatch PackageIdentifier)
  | PackageNameParseFail !Text
  | PackageVersionParseFail !Text
  | InvalidCabalFilePath !(Path Abs File)
  | DuplicatePackageNames !Utf8Builder ![(PackageName, [RawPackageLocationImmutable])]
  | MigrationFailure !Text !(Path Abs File) !SomeException
  | InvalidTreeFromCasa !BlobKey !ByteString
  | ParseSnapNameException !Text

  deriving Typeable
instance Exception PantryException where
instance Show PantryException where
  show :: PantryException -> String
show = Text -> String
T.unpack (Text -> String)
-> (PantryException -> Text) -> PantryException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (PantryException -> Utf8Builder) -> PantryException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PantryException -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance Display PantryException where
  display :: PantryException -> Utf8Builder
display (InvalidTreeFromCasa BlobKey
blobKey ByteString
_bs) = Utf8Builder
"Invalid tree from casa: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display BlobKey
blobKey
  display (PackageIdentifierRevisionParseFail Text
text) =
    Utf8Builder
"Invalid package identifier (with optional revision): " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
text
  display (InvalidCabalFile Either RawPackageLocationImmutable (Path Abs File)
loc Maybe Version
mversion [PError]
errs [PWarning]
warnings) =
    Utf8Builder
"Unable to parse cabal file from package " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    (RawPackageLocationImmutable -> Utf8Builder)
-> (Path Abs File -> Utf8Builder)
-> Either RawPackageLocationImmutable (Path Abs File)
-> Utf8Builder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder)
-> (Path Abs File -> String) -> Path Abs File -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> String
forall b t. Path b t -> String
toFilePath) Either RawPackageLocationImmutable (Path Abs File)
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\n\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    (PError -> Utf8Builder) -> [PError] -> Utf8Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
      (\(PError Position
pos String
msg) ->
          Utf8Builder
"- " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
          String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Position -> String
showPos Position
pos) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
          Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
          String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
msg Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
          Utf8Builder
"\n")
      [PError]
errs Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    (PWarning -> Utf8Builder) -> [PWarning] -> Utf8Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
      (\(PWarning PWarnType
_ Position
pos String
msg) ->
          Utf8Builder
"- " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
          String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Position -> String
showPos Position
pos) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
          Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
          String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
msg Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
          Utf8Builder
"\n")
      [PWarning]
warnings Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>

    (case Maybe Version
mversion of
       Just Version
version
         | Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
cabalSpecLatestVersion ->
             Utf8Builder
"\n\nThe cabal file uses the cabal specification version " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
             String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
version) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
             Utf8Builder
", but we only support up to version " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
             String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
cabalSpecLatestVersion) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
             Utf8Builder
".\nRecommended action: upgrade your build tool (e.g., `stack upgrade`)."
       Maybe Version
_ -> Utf8Builder
forall a. Monoid a => a
mempty)
  display (TreeWithoutCabalFile RawPackageLocationImmutable
pl) = Utf8Builder
"No cabal file found for " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
pl
  display (TreeWithMultipleCabalFiles RawPackageLocationImmutable
pl [SafeFilePath]
sfps) =
    Utf8Builder
"Multiple cabal files found for " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
pl Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    [Utf8Builder] -> Utf8Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Utf8Builder -> [Utf8Builder] -> [Utf8Builder]
forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " ((SafeFilePath -> Utf8Builder) -> [SafeFilePath] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map SafeFilePath -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display [SafeFilePath]
sfps))
  display (MismatchedCabalName Path Abs File
fp PackageName
name) =
    Utf8Builder
"cabal file path " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
" does not match the package name it defines.\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"Please rename the file to: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
".cabal\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"For more information, see: https://github.com/commercialhaskell/stack/issues/317"
  display (NoCabalFileFound Path Abs Dir
dir) =
    Utf8Builder
"Stack looks for packages in the directories configured in\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"the 'packages' and 'extra-deps' fields defined in your stack.yaml\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"The current entry points to " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
dir) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
",\nbut no .cabal or package.yaml file could be found there."
  display (MultipleCabalFilesFound Path Abs Dir
dir [Path Abs File]
files) =
    Utf8Builder
"Multiple .cabal files found in directory " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
dir) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
":\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    [Utf8Builder] -> Utf8Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Utf8Builder -> [Utf8Builder] -> [Utf8Builder]
forall a. a -> [a] -> [a]
intersperse Utf8Builder
"\n" ((Path Abs File -> Utf8Builder) -> [Path Abs File] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\Path Abs File
x -> Utf8Builder
"- " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Rel File -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Abs File
x))) [Path Abs File]
files))
  display (InvalidWantedCompiler Text
t) = Utf8Builder
"Invalid wanted compiler: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
t
  display (InvalidSnapshotLocation Path Abs Dir
dir Text
t) =
    Utf8Builder
"Invalid snapshot location " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Text -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Text
t Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
" relative to directory " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    String -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
dir)
  display (InvalidOverrideCompiler WantedCompiler
x WantedCompiler
y) =
    Utf8Builder
"Specified compiler for a resolver (" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display WantedCompiler
x Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"), but also specified an override compiler (" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display WantedCompiler
y Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
")"
  display (InvalidFilePathSnapshot Text
t) =
    Utf8Builder
"Specified snapshot as file path with " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Text -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Text
t Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
", but not reading from a local file"
  display (InvalidSnapshot RawSnapshotLocation
loc SomeException
e) =
    Utf8Builder
"Exception while reading snapshot from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    RawSnapshotLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawSnapshotLocation
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
":\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    SomeException -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow SomeException
e
  display (MismatchedPackageMetadata RawPackageLocationImmutable
loc RawPackageMetadata
pm Maybe TreeKey
mtreeKey PackageIdentifier
foundIdent) =
    Utf8Builder
"Mismatched package metadata for " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nFound: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageIdentifier -> String
packageIdentifierString PackageIdentifier
foundIdent) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    (case Maybe TreeKey
mtreeKey of
       Maybe TreeKey
Nothing -> Utf8Builder
forall a. Monoid a => a
mempty
       Just TreeKey
treeKey -> Utf8Builder
" with tree " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> TreeKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display TreeKey
treeKey) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nExpected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageMetadata -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageMetadata
pm
  display (Non200ResponseStatus Status
status) =
    Utf8Builder
"Unexpected non-200 HTTP status code: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Int -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow (Status -> Int
statusCode Status
status)
  display (InvalidBlobKey Mismatch{BlobKey
mismatchActual :: BlobKey
mismatchExpected :: BlobKey
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
    Utf8Builder
"Invalid blob key found, expected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display BlobKey
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
", actual: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display BlobKey
mismatchActual
  display (Couldn'tParseSnapshot RawSnapshotLocation
sl String
e) =
    Utf8Builder
"Couldn't parse snapshot from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawSnapshotLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawSnapshotLocation
sl Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
e
  display (WrongCabalFileName RawPackageLocationImmutable
pl SafeFilePath
sfp PackageName
name) =
    Utf8Builder
"Wrong cabal file name for package " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
pl Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nCabal file is named " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SafeFilePath -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SafeFilePath
sfp Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
", but package name is " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nFor more information, see:\n  - https://github.com/commercialhaskell/stack/issues/317\n  -https://github.com/commercialhaskell/stack/issues/895"
  display (DownloadInvalidSHA256 Text
url Mismatch {SHA256
mismatchActual :: SHA256
mismatchExpected :: SHA256
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
    Utf8Builder
"Mismatched SHA256 hash from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nExpected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SHA256 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SHA256
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nActual:   " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SHA256 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SHA256
mismatchActual
  display (DownloadInvalidSize Text
url Mismatch {FileSize
mismatchActual :: FileSize
mismatchExpected :: FileSize
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
    Utf8Builder
"Mismatched download size from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nExpected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nActual:   " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
mismatchActual
  display (DownloadTooLarge Text
url Mismatch {FileSize
mismatchActual :: FileSize
mismatchExpected :: FileSize
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
    Utf8Builder
"Download from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" was too large.\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"Expected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", stopped after receiving: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
mismatchActual
  display (LocalInvalidSHA256 Path Abs File
path Mismatch {SHA256
mismatchActual :: SHA256
mismatchExpected :: SHA256
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
    Utf8Builder
"Mismatched SHA256 hash from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
path) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nExpected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SHA256 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SHA256
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nActual:   " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SHA256 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SHA256
mismatchActual
  display (LocalInvalidSize Path Abs File
path Mismatch {FileSize
mismatchActual :: FileSize
mismatchExpected :: FileSize
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
    Utf8Builder
"Mismatched file size from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
path) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nExpected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nActual:   " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileSize -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display FileSize
mismatchActual
  display (UnknownArchiveType ArchiveLocation
loc) = Utf8Builder
"Unable to determine archive type of: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ArchiveLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display ArchiveLocation
loc
  display (InvalidTarFileType ArchiveLocation
loc String
fp FileType
x) =
    Utf8Builder
"Unsupported tar filetype in archive " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ArchiveLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display ArchiveLocation
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" at file " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
fp Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileType -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FileType
x
  display (UnsupportedTarball ArchiveLocation
loc Text
e) =
    Utf8Builder
"Unsupported tarball from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ArchiveLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display ArchiveLocation
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
e
  display (NoHackageCryptographicHash PackageIdentifier
ident) =
    Utf8Builder
"Not cryptographic hash found for Hackage package " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageIdentifier -> String
packageIdentifierString PackageIdentifier
ident)
  display (FailedToCloneRepo SimpleRepo
repo) = 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
"The package " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
" needs blob " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display BlobKey
key Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
" for file path " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SafeFilePath -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SafeFilePath
sfp Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
", but the blob is not available"
  display (CompletePackageMetadataMismatch RawPackageLocationImmutable
loc PackageMetadata
pm) =
    Utf8Builder
"When completing package metadata for " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
", some values changed in the new package metadata: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    PackageMetadata -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display PackageMetadata
pm
  display (CRC32Mismatch ArchiveLocation
loc String
fp Mismatch {Word32
mismatchActual :: Word32
mismatchExpected :: Word32
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
    Utf8Builder
"CRC32 mismatch in ZIP file from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ArchiveLocation -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display ArchiveLocation
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
" on internal file " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
fp Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\n.Expected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Word32
mismatchExpected Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\n.Actual:   " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Word32
mismatchActual
  display (UnknownHackagePackage PackageIdentifierRevision
pir FuzzyResults
fuzzy) =
    Utf8Builder
"Could not find " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" on Hackage" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    FuzzyResults -> Utf8Builder
displayFuzzy FuzzyResults
fuzzy
  display (CannotCompleteRepoNonSHA1 Repo
repo) =
    Utf8Builder
"Cannot complete repo information for a non SHA1 commit due to non-reproducibility: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Repo -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Repo
repo
  display (MutablePackageLocationFromUrl Text
t) =
    Utf8Builder
"Cannot refer to a mutable package location from a URL: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
t
  display (MismatchedCabalFileForHackage PackageIdentifierRevision
pir Mismatch{PackageIdentifier
mismatchActual :: PackageIdentifier
mismatchExpected :: PackageIdentifier
mismatchActual :: forall a. Mismatch a -> a
mismatchExpected :: forall a. Mismatch a -> a
..}) =
    Utf8Builder
"When processing cabal file for Hackage package " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
":\nMismatched package identifier." Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nExpected: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageIdentifier -> String
packageIdentifierString PackageIdentifier
mismatchExpected) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nActual:   " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageIdentifier -> String
packageIdentifierString PackageIdentifier
mismatchActual)
  display (PackageNameParseFail Text
t) =
    Utf8Builder
"Invalid package name: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
t
  display (PackageVersionParseFail Text
t) =
    Utf8Builder
"Invalid version: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
t
  display (InvalidCabalFilePath Path Abs File
fp) =
    Utf8Builder
"File path contains a name which is not a valid package name: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp)
  display (DuplicatePackageNames Utf8Builder
source [(PackageName, [RawPackageLocationImmutable])]
pairs') =
    Utf8Builder
"Duplicate package names (" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
source Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"):\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    ((PackageName, [RawPackageLocationImmutable]) -> Utf8Builder)
-> [(PackageName, [RawPackageLocationImmutable])] -> Utf8Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
      (\(PackageName
name, [RawPackageLocationImmutable]
locs) ->
        String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
":\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
        (RawPackageLocationImmutable -> Utf8Builder)
-> [RawPackageLocationImmutable] -> Utf8Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
          (\RawPackageLocationImmutable
loc -> Utf8Builder
"- " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\n")
          [RawPackageLocationImmutable]
locs
      )
      [(PackageName, [RawPackageLocationImmutable])]
pairs'
  display (MigrationFailure Text
desc Path Abs File
fp SomeException
ex) =
    Utf8Builder
"Encountered error while migrating " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
desc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" database:" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\n    " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SomeException -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow SomeException
ex Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nPlease report this on https://github.com/commercialhaskell/stack/issues" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
"\nAs a workaround you may delete " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
desc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" database in " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" triggering its recreation."
  display (ParseSnapNameException Text
t) = Utf8Builder
"Invalid snapshot name: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
t

data FuzzyResults
  = FRNameNotFound ![PackageName]
  | FRVersionNotFound !(NonEmpty PackageIdentifierRevision)
  | FRRevisionNotFound !(NonEmpty PackageIdentifierRevision)

displayFuzzy :: FuzzyResults -> Utf8Builder
displayFuzzy :: FuzzyResults -> Utf8Builder
displayFuzzy (FRNameNotFound [PackageName]
names) =
  case [PackageName] -> Maybe (NonEmpty PackageName)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [PackageName]
names of
    Maybe (NonEmpty PackageName)
Nothing -> Utf8Builder
""
    Just NonEmpty PackageName
names' ->
      Utf8Builder
"\nPerhaps you meant " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
      NonEmpty Utf8Builder -> Utf8Builder
orSeparated ((PackageName -> Utf8Builder)
-> NonEmpty PackageName -> NonEmpty Utf8Builder
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder)
-> (PackageName -> String) -> PackageName -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
packageNameString) NonEmpty PackageName
names') Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
      Utf8Builder
"?"
displayFuzzy (FRVersionNotFound NonEmpty PackageIdentifierRevision
pirs) =
  Utf8Builder
"\nPossible candidates: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
  NonEmpty Utf8Builder -> Utf8Builder
commaSeparated ((PackageIdentifierRevision -> Utf8Builder)
-> NonEmpty PackageIdentifierRevision -> NonEmpty Utf8Builder
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display NonEmpty PackageIdentifierRevision
pirs) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
  Utf8Builder
"."
displayFuzzy (FRRevisionNotFound NonEmpty PackageIdentifierRevision
pirs) =
  Utf8Builder
"\nThe specified revision was not found.\nPossible candidates: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
  NonEmpty Utf8Builder -> Utf8Builder
commaSeparated ((PackageIdentifierRevision -> Utf8Builder)
-> NonEmpty PackageIdentifierRevision -> NonEmpty Utf8Builder
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display NonEmpty PackageIdentifierRevision
pirs) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
  Utf8Builder
"."

orSeparated :: NonEmpty Utf8Builder -> Utf8Builder
orSeparated :: NonEmpty Utf8Builder -> Utf8Builder
orSeparated NonEmpty Utf8Builder
xs
  | NonEmpty Utf8Builder -> Int
forall a. NonEmpty a -> Int
NE.length NonEmpty Utf8Builder
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = NonEmpty Utf8Builder -> Utf8Builder
forall a. NonEmpty a -> a
NE.head NonEmpty Utf8Builder
xs
  | NonEmpty Utf8Builder -> Int
forall a. NonEmpty a -> Int
NE.length NonEmpty Utf8Builder
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = NonEmpty Utf8Builder -> Utf8Builder
forall a. NonEmpty a -> a
NE.head NonEmpty Utf8Builder
xs Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" or " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Utf8Builder -> Utf8Builder
forall a. NonEmpty a -> a
NE.last NonEmpty Utf8Builder
xs
  | Bool
otherwise = [Utf8Builder] -> Utf8Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Utf8Builder -> [Utf8Builder] -> [Utf8Builder]
forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " (NonEmpty Utf8Builder -> [Utf8Builder]
forall a. NonEmpty a -> [a]
NE.init NonEmpty Utf8Builder
xs)) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", or " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Utf8Builder -> Utf8Builder
forall a. NonEmpty a -> a
NE.last NonEmpty Utf8Builder
xs

commaSeparated :: NonEmpty Utf8Builder -> Utf8Builder
commaSeparated :: NonEmpty Utf8Builder -> Utf8Builder
commaSeparated = NonEmpty Utf8Builder -> Utf8Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (NonEmpty Utf8Builder -> Utf8Builder)
-> (NonEmpty Utf8Builder -> NonEmpty Utf8Builder)
-> NonEmpty Utf8Builder
-> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> NonEmpty Utf8Builder -> NonEmpty Utf8Builder
forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse Utf8Builder
", "

-- You'd really think there'd be a better way to do this in Cabal.
cabalSpecLatestVersion :: Version
cabalSpecLatestVersion :: Version
cabalSpecLatestVersion =
  case CabalSpecVersion
cabalSpecLatest of
    CabalSpecVersion
CabalSpecV1_0 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV1_2 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV1_4 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV1_6 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV1_8 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV1_10 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV1_12 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV1_18 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV1_20 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV1_22 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV1_24 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV2_0 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV2_2 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV2_4 -> String -> Version
forall a. HasCallStack => String -> a
error String
"this cannot happen"
    CabalSpecVersion
CabalSpecV3_0 -> [Int] -> Version
mkVersion [Int
3, Int
0]

data BuildFile = BFCabal !SafeFilePath !TreeEntry
               | BFHpack !TreeEntry -- We don't need SafeFilePath for Hpack since it has to be package.yaml file
  deriving (Int -> BuildFile -> ShowS
[BuildFile] -> ShowS
BuildFile -> String
(Int -> BuildFile -> ShowS)
-> (BuildFile -> String)
-> ([BuildFile] -> ShowS)
-> Show BuildFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildFile] -> ShowS
$cshowList :: [BuildFile] -> ShowS
show :: BuildFile -> String
$cshow :: BuildFile -> String
showsPrec :: Int -> BuildFile -> ShowS
$cshowsPrec :: Int -> BuildFile -> ShowS
Show, BuildFile -> BuildFile -> Bool
(BuildFile -> BuildFile -> Bool)
-> (BuildFile -> BuildFile -> Bool) -> Eq BuildFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildFile -> BuildFile -> Bool
$c/= :: BuildFile -> BuildFile -> Bool
== :: BuildFile -> BuildFile -> Bool
$c== :: BuildFile -> BuildFile -> Bool
Eq)

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

newtype SafeFilePath = SafeFilePath Text
  deriving (Int -> SafeFilePath -> ShowS
[SafeFilePath] -> ShowS
SafeFilePath -> String
(Int -> SafeFilePath -> ShowS)
-> (SafeFilePath -> String)
-> ([SafeFilePath] -> ShowS)
-> Show SafeFilePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SafeFilePath] -> ShowS
$cshowList :: [SafeFilePath] -> ShowS
show :: SafeFilePath -> String
$cshow :: SafeFilePath -> String
showsPrec :: Int -> SafeFilePath -> ShowS
$cshowsPrec :: Int -> SafeFilePath -> ShowS
Show, SafeFilePath -> SafeFilePath -> Bool
(SafeFilePath -> SafeFilePath -> Bool)
-> (SafeFilePath -> SafeFilePath -> Bool) -> Eq SafeFilePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SafeFilePath -> SafeFilePath -> Bool
$c/= :: SafeFilePath -> SafeFilePath -> Bool
== :: SafeFilePath -> SafeFilePath -> Bool
$c== :: SafeFilePath -> SafeFilePath -> Bool
Eq, Eq SafeFilePath
Eq SafeFilePath
-> (SafeFilePath -> SafeFilePath -> Ordering)
-> (SafeFilePath -> SafeFilePath -> Bool)
-> (SafeFilePath -> SafeFilePath -> Bool)
-> (SafeFilePath -> SafeFilePath -> Bool)
-> (SafeFilePath -> SafeFilePath -> Bool)
-> (SafeFilePath -> SafeFilePath -> SafeFilePath)
-> (SafeFilePath -> SafeFilePath -> SafeFilePath)
-> Ord SafeFilePath
SafeFilePath -> SafeFilePath -> Bool
SafeFilePath -> SafeFilePath -> Ordering
SafeFilePath -> SafeFilePath -> SafeFilePath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SafeFilePath -> SafeFilePath -> SafeFilePath
$cmin :: SafeFilePath -> SafeFilePath -> SafeFilePath
max :: SafeFilePath -> SafeFilePath -> SafeFilePath
$cmax :: SafeFilePath -> SafeFilePath -> SafeFilePath
>= :: SafeFilePath -> SafeFilePath -> Bool
$c>= :: SafeFilePath -> SafeFilePath -> Bool
> :: SafeFilePath -> SafeFilePath -> Bool
$c> :: SafeFilePath -> SafeFilePath -> Bool
<= :: SafeFilePath -> SafeFilePath -> Bool
$c<= :: SafeFilePath -> SafeFilePath -> Bool
< :: SafeFilePath -> SafeFilePath -> Bool
$c< :: SafeFilePath -> SafeFilePath -> Bool
compare :: SafeFilePath -> SafeFilePath -> Ordering
$ccompare :: SafeFilePath -> SafeFilePath -> Ordering
$cp1Ord :: Eq SafeFilePath
Ord, SafeFilePath -> Text
SafeFilePath -> Utf8Builder
(SafeFilePath -> Utf8Builder)
-> (SafeFilePath -> Text) -> Display SafeFilePath
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
textDisplay :: SafeFilePath -> Text
$ctextDisplay :: SafeFilePath -> Text
display :: SafeFilePath -> Utf8Builder
$cdisplay :: SafeFilePath -> Utf8Builder
Display)

instance PersistField SafeFilePath where
  toPersistValue :: SafeFilePath -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue)
-> (SafeFilePath -> Text) -> SafeFilePath -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeFilePath -> Text
unSafeFilePath
  fromPersistValue :: PersistValue -> Either Text SafeFilePath
fromPersistValue PersistValue
v = do
    Text
t <- PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v
    Either Text SafeFilePath
-> (SafeFilePath -> Either Text SafeFilePath)
-> Maybe SafeFilePath
-> Either Text SafeFilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text SafeFilePath
forall a b. a -> Either a b
Left (Text -> Either Text SafeFilePath)
-> Text -> Either Text SafeFilePath
forall a b. (a -> b) -> a -> b
$ Text
"Invalid SafeFilePath: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t) SafeFilePath -> Either Text SafeFilePath
forall a b. b -> Either a b
Right (Maybe SafeFilePath -> Either Text SafeFilePath)
-> Maybe SafeFilePath -> Either Text SafeFilePath
forall a b. (a -> b) -> a -> b
$ Text -> Maybe SafeFilePath
mkSafeFilePath Text
t
instance PersistFieldSql SafeFilePath where
  sqlType :: Proxy SafeFilePath -> SqlType
sqlType Proxy SafeFilePath
_ = SqlType
SqlString

unSafeFilePath :: SafeFilePath -> Text
unSafeFilePath :: SafeFilePath -> Text
unSafeFilePath (SafeFilePath Text
t) = Text
t

safeFilePathtoPath :: (MonadThrow m) => Path Abs Dir -> SafeFilePath -> m (Path Abs File)
safeFilePathtoPath :: Path Abs Dir -> SafeFilePath -> m (Path Abs File)
safeFilePathtoPath Path Abs Dir
dir (SafeFilePath Text
path) = do
  Path Rel File
fpath <- String -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (Text -> String
T.unpack Text
path)
  Path Abs File -> m (Path Abs File)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs File -> m (Path Abs File))
-> Path Abs File -> m (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
dir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
fpath

mkSafeFilePath :: Text -> Maybe SafeFilePath
mkSafeFilePath :: Text -> Maybe SafeFilePath
mkSafeFilePath Text
t = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"\\" Text -> Text -> Bool
`T.isInfixOf` Text
t
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"//" Text -> Text -> Bool
`T.isInfixOf` Text
t
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"\n" Text -> Text -> Bool
`T.isInfixOf` Text
t
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"\0" Text -> Text -> Bool
`T.isInfixOf` Text
t

  (Char
c, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
t
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/'

  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')) ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
t

  SafeFilePath -> Maybe SafeFilePath
forall a. a -> Maybe a
Just (SafeFilePath -> Maybe SafeFilePath)
-> SafeFilePath -> Maybe SafeFilePath
forall a b. (a -> b) -> a -> b
$ Text -> SafeFilePath
SafeFilePath Text
t

-- | SafeFilePath for `package.yaml` file.
hpackSafeFilePath :: SafeFilePath
hpackSafeFilePath :: SafeFilePath
hpackSafeFilePath =
    let fpath :: Maybe SafeFilePath
fpath = Text -> Maybe SafeFilePath
mkSafeFilePath (String -> Text
T.pack String
Hpack.packageConfig)
    in case Maybe SafeFilePath
fpath of
         Maybe SafeFilePath
Nothing -> String -> SafeFilePath
forall a. HasCallStack => String -> a
error (String -> SafeFilePath) -> String -> SafeFilePath
forall a b. (a -> b) -> a -> b
$ String
"hpackSafeFilePath: Not able to encode " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (String
Hpack.packageConfig)
         Just SafeFilePath
sfp -> SafeFilePath
sfp

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

-- | 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 -> String
(Int -> Tree -> ShowS)
-> (Tree -> String) -> ([Tree] -> ShowS) -> Show Tree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree] -> ShowS
$cshowList :: [Tree] -> ShowS
show :: Tree -> String
$cshow :: Tree -> String
showsPrec :: Int -> Tree -> ShowS
$cshowsPrec :: Int -> Tree -> ShowS
Show, Tree -> Tree -> Bool
(Tree -> Tree -> Bool) -> (Tree -> Tree -> Bool) -> Eq Tree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree -> Tree -> Bool
$c/= :: Tree -> Tree -> Bool
== :: Tree -> Tree -> Bool
$c== :: Tree -> Tree -> Bool
Eq, 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
min :: Tree -> Tree -> Tree
$cmin :: Tree -> Tree -> Tree
max :: Tree -> Tree -> Tree
$cmax :: Tree -> Tree -> Tree
>= :: Tree -> Tree -> Bool
$c>= :: Tree -> Tree -> Bool
> :: Tree -> Tree -> Bool
$c> :: Tree -> Tree -> Bool
<= :: Tree -> Tree -> Bool
$c<= :: Tree -> Tree -> Bool
< :: Tree -> Tree -> Bool
$c< :: Tree -> Tree -> Bool
compare :: Tree -> Tree -> Ordering
$ccompare :: Tree -> Tree -> Ordering
$cp1Ord :: Eq 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 :: (BlobKey, ByteString) -> m (TreeKey, Tree)
parseTreeM (BlobKey
blobKey, ByteString
blob) =
  case ByteString -> Maybe Tree
parseTree ByteString
blob of
    Maybe Tree
Nothing -> PantryException -> m (TreeKey, Tree)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (BlobKey -> ByteString -> PantryException
InvalidTreeFromCasa BlobKey
blobKey ByteString
blob)
    Just Tree
tree -> (TreeKey, Tree) -> m (TreeKey, Tree)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BlobKey -> TreeKey
TreeKey BlobKey
blobKey, Tree
tree)

parseTree :: ByteString -> Maybe Tree
parseTree :: ByteString -> Maybe Tree
parseTree ByteString
bs1 = do
  Tree
tree <- ByteString -> Maybe Tree
parseTree' ByteString
bs1
  let bs2 :: ByteString
bs2 = Tree -> ByteString
renderTree Tree
tree
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString
bs1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bs2
  Tree -> Maybe Tree
forall a. a -> Maybe a
Just Tree
tree

parseTree' :: ByteString -> Maybe Tree
parseTree' :: ByteString -> Maybe Tree
parseTree' ByteString
bs0 = do
  ByteString
entriesBS <- ByteString -> ByteString -> Maybe ByteString
B.stripPrefix ByteString
"map:" ByteString
bs0
  Map SafeFilePath TreeEntry -> Tree
TreeMap (Map SafeFilePath TreeEntry -> Tree)
-> Maybe (Map SafeFilePath TreeEntry) -> Maybe Tree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map SafeFilePath TreeEntry
-> ByteString -> Maybe (Map SafeFilePath TreeEntry)
loop Map SafeFilePath TreeEntry
forall k a. Map k a
Map.empty ByteString
entriesBS
  where
    loop :: Map SafeFilePath TreeEntry
-> ByteString -> Maybe (Map SafeFilePath TreeEntry)
loop !Map SafeFilePath TreeEntry
m ByteString
bs1
      | ByteString -> Bool
B.null ByteString
bs1 = Map SafeFilePath TreeEntry -> Maybe (Map SafeFilePath TreeEntry)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map SafeFilePath TreeEntry
m
      | Bool
otherwise = do
          (ByteString
sfpBS, ByteString
bs2) <- ByteString -> Maybe (ByteString, ByteString)
takeNetstring ByteString
bs1
          SafeFilePath
sfp <-
            case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
sfpBS of
              Left UnicodeException
_ -> Maybe SafeFilePath
forall a. Maybe a
Nothing
              Right Text
sfpT -> Text -> Maybe SafeFilePath
mkSafeFilePath Text
sfpT
          (SHA256
sha, ByteString
bs3) <- ByteString -> Maybe (SHA256, ByteString)
takeSha ByteString
bs2
          (Int
size', ByteString
bs4) <- ByteString -> Maybe (Int, ByteString)
takeNetword ByteString
bs3
          (Word8
typeW, ByteString
bs5) <- ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs4
          FileType
ft <-
            case Word8
typeW of
              Word8
78 -> FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
FTNormal -- '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 (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 :: String -> Maybe PackageIdentifier
parsePackageIdentifier = (String -> Maybe PackageIdentifier)
-> (PackageIdentifier -> Maybe PackageIdentifier)
-> Either String PackageIdentifier
-> Maybe PackageIdentifier
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe PackageIdentifier -> String -> Maybe PackageIdentifier
forall a b. a -> b -> a
const Maybe PackageIdentifier
forall a. Maybe a
Nothing) PackageIdentifier -> Maybe PackageIdentifier
forall a. a -> Maybe a
Just (Either String PackageIdentifier -> Maybe PackageIdentifier)
-> (String -> Either String PackageIdentifier)
-> String
-> Maybe PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecParser PackageIdentifier
-> String -> Either String PackageIdentifier
forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec (ParsecParser PackageIdentifier
packageIdentifierParsec ParsecParser PackageIdentifier
-> ParsecParser () -> ParsecParser PackageIdentifier
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecParser ()
forall (m :: * -> *). Parsing m => m ()
Parse.eof)

packageIdentifierParsec :: ParsecParser PackageIdentifier
packageIdentifierParsec :: ParsecParser PackageIdentifier
packageIdentifierParsec = do
  ident :: PackageIdentifier
ident@(PackageIdentifier PackageName
_ Version
v) <- ParsecParser PackageIdentifier
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec

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

-- | Parse a version from a 'String'.
--
-- @since 0.1.0.0
parseVersion :: String -> Maybe Version
parseVersion :: String -> Maybe Version
parseVersion = String -> Maybe Version
forall a. Parsec a => String -> 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 :: String -> m Version
parseVersionThrowing String
str =
  case String -> Maybe Version
parseVersion String
str of
    Maybe Version
Nothing -> PantryException -> m Version
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PantryException -> m Version) -> PantryException -> m Version
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
PackageVersionParseFail (Text -> PantryException) -> Text -> PantryException
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
str
    Just Version
v -> Version -> m Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v

-- | Parse a version range from a 'String'.
--
-- @since 0.1.0.0
parseVersionRange :: String -> Maybe VersionRange
parseVersionRange :: String -> Maybe VersionRange
parseVersionRange = String -> Maybe VersionRange
forall a. Parsec a => String -> Maybe a
Distribution.Text.simpleParse

-- | Parse a module name from a 'String'.
--
-- @since 0.1.0.0
parseModuleName :: String -> Maybe ModuleName
parseModuleName :: String -> Maybe ModuleName
parseModuleName = String -> Maybe ModuleName
forall a. Parsec a => String -> Maybe a
Distribution.Text.simpleParse

-- | Parse a flag name from a 'String'.
--
-- @since 0.1.0.0
parseFlagName :: String -> Maybe FlagName
parseFlagName :: String -> Maybe FlagName
parseFlagName = String -> Maybe FlagName
forall a. Parsec a => String -> Maybe a
Distribution.Text.simpleParse

-- | Render a package name as a 'String'.
--
-- @since 0.1.0.0
packageNameString :: PackageName -> String
packageNameString :: PackageName -> String
packageNameString = PackageName -> String
unPackageName

-- | Render a package identifier as a 'String'.
--
-- @since 0.1.0.0
packageIdentifierString :: PackageIdentifier -> String
packageIdentifierString :: PackageIdentifier -> String
packageIdentifierString = PackageIdentifier -> String
forall a. Pretty a => a -> String
Distribution.Text.display

-- | Render a version as a 'String'.
--
-- @since 0.1.0.0
versionString :: Version -> String
versionString :: Version -> String
versionString = Version -> String
forall a. Pretty a => a -> String
Distribution.Text.display

-- | Render a flag name as a 'String'.
--
-- @since 0.1.0.0
flagNameString :: FlagName -> String
flagNameString :: FlagName -> String
flagNameString = FlagName -> String
unFlagName

-- | Render a module name as a 'String'.
--
-- @since 0.1.0.0
moduleNameString :: ModuleName -> String
moduleNameString :: ModuleName -> String
moduleNameString = ModuleName -> String
forall a. Pretty a => a -> String
Distribution.Text.display

data OptionalSubdirs
  = OSSubdirs !(NonEmpty Text)
  | OSPackageMetadata !Text !RawPackageMetadata
  -- ^ subdirectory and package metadata
  deriving (Int -> OptionalSubdirs -> ShowS
[OptionalSubdirs] -> ShowS
OptionalSubdirs -> String
(Int -> OptionalSubdirs -> ShowS)
-> (OptionalSubdirs -> String)
-> ([OptionalSubdirs] -> ShowS)
-> Show OptionalSubdirs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionalSubdirs] -> ShowS
$cshowList :: [OptionalSubdirs] -> ShowS
show :: OptionalSubdirs -> String
$cshow :: OptionalSubdirs -> String
showsPrec :: Int -> OptionalSubdirs -> ShowS
$cshowsPrec :: Int -> OptionalSubdirs -> ShowS
Show, OptionalSubdirs -> OptionalSubdirs -> Bool
(OptionalSubdirs -> OptionalSubdirs -> Bool)
-> (OptionalSubdirs -> OptionalSubdirs -> Bool)
-> Eq OptionalSubdirs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionalSubdirs -> OptionalSubdirs -> Bool
$c/= :: OptionalSubdirs -> OptionalSubdirs -> Bool
== :: OptionalSubdirs -> OptionalSubdirs -> Bool
$c== :: OptionalSubdirs -> OptionalSubdirs -> Bool
Eq, (forall x. OptionalSubdirs -> Rep OptionalSubdirs x)
-> (forall x. Rep OptionalSubdirs x -> OptionalSubdirs)
-> Generic OptionalSubdirs
forall x. Rep OptionalSubdirs x -> OptionalSubdirs
forall x. OptionalSubdirs -> Rep OptionalSubdirs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OptionalSubdirs x -> OptionalSubdirs
$cfrom :: forall x. OptionalSubdirs -> Rep OptionalSubdirs x
Generic)
instance NFData OptionalSubdirs

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

instance Display RawPackageMetadata where
  display :: RawPackageMetadata -> Utf8Builder
display RawPackageMetadata
rpm = [Utf8Builder] -> Utf8Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Utf8Builder] -> Utf8Builder) -> [Utf8Builder] -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> [Utf8Builder] -> [Utf8Builder]
forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " ([Utf8Builder] -> [Utf8Builder]) -> [Utf8Builder] -> [Utf8Builder]
forall a b. (a -> b) -> a -> b
$ [Maybe Utf8Builder] -> [Utf8Builder]
forall a. [Maybe a] -> [a]
catMaybes
    [ (\PackageName
name -> Utf8Builder
"name == " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name)) (PackageName -> Utf8Builder)
-> Maybe PackageName -> Maybe Utf8Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPackageMetadata -> Maybe PackageName
rpmName RawPackageMetadata
rpm
    , (\Version
version -> Utf8Builder
"version == " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
version)) (Version -> Utf8Builder) -> Maybe Version -> Maybe Utf8Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPackageMetadata -> Maybe Version
rpmVersion RawPackageMetadata
rpm
    , (\TreeKey
tree -> Utf8Builder
"tree == " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> TreeKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display TreeKey
tree) (TreeKey -> Utf8Builder) -> Maybe TreeKey -> Maybe Utf8Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPackageMetadata -> Maybe TreeKey
rpmTreeKey RawPackageMetadata
rpm
    ]

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

instance Display PackageMetadata where
  display :: PackageMetadata -> Utf8Builder
display PackageMetadata
pm = [Utf8Builder] -> Utf8Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Utf8Builder] -> Utf8Builder) -> [Utf8Builder] -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> [Utf8Builder] -> [Utf8Builder]
forall a. a -> [a] -> [a]
intersperse Utf8Builder
", " ([Utf8Builder] -> [Utf8Builder]) -> [Utf8Builder] -> [Utf8Builder]
forall a b. (a -> b) -> a -> b
$
    [ Utf8Builder
"ident == " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (PackageIdentifier -> String
packageIdentifierString (PackageIdentifier -> String) -> PackageIdentifier -> String
forall a b. (a -> b) -> a -> b
$ PackageMetadata -> PackageIdentifier
pmIdent PackageMetadata
pm)
    , Utf8Builder
"tree == " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> TreeKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (PackageMetadata -> TreeKey
pmTreeKey PackageMetadata
pm)
    ]

parsePackageMetadata :: Object -> WarningParser PackageMetadata
parsePackageMetadata :: Object -> WarningParser PackageMetadata
parsePackageMetadata Object
o = do
  Maybe BlobKey
_oldCabalFile :: Maybe BlobKey <- Object
o Object -> Text -> WarningParser (Maybe BlobKey)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"cabal-file"
  BlobKey
pantryTree :: BlobKey <- Object
o Object -> Text -> WarningParser BlobKey
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"pantry-tree"
  CabalString PackageName
pkgName <- Object
o Object -> Text -> WarningParser (CabalString PackageName)
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"name"
  CabalString Version
pkgVersion <- Object
o Object -> Text -> WarningParser (CabalString Version)
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"version"
  let pmTreeKey :: TreeKey
pmTreeKey = BlobKey -> TreeKey
TreeKey BlobKey
pantryTree
      pmIdent :: PackageIdentifier
pmIdent = PackageIdentifier :: PackageName -> Version -> PackageIdentifier
PackageIdentifier {PackageName
Version
pkgVersion :: Version
pkgVersion :: Version
pkgName :: PackageName
pkgName :: PackageName
..}
  PackageMetadata -> WarningParser PackageMetadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageMetadata :: PackageIdentifier -> TreeKey -> PackageMetadata
PackageMetadata {PackageIdentifier
TreeKey
pmIdent :: PackageIdentifier
pmTreeKey :: TreeKey
pmTreeKey :: TreeKey
pmIdent :: PackageIdentifier
..}


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

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

instance Display ArchiveLocation where
  display :: ArchiveLocation -> Utf8Builder
display (ALUrl Text
url) = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url
  display (ALFilePath ResolvedPath File
resolved) = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder) -> String -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ Path Abs File -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> String) -> Path Abs File -> String
forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> Path Abs File
forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute ResolvedPath File
resolved

parseArchiveLocationObject :: Object -> WarningParser (Unresolved ArchiveLocation)
parseArchiveLocationObject :: Object -> WarningParser (Unresolved ArchiveLocation)
parseArchiveLocationObject Object
o =
    ((Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"url") WarningParser Text
-> (Text -> WarningParser (Unresolved ArchiveLocation))
-> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> WarningParser (Unresolved ArchiveLocation))
-> (Unresolved ArchiveLocation
    -> WarningParser (Unresolved ArchiveLocation))
-> Either Text (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> String)
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Unresolved ArchiveLocation)
 -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> Either Text (Unresolved ArchiveLocation))
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Unresolved ArchiveLocation)
validateUrl) WarningParser (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    ((Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"filepath") WarningParser Text
-> (Text -> WarningParser (Unresolved ArchiveLocation))
-> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> WarningParser (Unresolved ArchiveLocation))
-> (Unresolved ArchiveLocation
    -> WarningParser (Unresolved ArchiveLocation))
-> Either Text (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> String)
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Unresolved ArchiveLocation)
 -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> Either Text (Unresolved ArchiveLocation))
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Unresolved ArchiveLocation)
validateFilePath) WarningParser (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    ((Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"archive") WarningParser Text
-> (Text -> WarningParser (Unresolved ArchiveLocation))
-> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> WarningParser (Unresolved ArchiveLocation))
-> (Unresolved ArchiveLocation
    -> WarningParser (Unresolved ArchiveLocation))
-> Either Text (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> String)
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Unresolved ArchiveLocation)
 -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> Either Text (Unresolved ArchiveLocation))
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Unresolved ArchiveLocation)
parseArchiveLocationText) WarningParser (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    ((Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"location") WarningParser Text
-> (Text -> WarningParser (Unresolved ArchiveLocation))
-> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> WarningParser (Unresolved ArchiveLocation))
-> (Unresolved ArchiveLocation
    -> WarningParser (Unresolved ArchiveLocation))
-> Either Text (Unresolved ArchiveLocation)
-> WarningParser (Unresolved ArchiveLocation)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> WarningParser (Unresolved ArchiveLocation)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> String)
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Unresolved ArchiveLocation
-> WarningParser (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Unresolved ArchiveLocation)
 -> WarningParser (Unresolved ArchiveLocation))
-> (Text -> Either Text (Unresolved ArchiveLocation))
-> Text
-> WarningParser (Unresolved ArchiveLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Unresolved ArchiveLocation)
parseArchiveLocationText)

parseArchiveLocationText :: Text -> Either Text (Unresolved ArchiveLocation)
parseArchiveLocationText :: Text -> Either Text (Unresolved ArchiveLocation)
parseArchiveLocationText Text
t =
  case Text -> Either Text (Unresolved ArchiveLocation)
validateUrl Text
t of
    Left Text
e1 ->
      case Text -> Either Text (Unresolved ArchiveLocation)
validateFilePath Text
t of
        Left Text
e2 -> Text -> Either Text (Unresolved ArchiveLocation)
forall a b. a -> Either a b
Left (Text -> Either Text (Unresolved ArchiveLocation))
-> Text -> Either Text (Unresolved ArchiveLocation)
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"Invalid archive location, neither a URL nor a file path"
          , Text
"  URL error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e1
          , Text
"  File path error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e2
          ]
        Right Unresolved ArchiveLocation
x -> Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
forall a b. b -> Either a b
Right Unresolved ArchiveLocation
x
    Right Unresolved ArchiveLocation
x -> Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
forall a b. b -> Either a b
Right Unresolved ArchiveLocation
x

validateUrl :: Text -> Either Text (Unresolved ArchiveLocation)
validateUrl :: Text -> Either Text (Unresolved ArchiveLocation)
validateUrl Text
t =
  case String -> Either SomeException Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> Either SomeException Request)
-> String -> Either SomeException Request
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t of
    Left SomeException
_ -> Text -> Either Text (Unresolved ArchiveLocation)
forall a b. a -> Either a b
Left (Text -> Either Text (Unresolved ArchiveLocation))
-> Text -> Either Text (Unresolved ArchiveLocation)
forall a b. (a -> b) -> a -> b
$ Text
"Could not parse URL: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
    Right Request
_ -> Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved ArchiveLocation
 -> Either Text (Unresolved ArchiveLocation))
-> Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
forall a b. (a -> b) -> a -> b
$ ArchiveLocation -> Unresolved ArchiveLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArchiveLocation -> Unresolved ArchiveLocation)
-> ArchiveLocation -> Unresolved ArchiveLocation
forall a b. (a -> b) -> a -> b
$ Text -> ArchiveLocation
ALUrl Text
t

validateFilePath :: Text -> Either Text (Unresolved ArchiveLocation)
validateFilePath :: Text -> Either Text (Unresolved ArchiveLocation)
validateFilePath Text
t =
  if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
ext -> Text
ext Text -> Text -> Bool
`T.isSuffixOf` Text
t) (Text -> [Text]
T.words Text
".zip .tar .tar.gz")
    then Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved ArchiveLocation
 -> Either Text (Unresolved ArchiveLocation))
-> Unresolved ArchiveLocation
-> Either Text (Unresolved ArchiveLocation)
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO ArchiveLocation)
-> Unresolved ArchiveLocation
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO ArchiveLocation)
 -> Unresolved ArchiveLocation)
-> (Maybe (Path Abs Dir) -> IO ArchiveLocation)
-> Unresolved ArchiveLocation
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir ->
           case Maybe (Path Abs Dir)
mdir of
             Maybe (Path Abs Dir)
Nothing -> PantryException -> IO ArchiveLocation
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PantryException -> IO ArchiveLocation)
-> PantryException -> IO ArchiveLocation
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
InvalidFilePathSnapshot Text
t
             Just Path Abs Dir
dir -> do
               Path Abs File
abs' <- Path Abs Dir -> String -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs File)
resolveFile Path Abs Dir
dir (String -> IO (Path Abs File)) -> String -> IO (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
               ArchiveLocation -> IO ArchiveLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArchiveLocation -> IO ArchiveLocation)
-> ArchiveLocation -> IO ArchiveLocation
forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> ArchiveLocation
ALFilePath (ResolvedPath File -> ArchiveLocation)
-> ResolvedPath File -> ArchiveLocation
forall a b. (a -> b) -> a -> b
$ RelFilePath -> Path Abs File -> ResolvedPath File
forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath Text
t) Path Abs File
abs'
    else Text -> Either Text (Unresolved ArchiveLocation)
forall a b. a -> Either a b
Left (Text -> Either Text (Unresolved ArchiveLocation))
-> Text -> Either Text (Unresolved ArchiveLocation)
forall a b. (a -> b) -> a -> b
$ Text
"Does not have an archive file extension: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t

instance ToJSON RawPackageLocation where
  toJSON :: RawPackageLocation -> Value
toJSON (RPLImmutable RawPackageLocationImmutable
rpli) = RawPackageLocationImmutable -> Value
forall a. ToJSON a => a -> Value
toJSON RawPackageLocationImmutable
rpli
  toJSON (RPLMutable ResolvedPath Dir
resolved) = RelFilePath -> Value
forall a. ToJSON a => a -> Value
toJSON (ResolvedPath Dir -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath Dir
resolved)
instance FromJSON (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))) where
  parseJSON :: Value
-> Parser
     (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
parseJSON Value
v =
    (((WithJSONWarnings
   (Unresolved (NonEmpty RawPackageLocationImmutable))
 -> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((WithJSONWarnings
    (Unresolved (NonEmpty RawPackageLocationImmutable))
  -> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
 -> Parser
      (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))))
-> ((RawPackageLocationImmutable -> RawPackageLocation)
    -> WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))
    -> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> (RawPackageLocationImmutable -> RawPackageLocation)
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Unresolved (NonEmpty RawPackageLocationImmutable)
 -> Unresolved (NonEmpty RawPackageLocation))
-> WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable))
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Unresolved (NonEmpty RawPackageLocationImmutable)
  -> Unresolved (NonEmpty RawPackageLocation))
 -> WithJSONWarnings
      (Unresolved (NonEmpty RawPackageLocationImmutable))
 -> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> ((RawPackageLocationImmutable -> RawPackageLocation)
    -> Unresolved (NonEmpty RawPackageLocationImmutable)
    -> Unresolved (NonEmpty RawPackageLocation))
-> (RawPackageLocationImmutable -> RawPackageLocation)
-> WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable))
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(NonEmpty RawPackageLocationImmutable
 -> NonEmpty RawPackageLocation)
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> Unresolved (NonEmpty RawPackageLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((NonEmpty RawPackageLocationImmutable
  -> NonEmpty RawPackageLocation)
 -> Unresolved (NonEmpty RawPackageLocationImmutable)
 -> Unresolved (NonEmpty RawPackageLocation))
-> ((RawPackageLocationImmutable -> RawPackageLocation)
    -> NonEmpty RawPackageLocationImmutable
    -> NonEmpty RawPackageLocation)
-> (RawPackageLocationImmutable -> RawPackageLocation)
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> Unresolved (NonEmpty RawPackageLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(RawPackageLocationImmutable -> RawPackageLocation)
-> NonEmpty RawPackageLocationImmutable
-> NonEmpty RawPackageLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) RawPackageLocationImmutable -> RawPackageLocation
RPLImmutable (Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)) Parser
  (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> Parser
     (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> Parser
     (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    ((Unresolved (NonEmpty RawPackageLocation)
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))
forall a. a -> WithJSONWarnings a
noJSONWarnings (Unresolved (NonEmpty RawPackageLocation)
 -> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> (Text -> Unresolved (NonEmpty RawPackageLocation))
-> Text
-> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Unresolved (NonEmpty RawPackageLocation)
mkMutable) (Text
 -> WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
-> Parser Text
-> Parser
     (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocation)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
    where
      mkMutable :: Text -> Unresolved (NonEmpty RawPackageLocation)
      mkMutable :: Text -> Unresolved (NonEmpty RawPackageLocation)
mkMutable Text
t = (Maybe (Path Abs Dir) -> IO (NonEmpty RawPackageLocation))
-> Unresolved (NonEmpty RawPackageLocation)
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO (NonEmpty RawPackageLocation))
 -> Unresolved (NonEmpty RawPackageLocation))
-> (Maybe (Path Abs Dir) -> IO (NonEmpty RawPackageLocation))
-> Unresolved (NonEmpty RawPackageLocation)
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir -> do
        case Maybe (Path Abs Dir)
mdir of
          Maybe (Path Abs Dir)
Nothing -> PantryException -> IO (NonEmpty RawPackageLocation)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PantryException -> IO (NonEmpty RawPackageLocation))
-> PantryException -> IO (NonEmpty RawPackageLocation)
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
MutablePackageLocationFromUrl Text
t
          Just Path Abs Dir
dir -> do
            Path Abs Dir
abs' <- Path Abs Dir -> String -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs Dir)
resolveDir Path Abs Dir
dir (String -> IO (Path Abs Dir)) -> String -> IO (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
            NonEmpty RawPackageLocation -> IO (NonEmpty RawPackageLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty RawPackageLocation -> IO (NonEmpty RawPackageLocation))
-> NonEmpty RawPackageLocation -> IO (NonEmpty RawPackageLocation)
forall a b. (a -> b) -> a -> b
$ RawPackageLocation -> NonEmpty RawPackageLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawPackageLocation -> NonEmpty RawPackageLocation)
-> RawPackageLocation -> NonEmpty RawPackageLocation
forall a b. (a -> b) -> a -> b
$ ResolvedPath Dir -> RawPackageLocation
RPLMutable (ResolvedPath Dir -> RawPackageLocation)
-> ResolvedPath Dir -> RawPackageLocation
forall a b. (a -> b) -> a -> b
$ RelFilePath -> Path Abs Dir -> ResolvedPath Dir
forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath Text
t) Path Abs Dir
abs'

instance ToJSON RawPackageLocationImmutable where
  toJSON :: RawPackageLocationImmutable -> Value
toJSON (RPLIHackage PackageIdentifierRevision
pir Maybe TreeKey
mtree) = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Text
"hackage" Text -> PackageIdentifierRevision -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PackageIdentifierRevision
pir]
    , [(Text, Value)]
-> (TreeKey -> [(Text, Value)]) -> Maybe TreeKey -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\TreeKey
tree -> [Text
"pantry-tree" Text -> TreeKey -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TreeKey
tree]) Maybe TreeKey
mtree
    ]
  toJSON (RPLIArchive (RawArchive ArchiveLocation
loc Maybe SHA256
msha Maybe FileSize
msize Text
subdir) RawPackageMetadata
rpm) = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ case ArchiveLocation
loc of
        ALUrl Text
url -> [Text
"url" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
url]
        ALFilePath ResolvedPath File
resolved -> [Text
"filepath" Text -> RelFilePath -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved]
    , [(Text, Value)]
-> (SHA256 -> [(Text, Value)]) -> Maybe SHA256 -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\SHA256
sha -> [Text
"sha256" Text -> SHA256 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SHA256
sha]) Maybe SHA256
msha
    , [(Text, Value)]
-> (FileSize -> [(Text, Value)])
-> Maybe FileSize
-> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FileSize
size' -> [Text
"size" Text -> FileSize -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FileSize
size']) Maybe FileSize
msize
    , if Text -> Bool
T.null Text
subdir then [] else [Text
"subdir" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
subdir]
    , RawPackageMetadata -> [(Text, Value)]
rpmToPairs RawPackageMetadata
rpm
    ]
  toJSON (RPLIRepo (Repo Text
url Text
commit RepoType
typ Text
subdir) RawPackageMetadata
rpm) = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [ Text
urlKey Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
url
      , Text
"commit" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
commit
      ]
    , if Text -> Bool
T.null Text
subdir then [] else [Text
"subdir" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
subdir]
    , RawPackageMetadata -> [(Text, Value)]
rpmToPairs RawPackageMetadata
rpm
    ]
    where
      urlKey :: Text
urlKey =
        case RepoType
typ of
          RepoType
RepoGit -> Text
"git"
          RepoType
RepoHg  -> Text
"hg"

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

instance FromJSON (WithJSONWarnings (Unresolved PackageLocationImmutable)) where
    parseJSON :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
parseJSON Value
v = Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
repoObject Value
v Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
archiveObject Value
v Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
hackageObject Value
v Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall (f :: * -> *).
Applicative f =>
Value -> Parser (WithJSONWarnings (f PackageLocationImmutable))
github Value
v
                  Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Could not parse a UnresolvedPackageLocationImmutable from: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
v)
        where
          repoObject :: Value -> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
          repoObject :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
repoObject = String
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackageLocationImmutable.PLIRepo" ((Object -> WarningParser (Unresolved PackageLocationImmutable))
 -> Value
 -> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable)))
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
            PackageMetadata
pm <- Object -> WarningParser PackageMetadata
parsePackageMetadata Object
o
            Text
repoSubdir <- Object
o Object -> Text -> WarningParser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"subdir" WarningParser (Maybe Text) -> Text -> WarningParser Text
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Text
""
            Text
repoCommit <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"commit"
            (RepoType
repoType, Text
repoUrl) <-
                (Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"git" WarningParser Text
-> (Text -> WriterT WarningParserMonoid Parser (RepoType, Text))
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
url -> (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RepoType
RepoGit, Text
url)) WriterT WarningParserMonoid Parser (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                (Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hg" WarningParser Text
-> (Text -> WriterT WarningParserMonoid Parser (RepoType, Text))
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
url -> (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RepoType
RepoHg, Text
url))
            Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved PackageLocationImmutable
 -> WarningParser (Unresolved PackageLocationImmutable))
-> Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ PackageLocationImmutable -> Unresolved PackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageLocationImmutable -> Unresolved PackageLocationImmutable)
-> PackageLocationImmutable -> Unresolved PackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ Repo -> PackageMetadata -> PackageLocationImmutable
PLIRepo Repo :: Text -> Text -> RepoType -> Text -> Repo
Repo {Text
RepoType
repoUrl :: Text
repoType :: RepoType
repoCommit :: Text
repoSubdir :: Text
repoType :: RepoType
repoSubdir :: Text
repoCommit :: Text
repoUrl :: Text
..} PackageMetadata
pm

          archiveObject :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
archiveObject =
            String
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackageLocationImmutable.PLIArchive" ((Object -> WarningParser (Unresolved PackageLocationImmutable))
 -> Value
 -> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable)))
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
              PackageMetadata
pm <- Object -> WarningParser PackageMetadata
parsePackageMetadata Object
o
              Unresolved Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation <- Object -> WarningParser (Unresolved ArchiveLocation)
parseArchiveLocationObject Object
o
              SHA256
archiveHash <- Object
o Object -> Text -> WarningParser SHA256
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"sha256"
              FileSize
archiveSize <- Object
o Object -> Text -> WarningParser FileSize
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"size"
              Text
archiveSubdir <- Object
o Object -> Text -> WarningParser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"subdir" WarningParser (Maybe Text) -> Text -> WarningParser Text
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Text
""
              Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved PackageLocationImmutable
 -> WarningParser (Unresolved PackageLocationImmutable))
-> Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO PackageLocationImmutable)
-> Unresolved PackageLocationImmutable
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO PackageLocationImmutable)
 -> Unresolved PackageLocationImmutable)
-> (Maybe (Path Abs Dir) -> IO PackageLocationImmutable)
-> Unresolved PackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir -> do
                ArchiveLocation
archiveLocation <- Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation Maybe (Path Abs Dir)
mdir
                PackageLocationImmutable -> IO PackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageLocationImmutable -> IO PackageLocationImmutable)
-> PackageLocationImmutable -> IO PackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ Archive -> PackageMetadata -> PackageLocationImmutable
PLIArchive Archive :: ArchiveLocation -> SHA256 -> FileSize -> Text -> Archive
Archive {Text
SHA256
ArchiveLocation
FileSize
archiveLocation :: ArchiveLocation
archiveSubdir :: Text
archiveSize :: FileSize
archiveHash :: SHA256
archiveSize :: FileSize
archiveHash :: SHA256
archiveSubdir :: Text
archiveLocation :: ArchiveLocation
..} PackageMetadata
pm

          hackageObject :: Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
hackageObject =
             String
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackagelocationimmutable.PLIHackage (Object)" ((Object -> WarningParser (Unresolved PackageLocationImmutable))
 -> Value
 -> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable)))
-> (Object -> WarningParser (Unresolved PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (Unresolved PackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
                      BlobKey
treeKey <- Object
o Object -> Text -> WarningParser BlobKey
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"pantry-tree"
                      Text
htxt <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hackage"
                      case Text -> Either PantryException (PackageIdentifier, BlobKey)
parseHackageText Text
htxt of
                        Left PantryException
e -> String -> WarningParser (Unresolved PackageLocationImmutable)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WarningParser (Unresolved PackageLocationImmutable))
-> String -> WarningParser (Unresolved PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ PantryException -> String
forall a. Show a => a -> String
show PantryException
e
                        Right (PackageIdentifier
pkgIdentifier, BlobKey
blobKey) ->
                          Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved PackageLocationImmutable
 -> WarningParser (Unresolved PackageLocationImmutable))
-> Unresolved PackageLocationImmutable
-> WarningParser (Unresolved PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ PackageLocationImmutable -> Unresolved PackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageLocationImmutable -> Unresolved PackageLocationImmutable)
-> PackageLocationImmutable -> Unresolved PackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> BlobKey -> TreeKey -> PackageLocationImmutable
PLIHackage PackageIdentifier
pkgIdentifier BlobKey
blobKey (BlobKey -> TreeKey
TreeKey BlobKey
treeKey)

          github :: Value -> Parser (WithJSONWarnings (f PackageLocationImmutable))
github Value
value =
            String
-> (Object -> WarningParser (f PackageLocationImmutable))
-> Value
-> Parser (WithJSONWarnings (f PackageLocationImmutable))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackagelocationimmutable.PLIArchive:github" (\Object
o -> do
              PackageMetadata
pm <- Object -> WarningParser PackageMetadata
parsePackageMetadata Object
o
              GitHubRepo Text
ghRepo <- Object
o Object -> Text -> WarningParser GitHubRepo
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"github"
              Text
commit <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"commit"
              let archiveLocation :: ArchiveLocation
archiveLocation = Text -> ArchiveLocation
ALUrl (Text -> ArchiveLocation) -> Text -> ArchiveLocation
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
                    [ Text
"https://github.com/"
                    , Text
ghRepo
                    , Text
"/archive/"
                    , Text
commit
                    , Text
".tar.gz"
                    ]
              SHA256
archiveHash <- Object
o Object -> Text -> WarningParser SHA256
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"sha256"
              FileSize
archiveSize <- Object
o Object -> Text -> WarningParser FileSize
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"size"
              Text
archiveSubdir <- Object
o Object -> Text -> WarningParser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"subdir" WarningParser (Maybe Text) -> Text -> WarningParser Text
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Text
""
              f PackageLocationImmutable
-> WarningParser (f PackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f PackageLocationImmutable
 -> WarningParser (f PackageLocationImmutable))
-> f PackageLocationImmutable
-> WarningParser (f PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ PackageLocationImmutable -> f PackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageLocationImmutable -> f PackageLocationImmutable)
-> PackageLocationImmutable -> f PackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ Archive -> PackageMetadata -> PackageLocationImmutable
PLIArchive Archive :: ArchiveLocation -> SHA256 -> FileSize -> Text -> Archive
Archive {Text
SHA256
ArchiveLocation
FileSize
archiveSubdir :: Text
archiveSize :: FileSize
archiveHash :: SHA256
archiveLocation :: ArchiveLocation
archiveSize :: FileSize
archiveHash :: SHA256
archiveSubdir :: Text
archiveLocation :: ArchiveLocation
..} PackageMetadata
pm) Value
value

instance FromJSON (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable))) where
  parseJSON :: Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
parseJSON Value
v
      = Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
http Value
v
    Parser
  (WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
hackageText Value
v
    Parser
  (WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
hackageObject Value
v
    Parser
  (WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
repo Value
v
    Parser
  (WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
archiveObject Value
v
    Parser
  (WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
github Value
v
    Parser
  (WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Could not parse a UnresolvedRawPackageLocationImmutable from: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
v)
    where
      http :: Value -> Parser (WithJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable)))
      http :: Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
http = String
-> (Text
    -> Parser
         (WithJSONWarnings
            (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"UnresolvedPackageLocationImmutable.RPLIArchive (Text)" ((Text
  -> Parser
       (WithJSONWarnings
          (Unresolved (NonEmpty RawPackageLocationImmutable))))
 -> Value
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> (Text
    -> Parser
         (WithJSONWarnings
            (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case Text -> Either Text (Unresolved ArchiveLocation)
parseArchiveLocationText Text
t of
          Left Text
_ -> String
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> String
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ String
"Invalid archive location: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
          Right (Unresolved Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation) ->
            WithJSONWarnings
  (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WithJSONWarnings
   (Unresolved (NonEmpty RawPackageLocationImmutable))
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ Unresolved (NonEmpty RawPackageLocationImmutable)
-> WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a. a -> WithJSONWarnings a
noJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable)
 -> WithJSONWarnings
      (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO (NonEmpty RawPackageLocationImmutable))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir)
  -> IO (NonEmpty RawPackageLocationImmutable))
 -> Unresolved (NonEmpty RawPackageLocationImmutable))
-> (Maybe (Path Abs Dir)
    -> IO (NonEmpty RawPackageLocationImmutable))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir -> do
              ArchiveLocation
raLocation <- Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation Maybe (Path Abs Dir)
mdir
              let raHash :: Maybe a
raHash = Maybe a
forall a. Maybe a
Nothing
                  raSize :: Maybe a
raSize = Maybe a
forall a. Maybe a
Nothing
                  raSubdir :: Text
raSubdir = Text
T.empty
              NonEmpty RawPackageLocationImmutable
-> IO (NonEmpty RawPackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty RawPackageLocationImmutable
 -> IO (NonEmpty RawPackageLocationImmutable))
-> NonEmpty RawPackageLocationImmutable
-> IO (NonEmpty RawPackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ RawPackageLocationImmutable -> NonEmpty RawPackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawPackageLocationImmutable
 -> NonEmpty RawPackageLocationImmutable)
-> RawPackageLocationImmutable
-> NonEmpty RawPackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ RawArchive -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIArchive RawArchive :: ArchiveLocation
-> Maybe SHA256 -> Maybe FileSize -> Text -> RawArchive
RawArchive {Maybe SHA256
Maybe FileSize
Text
ArchiveLocation
forall a. Maybe a
raSubdir :: Text
raSize :: forall a. Maybe a
raHash :: forall a. Maybe a
raLocation :: ArchiveLocation
raSize :: Maybe FileSize
raHash :: Maybe SHA256
raSubdir :: Text
raLocation :: ArchiveLocation
..} RawPackageMetadata
rpmEmpty

      hackageText :: Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
hackageText = String
-> (Text
    -> Parser
         (WithJSONWarnings
            (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"UnresolvedPackageLocationImmutable.UPLIHackage (Text)" ((Text
  -> Parser
       (WithJSONWarnings
          (Unresolved (NonEmpty RawPackageLocationImmutable))))
 -> Value
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> (Text
    -> Parser
         (WithJSONWarnings
            (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case Text -> Either PantryException PackageIdentifierRevision
parsePackageIdentifierRevision Text
t of
          Left PantryException
e -> String
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> String
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ PantryException -> String
forall a. Show a => a -> String
show PantryException
e
          Right PackageIdentifierRevision
pir -> WithJSONWarnings
  (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WithJSONWarnings
   (Unresolved (NonEmpty RawPackageLocationImmutable))
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable))
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ Unresolved (NonEmpty RawPackageLocationImmutable)
-> WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a. a -> WithJSONWarnings a
noJSONWarnings (Unresolved (NonEmpty RawPackageLocationImmutable)
 -> WithJSONWarnings
      (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty RawPackageLocationImmutable
 -> Unresolved (NonEmpty RawPackageLocationImmutable))
-> NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ RawPackageLocationImmutable -> NonEmpty RawPackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawPackageLocationImmutable
 -> NonEmpty RawPackageLocationImmutable)
-> RawPackageLocationImmutable
-> NonEmpty RawPackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ PackageIdentifierRevision
-> Maybe TreeKey -> RawPackageLocationImmutable
RPLIHackage PackageIdentifierRevision
pir Maybe TreeKey
forall a. Maybe a
Nothing

      hackageObject :: Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
hackageObject = String
-> (Object
    -> WarningParser
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackageLocationImmutable.UPLIHackage" ((Object
  -> WarningParser
       (Unresolved (NonEmpty RawPackageLocationImmutable)))
 -> Value
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> (Object
    -> WarningParser
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ \Object
o -> (NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure(NonEmpty RawPackageLocationImmutable
 -> Unresolved (NonEmpty RawPackageLocationImmutable))
-> (RawPackageLocationImmutable
    -> NonEmpty RawPackageLocationImmutable)
-> RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RawPackageLocationImmutable -> NonEmpty RawPackageLocationImmutable
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (RawPackageLocationImmutable
 -> Unresolved (NonEmpty RawPackageLocationImmutable))
-> WriterT WarningParserMonoid Parser RawPackageLocationImmutable
-> WarningParser
     (Unresolved (NonEmpty RawPackageLocationImmutable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PackageIdentifierRevision
-> Maybe TreeKey -> RawPackageLocationImmutable
RPLIHackage
        (PackageIdentifierRevision
 -> Maybe TreeKey -> RawPackageLocationImmutable)
-> WriterT WarningParserMonoid Parser PackageIdentifierRevision
-> WriterT
     WarningParserMonoid
     Parser
     (Maybe TreeKey -> RawPackageLocationImmutable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object
-> Text
-> WriterT WarningParserMonoid Parser PackageIdentifierRevision
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hackage"
        WriterT
  WarningParserMonoid
  Parser
  (Maybe TreeKey -> RawPackageLocationImmutable)
-> WriterT WarningParserMonoid Parser (Maybe TreeKey)
-> WriterT WarningParserMonoid Parser RawPackageLocationImmutable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Text -> WriterT WarningParserMonoid Parser (Maybe TreeKey)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"pantry-tree")

      optionalSubdirs :: Object -> WarningParser OptionalSubdirs
      optionalSubdirs :: Object -> WarningParser OptionalSubdirs
optionalSubdirs Object
o =
        -- if subdirs exists, it needs to be valid
        case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
"subdirs" Object
o of
          Just Value
v' -> do
            Text -> WarningParser ()
tellJSONField Text
"subdirs"
            [Text]
subdirs <- Parser [Text] -> WarningParser [Text]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser [Text] -> WarningParser [Text])
-> Parser [Text] -> WarningParser [Text]
forall a b. (a -> b) -> a -> b
$ Value -> Parser [Text]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v'
            case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Text]
subdirs of
              Maybe (NonEmpty Text)
Nothing -> String -> WarningParser OptionalSubdirs
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid empty subdirs"
              Just NonEmpty Text
x -> OptionalSubdirs -> WarningParser OptionalSubdirs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OptionalSubdirs -> WarningParser OptionalSubdirs)
-> OptionalSubdirs -> WarningParser OptionalSubdirs
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> OptionalSubdirs
OSSubdirs NonEmpty Text
x
          Maybe Value
Nothing -> Text -> RawPackageMetadata -> OptionalSubdirs
OSPackageMetadata
            (Text -> RawPackageMetadata -> OptionalSubdirs)
-> WarningParser Text
-> WriterT
     WarningParserMonoid Parser (RawPackageMetadata -> OptionalSubdirs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WarningParser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"subdir" WarningParser (Maybe Text) -> Text -> WarningParser Text
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Text
T.empty
            WriterT
  WarningParserMonoid Parser (RawPackageMetadata -> OptionalSubdirs)
-> WriterT WarningParserMonoid Parser RawPackageMetadata
-> WarningParser OptionalSubdirs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe PackageName
-> Maybe Version
-> Maybe TreeKey
-> Maybe BlobKey
-> RawPackageMetadata
rawPackageMetadataHelper
                  (Maybe PackageName
 -> Maybe Version
 -> Maybe TreeKey
 -> Maybe BlobKey
 -> RawPackageMetadata)
-> WriterT WarningParserMonoid Parser (Maybe PackageName)
-> WriterT
     WarningParserMonoid
     Parser
     (Maybe Version
      -> Maybe TreeKey -> Maybe BlobKey -> RawPackageMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((CabalString PackageName -> PackageName)
-> Maybe (CabalString PackageName) -> Maybe PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CabalString PackageName -> PackageName
forall a. CabalString a -> a
unCabalString (Maybe (CabalString PackageName) -> Maybe PackageName)
-> WriterT
     WarningParserMonoid Parser (Maybe (CabalString PackageName))
-> WriterT WarningParserMonoid Parser (Maybe PackageName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Text
-> WriterT
     WarningParserMonoid Parser (Maybe (CabalString PackageName))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"name"))
                  WriterT
  WarningParserMonoid
  Parser
  (Maybe Version
   -> Maybe TreeKey -> Maybe BlobKey -> RawPackageMetadata)
-> WriterT WarningParserMonoid Parser (Maybe Version)
-> WriterT
     WarningParserMonoid
     Parser
     (Maybe TreeKey -> Maybe BlobKey -> RawPackageMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((CabalString Version -> Version)
-> Maybe (CabalString Version) -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CabalString Version -> Version
forall a. CabalString a -> a
unCabalString (Maybe (CabalString Version) -> Maybe Version)
-> WriterT WarningParserMonoid Parser (Maybe (CabalString Version))
-> WriterT WarningParserMonoid Parser (Maybe Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Text
-> WriterT WarningParserMonoid Parser (Maybe (CabalString Version))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"version"))
                  WriterT
  WarningParserMonoid
  Parser
  (Maybe TreeKey -> Maybe BlobKey -> RawPackageMetadata)
-> WriterT WarningParserMonoid Parser (Maybe TreeKey)
-> WriterT
     WarningParserMonoid Parser (Maybe BlobKey -> RawPackageMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Text -> WriterT WarningParserMonoid Parser (Maybe TreeKey)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"pantry-tree"
                  WriterT
  WarningParserMonoid Parser (Maybe BlobKey -> RawPackageMetadata)
-> WarningParser (Maybe BlobKey)
-> WriterT WarningParserMonoid Parser RawPackageMetadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> WarningParser (Maybe BlobKey)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"cabal-file")

      rawPackageMetadataHelper
        :: Maybe PackageName
        -> Maybe Version
        -> Maybe TreeKey
        -> Maybe BlobKey
        -> RawPackageMetadata
      rawPackageMetadataHelper :: Maybe PackageName
-> Maybe Version
-> Maybe TreeKey
-> Maybe BlobKey
-> RawPackageMetadata
rawPackageMetadataHelper Maybe PackageName
name Maybe Version
version Maybe TreeKey
pantryTree Maybe BlobKey
_ignoredCabalFile =
        Maybe PackageName
-> Maybe Version -> Maybe TreeKey -> RawPackageMetadata
RawPackageMetadata Maybe PackageName
name Maybe Version
version Maybe TreeKey
pantryTree

      repo :: Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
repo = String
-> (Object
    -> WarningParser
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackageLocationImmutable.UPLIRepo" ((Object
  -> WarningParser
       (Unresolved (NonEmpty RawPackageLocationImmutable)))
 -> Value
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> (Object
    -> WarningParser
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        (RepoType
repoType, Text
repoUrl) <-
          ((RepoType
RepoGit, ) (Text -> (RepoType, Text))
-> WarningParser Text
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"git") WriterT WarningParserMonoid Parser (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          ((RepoType
RepoHg, ) (Text -> (RepoType, Text))
-> WarningParser Text
-> WriterT WarningParserMonoid Parser (RepoType, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"hg")
        Text
repoCommit <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"commit"
        OptionalSubdirs
os <- Object -> WarningParser OptionalSubdirs
optionalSubdirs Object
o
        Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
     (Unresolved (NonEmpty RawPackageLocationImmutable))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved (NonEmpty RawPackageLocationImmutable)
 -> WarningParser
      (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
     (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty RawPackageLocationImmutable
 -> Unresolved (NonEmpty RawPackageLocationImmutable))
-> NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ ((Text, RawPackageMetadata) -> RawPackageLocationImmutable)
-> NonEmpty (Text, RawPackageMetadata)
-> NonEmpty RawPackageLocationImmutable
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\(Text
repoSubdir, RawPackageMetadata
pm) -> Repo -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIRepo Repo :: Text -> Text -> RepoType -> Text -> Repo
Repo {Text
RepoType
repoSubdir :: Text
repoCommit :: Text
repoUrl :: Text
repoType :: RepoType
repoType :: RepoType
repoSubdir :: Text
repoCommit :: Text
repoUrl :: Text
..} RawPackageMetadata
pm) (OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
osToRpms OptionalSubdirs
os)

      archiveObject :: Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
archiveObject = String
-> (Object
    -> WarningParser
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedPackageLocationImmutable.RPLIArchive" ((Object
  -> WarningParser
       (Unresolved (NonEmpty RawPackageLocationImmutable)))
 -> Value
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> (Object
    -> WarningParser
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Unresolved Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation <- Object -> WarningParser (Unresolved ArchiveLocation)
parseArchiveLocationObject Object
o
        Maybe SHA256
raHash <- Object
o Object -> Text -> WarningParser (Maybe SHA256)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha256"
        Maybe FileSize
raSize <- Object
o Object -> Text -> WarningParser (Maybe FileSize)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"size"
        OptionalSubdirs
os <- Object -> WarningParser OptionalSubdirs
optionalSubdirs Object
o
        Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
     (Unresolved (NonEmpty RawPackageLocationImmutable))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved (NonEmpty RawPackageLocationImmutable)
 -> WarningParser
      (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
     (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO (NonEmpty RawPackageLocationImmutable))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir)
  -> IO (NonEmpty RawPackageLocationImmutable))
 -> Unresolved (NonEmpty RawPackageLocationImmutable))
-> (Maybe (Path Abs Dir)
    -> IO (NonEmpty RawPackageLocationImmutable))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir -> do
          ArchiveLocation
raLocation <- Maybe (Path Abs Dir) -> IO ArchiveLocation
mkArchiveLocation Maybe (Path Abs Dir)
mdir
          NonEmpty RawPackageLocationImmutable
-> IO (NonEmpty RawPackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty RawPackageLocationImmutable
 -> IO (NonEmpty RawPackageLocationImmutable))
-> NonEmpty RawPackageLocationImmutable
-> IO (NonEmpty RawPackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ ((Text, RawPackageMetadata) -> RawPackageLocationImmutable)
-> NonEmpty (Text, RawPackageMetadata)
-> NonEmpty RawPackageLocationImmutable
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\(Text
raSubdir, RawPackageMetadata
pm) -> RawArchive -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIArchive RawArchive :: ArchiveLocation
-> Maybe SHA256 -> Maybe FileSize -> Text -> RawArchive
RawArchive {Maybe SHA256
Maybe FileSize
Text
ArchiveLocation
raSubdir :: Text
raLocation :: ArchiveLocation
raSize :: Maybe FileSize
raHash :: Maybe SHA256
raSize :: Maybe FileSize
raHash :: Maybe SHA256
raSubdir :: Text
raLocation :: ArchiveLocation
..} RawPackageMetadata
pm) (OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
osToRpms OptionalSubdirs
os)

      github :: Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
github = String
-> (Object
    -> WarningParser
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"PLArchive:github" ((Object
  -> WarningParser
       (Unresolved (NonEmpty RawPackageLocationImmutable)))
 -> Value
 -> Parser
      (WithJSONWarnings
         (Unresolved (NonEmpty RawPackageLocationImmutable))))
-> (Object
    -> WarningParser
         (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Value
-> Parser
     (WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable)))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        GitHubRepo Text
ghRepo <- Object
o Object -> Text -> WarningParser GitHubRepo
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"github"
        Text
commit <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"commit"
        let raLocation :: ArchiveLocation
raLocation = Text -> ArchiveLocation
ALUrl (Text -> ArchiveLocation) -> Text -> ArchiveLocation
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
              [ Text
"https://github.com/"
              , Text
ghRepo
              , Text
"/archive/"
              , Text
commit
              , Text
".tar.gz"
              ]
        Maybe SHA256
raHash <- Object
o Object -> Text -> WarningParser (Maybe SHA256)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha256"
        Maybe FileSize
raSize <- Object
o Object -> Text -> WarningParser (Maybe FileSize)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"size"
        OptionalSubdirs
os <- Object -> WarningParser OptionalSubdirs
optionalSubdirs Object
o
        Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
     (Unresolved (NonEmpty RawPackageLocationImmutable))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved (NonEmpty RawPackageLocationImmutable)
 -> WarningParser
      (Unresolved (NonEmpty RawPackageLocationImmutable)))
-> Unresolved (NonEmpty RawPackageLocationImmutable)
-> WarningParser
     (Unresolved (NonEmpty RawPackageLocationImmutable))
forall a b. (a -> b) -> a -> b
$ NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty RawPackageLocationImmutable
 -> Unresolved (NonEmpty RawPackageLocationImmutable))
-> NonEmpty RawPackageLocationImmutable
-> Unresolved (NonEmpty RawPackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ ((Text, RawPackageMetadata) -> RawPackageLocationImmutable)
-> NonEmpty (Text, RawPackageMetadata)
-> NonEmpty RawPackageLocationImmutable
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\(Text
raSubdir, RawPackageMetadata
pm) -> RawArchive -> RawPackageMetadata -> RawPackageLocationImmutable
RPLIArchive RawArchive :: ArchiveLocation
-> Maybe SHA256 -> Maybe FileSize -> Text -> RawArchive
RawArchive {Maybe SHA256
Maybe FileSize
Text
ArchiveLocation
raSubdir :: Text
raSize :: Maybe FileSize
raHash :: Maybe SHA256
raLocation :: ArchiveLocation
raSize :: Maybe FileSize
raHash :: Maybe SHA256
raSubdir :: Text
raLocation :: ArchiveLocation
..} RawPackageMetadata
pm) (OptionalSubdirs -> NonEmpty (Text, RawPackageMetadata)
osToRpms OptionalSubdirs
os)

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

-- 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 :: 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 :: Map (CabalString a) v -> Map a v
unCabalStringMap = (CabalString a -> a) -> Map (CabalString a) v -> Map a v
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic CabalString a -> a
forall a. CabalString a -> a
unCabalString

instance Distribution.Pretty.Pretty a => ToJSON (CabalString a) where
  toJSON :: CabalString a -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value)
-> (CabalString a -> String) -> CabalString a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Pretty a => a -> String
Distribution.Text.display (a -> String) -> (CabalString a -> a) -> CabalString a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalString a -> a
forall a. CabalString a -> a
unCabalString
instance Distribution.Pretty.Pretty a => ToJSONKey (CabalString a) where
  toJSONKey :: ToJSONKeyFunction (CabalString a)
toJSONKey = (CabalString a -> Text) -> ToJSONKeyFunction (CabalString a)
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ((CabalString a -> Text) -> ToJSONKeyFunction (CabalString a))
-> (CabalString a -> Text) -> ToJSONKeyFunction (CabalString a)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text)
-> (CabalString a -> String) -> CabalString a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Pretty a => a -> String
Distribution.Text.display (a -> String) -> (CabalString a -> a) -> CabalString a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalString a -> a
forall a. CabalString a -> a
unCabalString

instance forall a. IsCabalString a => FromJSON (CabalString a) where
  parseJSON :: Value -> Parser (CabalString a)
parseJSON = String
-> (Text -> Parser (CabalString a))
-> Value
-> Parser (CabalString a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
name ((Text -> Parser (CabalString a))
 -> Value -> Parser (CabalString a))
-> (Text -> Parser (CabalString a))
-> Value
-> Parser (CabalString a)
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case String -> Maybe a
forall a. IsCabalString a => String -> Maybe a
cabalStringParser (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t of
      Maybe a
Nothing -> String -> Parser (CabalString a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (CabalString a))
-> String -> Parser (CabalString a)
forall a b. (a -> b) -> a -> b
$ String
"Invalid " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
      Just a
x -> CabalString a -> Parser (CabalString a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CabalString a -> Parser (CabalString a))
-> CabalString a -> Parser (CabalString a)
forall a b. (a -> b) -> a -> b
$ a -> CabalString a
forall a. a -> CabalString a
CabalString a
x
    where
      name :: String
name = Maybe a -> String
forall a (proxy :: * -> *). IsCabalString a => proxy a -> String
cabalStringName (Maybe a
forall a. Maybe a
Nothing :: Maybe a)
instance forall a. IsCabalString a => FromJSONKey (CabalString a) where
  fromJSONKey :: FromJSONKeyFunction (CabalString a)
fromJSONKey =
    (Text -> Parser (CabalString a))
-> FromJSONKeyFunction (CabalString a)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser (CabalString a))
 -> FromJSONKeyFunction (CabalString a))
-> (Text -> Parser (CabalString a))
-> FromJSONKeyFunction (CabalString a)
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case String -> Maybe a
forall a. IsCabalString a => String -> Maybe a
cabalStringParser (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t of
      Maybe a
Nothing -> String -> Parser (CabalString a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (CabalString a))
-> String -> Parser (CabalString a)
forall a b. (a -> b) -> a -> b
$ String
"Invalid " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
      Just a
x -> CabalString a -> Parser (CabalString a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CabalString a -> Parser (CabalString a))
-> CabalString a -> Parser (CabalString a)
forall a b. (a -> b) -> a -> b
$ a -> CabalString a
forall a. a -> CabalString a
CabalString a
x
    where
      name :: String
name = Maybe a -> String
forall a (proxy :: * -> *). IsCabalString a => proxy a -> String
cabalStringName (Maybe a
forall a. Maybe a
Nothing :: Maybe a)

class IsCabalString a where
  cabalStringName :: proxy a -> String
  cabalStringParser :: String -> Maybe a
instance IsCabalString PackageName where
  cabalStringName :: proxy PackageName -> String
cabalStringName proxy PackageName
_ = String
"package name"
  cabalStringParser :: String -> Maybe PackageName
cabalStringParser = String -> Maybe PackageName
parsePackageName
instance IsCabalString Version where
  cabalStringName :: proxy Version -> String
cabalStringName proxy Version
_ = String
"version"
  cabalStringParser :: String -> Maybe Version
cabalStringParser = String -> Maybe Version
parseVersion
instance IsCabalString VersionRange where
  cabalStringName :: proxy VersionRange -> String
cabalStringName proxy VersionRange
_ = String
"version range"
  cabalStringParser :: String -> Maybe VersionRange
cabalStringParser = String -> Maybe VersionRange
parseVersionRange
instance IsCabalString PackageIdentifier where
  cabalStringName :: proxy PackageIdentifier -> String
cabalStringName proxy PackageIdentifier
_ = String
"package identifier"
  cabalStringParser :: String -> Maybe PackageIdentifier
cabalStringParser = String -> Maybe PackageIdentifier
parsePackageIdentifier
instance IsCabalString FlagName where
  cabalStringName :: proxy FlagName -> String
cabalStringName proxy FlagName
_ = String
"flag name"
  cabalStringParser :: String -> Maybe FlagName
cabalStringParser = String -> Maybe FlagName
parseFlagName

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


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

instance NFData WantedCompiler
instance Display WantedCompiler where
  display :: WantedCompiler -> Utf8Builder
display (WCGhc Version
vghc) = Utf8Builder
"ghc-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
vghc)
  display (WCGhcjs Version
vghcjs Version
vghc) =
    Utf8Builder
"ghcjs-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
vghcjs) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"_ghc-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
vghc)
  display (WCGhcGit Text
commit Text
flavour) =
    Utf8Builder
"ghc-git-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
commit Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
flavour
instance ToJSON WantedCompiler where
  toJSON :: WantedCompiler -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (WantedCompiler -> Text) -> WantedCompiler -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (WantedCompiler -> Utf8Builder) -> WantedCompiler -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance FromJSON WantedCompiler where
  parseJSON :: Value -> Parser WantedCompiler
parseJSON = String
-> (Text -> Parser WantedCompiler)
-> Value
-> Parser WantedCompiler
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"WantedCompiler" ((Text -> Parser WantedCompiler) -> Value -> Parser WantedCompiler)
-> (Text -> Parser WantedCompiler)
-> Value
-> Parser WantedCompiler
forall a b. (a -> b) -> a -> b
$ (PantryException -> Parser WantedCompiler)
-> (WantedCompiler -> Parser WantedCompiler)
-> Either PantryException WantedCompiler
-> Parser WantedCompiler
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser WantedCompiler
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser WantedCompiler)
-> (PantryException -> String)
-> PantryException
-> Parser WantedCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PantryException -> String
forall a. Show a => a -> String
show) WantedCompiler -> Parser WantedCompiler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PantryException WantedCompiler -> Parser WantedCompiler)
-> (Text -> Either PantryException WantedCompiler)
-> Text
-> Parser WantedCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either PantryException WantedCompiler
parseWantedCompiler
instance FromJSONKey WantedCompiler where
  fromJSONKey :: FromJSONKeyFunction WantedCompiler
fromJSONKey =
    (Text -> Parser WantedCompiler)
-> FromJSONKeyFunction WantedCompiler
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser WantedCompiler)
 -> FromJSONKeyFunction WantedCompiler)
-> (Text -> Parser WantedCompiler)
-> FromJSONKeyFunction WantedCompiler
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Text -> Either PantryException WantedCompiler
parseWantedCompiler Text
t of
      Left PantryException
e -> String -> Parser WantedCompiler
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser WantedCompiler)
-> String -> Parser WantedCompiler
forall a b. (a -> b) -> a -> b
$ String
"Invalid WantedComiler " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PantryException -> String
forall a. Show a => a -> String
show PantryException
e
      Right WantedCompiler
x -> WantedCompiler -> Parser WantedCompiler
forall (f :: * -> *) a. Applicative f => a -> f a
pure WantedCompiler
x

-- | 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe WantedCompiler
parseGhc
  where
    parseGhcjs :: Text -> Maybe WantedCompiler
parseGhcjs Text
t1 = do
      let (Text
ghcjsVT, Text
t2) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
t1
      Version
ghcjsV <- String -> Maybe Version
parseVersion (String -> Maybe Version) -> String -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ghcjsVT
      Text
ghcVT <- Text -> Text -> Maybe Text
T.stripPrefix Text
"_ghc-" Text
t2
      Version
ghcV <- String -> Maybe Version
parseVersion (String -> Maybe Version) -> String -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ghcVT
      WantedCompiler -> Maybe WantedCompiler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WantedCompiler -> Maybe WantedCompiler)
-> WantedCompiler -> Maybe WantedCompiler
forall a b. (a -> b) -> a -> b
$ Version -> Version -> WantedCompiler
WCGhcjs Version
ghcjsV Version
ghcV
    parseGhcGit :: Text -> f WantedCompiler
parseGhcGit Text
t1 = do
      let (Text
commit, Text
flavour) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Text
t1
      WantedCompiler -> f WantedCompiler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WantedCompiler -> f WantedCompiler)
-> WantedCompiler -> f WantedCompiler
forall a b. (a -> b) -> a -> b
$ Text -> Text -> WantedCompiler
WCGhcGit Text
commit (Int -> Text -> Text
T.drop Int
1 Text
flavour)
    parseGhc :: Text -> Maybe WantedCompiler
parseGhc = (Version -> WantedCompiler)
-> Maybe Version -> Maybe WantedCompiler
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> WantedCompiler
WCGhc (Maybe Version -> Maybe WantedCompiler)
-> (Text -> Maybe Version) -> Text -> Maybe WantedCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Version
parseVersion (String -> Maybe Version)
-> (Text -> String) -> Text -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

instance FromJSON (WithJSONWarnings (Unresolved RawSnapshotLocation)) where
  parseJSON :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
parseJSON Value
v = Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
text Value
v Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
obj Value
v
    where
      text :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
      text :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
text = String
-> (Text
    -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"UnresolvedSnapshotLocation (Text)" ((Text
  -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
 -> Value
 -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> (Text
    -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall a b. (a -> b) -> a -> b
$ WithJSONWarnings (Unresolved RawSnapshotLocation)
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WithJSONWarnings (Unresolved RawSnapshotLocation)
 -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> (Text -> WithJSONWarnings (Unresolved RawSnapshotLocation))
-> Text
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unresolved RawSnapshotLocation
-> WithJSONWarnings (Unresolved RawSnapshotLocation)
forall a. a -> WithJSONWarnings a
noJSONWarnings (Unresolved RawSnapshotLocation
 -> WithJSONWarnings (Unresolved RawSnapshotLocation))
-> (Text -> Unresolved RawSnapshotLocation)
-> Text
-> WithJSONWarnings (Unresolved RawSnapshotLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocation

      obj :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
      obj :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
obj = String
-> (Object -> WarningParser (Unresolved RawSnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"UnresolvedSnapshotLocation (Object)" ((Object -> WarningParser (Unresolved RawSnapshotLocation))
 -> Value
 -> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> (Object -> WarningParser (Unresolved RawSnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLocation))
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        ((RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> Unresolved RawSnapshotLocation)
-> (WantedCompiler -> RawSnapshotLocation)
-> WantedCompiler
-> Unresolved RawSnapshotLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WantedCompiler -> RawSnapshotLocation
RSLCompiler) (WantedCompiler -> Unresolved RawSnapshotLocation)
-> WriterT WarningParserMonoid Parser WantedCompiler
-> WarningParser (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WriterT WarningParserMonoid Parser WantedCompiler
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"compiler") WarningParser (Unresolved RawSnapshotLocation)
-> WarningParser (Unresolved RawSnapshotLocation)
-> WarningParser (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ((\Text
x Maybe BlobKey
y -> RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> Unresolved RawSnapshotLocation)
-> RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ Text -> Maybe BlobKey -> RawSnapshotLocation
RSLUrl Text
x Maybe BlobKey
y) (Text -> Maybe BlobKey -> Unresolved RawSnapshotLocation)
-> WarningParser Text
-> WriterT
     WarningParserMonoid
     Parser
     (Maybe BlobKey -> Unresolved RawSnapshotLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"url" WriterT
  WarningParserMonoid
  Parser
  (Maybe BlobKey -> Unresolved RawSnapshotLocation)
-> WarningParser (Maybe BlobKey)
-> WarningParser (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> WarningParser (Maybe BlobKey)
blobKey Object
o) WarningParser (Unresolved RawSnapshotLocation)
-> WarningParser (Unresolved RawSnapshotLocation)
-> WarningParser (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath (Text -> Unresolved RawSnapshotLocation)
-> WarningParser Text
-> WarningParser (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"filepath")

      blobKey :: Object -> WarningParser (Maybe BlobKey)
blobKey Object
o = do
        Maybe SHA256
msha <- Object
o Object -> Text -> WarningParser (Maybe SHA256)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha256"
        Maybe FileSize
msize <- Object
o Object -> Text -> WarningParser (Maybe FileSize)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"size"
        case (Maybe SHA256
msha, Maybe FileSize
msize) of
          (Maybe SHA256
Nothing, Maybe FileSize
Nothing) -> Maybe BlobKey -> WarningParser (Maybe BlobKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe BlobKey
forall a. Maybe a
Nothing
          (Just SHA256
sha, Just FileSize
size') -> Maybe BlobKey -> WarningParser (Maybe BlobKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe BlobKey -> WarningParser (Maybe BlobKey))
-> Maybe BlobKey -> WarningParser (Maybe BlobKey)
forall a b. (a -> b) -> a -> b
$ BlobKey -> Maybe BlobKey
forall a. a -> Maybe a
Just (BlobKey -> Maybe BlobKey) -> BlobKey -> Maybe BlobKey
forall a b. (a -> b) -> a -> b
$ SHA256 -> FileSize -> BlobKey
BlobKey SHA256
sha FileSize
size'
          (Just SHA256
_sha, Maybe FileSize
Nothing) -> String -> WarningParser (Maybe BlobKey)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"You must also specify the file size"
          (Maybe SHA256
Nothing, Just FileSize
_) -> String -> WarningParser (Maybe BlobKey)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"You must also specify the file's SHA256"

instance Display SnapshotLocation where
  display :: SnapshotLocation -> Utf8Builder
display (SLCompiler WantedCompiler
compiler) = WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display WantedCompiler
compiler
  display (SLUrl Text
url BlobKey
blob) = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" (" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display BlobKey
blob Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
")"
  display (SLFilePath ResolvedPath File
resolved) = RelFilePath -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved)

-- | 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 (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> Unresolved RawSnapshotLocation)
-> (WantedCompiler -> RawSnapshotLocation)
-> WantedCompiler
-> Unresolved RawSnapshotLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WantedCompiler -> RawSnapshotLocation
RSLCompiler) (Text -> Either PantryException WantedCompiler
parseWantedCompiler Text
t0)) Maybe (Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> Unresolved RawSnapshotLocation)
-> (SnapName -> RawSnapshotLocation)
-> SnapName
-> Unresolved RawSnapshotLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapName -> RawSnapshotLocation
RSLSynonym (SnapName -> Unresolved RawSnapshotLocation)
-> Maybe SnapName -> Maybe (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe SnapName
forall (m :: * -> *). MonadThrow m => Text -> m SnapName
parseSnapName Text
t0) Maybe (Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Maybe (Unresolved RawSnapshotLocation)
parseGithub Maybe (Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
-> Maybe (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Maybe (Unresolved RawSnapshotLocation)
parseUrl
  where
    parseGithub :: Maybe (Unresolved RawSnapshotLocation)
parseGithub = do
      Text
t1 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"github:" Text
t0
      let (Text
user, Text
t2) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
t1
      Text
t3 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"/" Text
t2
      let (Text
repo, Text
t4) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
t3
      Text
path <- Text -> Text -> Maybe Text
T.stripPrefix Text
":" Text
t4
      Unresolved RawSnapshotLocation
-> Maybe (Unresolved RawSnapshotLocation)
forall a. a -> Maybe a
Just (Unresolved RawSnapshotLocation
 -> Maybe (Unresolved RawSnapshotLocation))
-> Unresolved RawSnapshotLocation
-> Maybe (Unresolved RawSnapshotLocation)
forall a b. (a -> b) -> a -> b
$ RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> Unresolved RawSnapshotLocation)
-> RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RawSnapshotLocation
githubSnapshotLocation Text
user Text
repo Text
path

    parseUrl :: Maybe (Unresolved RawSnapshotLocation)
parseUrl = String -> Maybe Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (Text -> String
T.unpack Text
t0) Maybe Request
-> Unresolved RawSnapshotLocation
-> Maybe (Unresolved RawSnapshotLocation)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RawSnapshotLocation -> Unresolved RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe BlobKey -> RawSnapshotLocation
RSLUrl Text
t0 Maybe BlobKey
forall a. Maybe a
Nothing)

parseRawSnapshotLocationPath :: Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath :: Text -> Unresolved RawSnapshotLocation
parseRawSnapshotLocationPath Text
t =
  (Maybe (Path Abs Dir) -> IO RawSnapshotLocation)
-> Unresolved RawSnapshotLocation
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO RawSnapshotLocation)
 -> Unresolved RawSnapshotLocation)
-> (Maybe (Path Abs Dir) -> IO RawSnapshotLocation)
-> Unresolved RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir ->
  case Maybe (Path Abs Dir)
mdir of
    Maybe (Path Abs Dir)
Nothing -> PantryException -> IO RawSnapshotLocation
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PantryException -> IO RawSnapshotLocation)
-> PantryException -> IO RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
InvalidFilePathSnapshot Text
t
    Just Path Abs Dir
dir -> do
      Path Abs File
abs' <- Path Abs Dir -> String -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs File)
resolveFile Path Abs Dir
dir (Text -> String
T.unpack Text
t) IO (Path Abs File)
-> (SomeException -> IO (Path Abs File)) -> IO (Path Abs File)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
_ -> PantryException -> IO (Path Abs File)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Path Abs Dir -> Text -> PantryException
InvalidSnapshotLocation Path Abs Dir
dir Text
t)
      RawSnapshotLocation -> IO RawSnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation -> IO RawSnapshotLocation)
-> RawSnapshotLocation -> IO RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> RawSnapshotLocation
RSLFilePath (ResolvedPath File -> RawSnapshotLocation)
-> ResolvedPath File -> RawSnapshotLocation
forall a b. (a -> b) -> a -> b
$ RelFilePath -> Path Abs File -> ResolvedPath File
forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath Text
t) Path Abs File
abs'

githubSnapshotLocation :: Text -> Text -> Text -> RawSnapshotLocation
githubSnapshotLocation :: Text -> Text -> Text -> RawSnapshotLocation
githubSnapshotLocation Text
user Text
repo Text
path =
  let url :: Text
url = [Text] -> Text
T.concat
        [ Text
"https://raw.githubusercontent.com/"
        , Text
user
        , Text
"/"
        , Text
repo
        , Text
"/master/"
        , Text
path
        ]
   in Text -> Maybe BlobKey -> RawSnapshotLocation
RSLUrl Text
url Maybe BlobKey
forall a. Maybe a
Nothing

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

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

-- | 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
<> Integer -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Integer
year Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"/" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
month Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"/" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
day Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
".yaml"
  where
    (Integer
year, Int
month, Int
day) = Day -> (Integer, Int, Int)
toGregorian Day
date

-- | A snapshot synonym.
-- It is expanded according to the field 'snapshotLocation'
-- of a 'PantryConfig'.
--
-- @ since 0.5.0.0
data SnapName
    -- | LTS Haskell snapshot,
    -- displayed as @"lts-maj.min"@.
    --
    -- @since 0.5.0.0
    = LTS
        !Int -- ^ Major version
        !Int -- ^ Minor version
    -- | Stackage Nightly snapshot,
    -- displayed as @"nighly-YYYY-MM-DD"@.
    --
    -- @since 0.5.0.0
    | Nightly !Day
    deriving (SnapName -> SnapName -> Bool
(SnapName -> SnapName -> Bool)
-> (SnapName -> SnapName -> Bool) -> Eq SnapName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapName -> SnapName -> Bool
$c/= :: SnapName -> SnapName -> Bool
== :: SnapName -> SnapName -> Bool
$c== :: SnapName -> SnapName -> Bool
Eq, Eq SnapName
Eq SnapName
-> (SnapName -> SnapName -> Ordering)
-> (SnapName -> SnapName -> Bool)
-> (SnapName -> SnapName -> Bool)
-> (SnapName -> SnapName -> Bool)
-> (SnapName -> SnapName -> Bool)
-> (SnapName -> SnapName -> SnapName)
-> (SnapName -> SnapName -> SnapName)
-> Ord SnapName
SnapName -> SnapName -> Bool
SnapName -> SnapName -> Ordering
SnapName -> SnapName -> SnapName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SnapName -> SnapName -> SnapName
$cmin :: SnapName -> SnapName -> SnapName
max :: SnapName -> SnapName -> SnapName
$cmax :: SnapName -> SnapName -> SnapName
>= :: SnapName -> SnapName -> Bool
$c>= :: SnapName -> SnapName -> Bool
> :: SnapName -> SnapName -> Bool
$c> :: SnapName -> SnapName -> Bool
<= :: SnapName -> SnapName -> Bool
$c<= :: SnapName -> SnapName -> Bool
< :: SnapName -> SnapName -> Bool
$c< :: SnapName -> SnapName -> Bool
compare :: SnapName -> SnapName -> Ordering
$ccompare :: SnapName -> SnapName -> Ordering
$cp1Ord :: Eq SnapName
Ord, (forall x. SnapName -> Rep SnapName x)
-> (forall x. Rep SnapName x -> SnapName) -> Generic SnapName
forall x. Rep SnapName x -> SnapName
forall x. SnapName -> Rep SnapName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SnapName x -> SnapName
$cfrom :: forall x. SnapName -> Rep SnapName x
Generic)

instance NFData SnapName

instance Display SnapName where
  display :: SnapName -> Utf8Builder
display (LTS Int
x Int
y) = Utf8Builder
"lts-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
x Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"." Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
y
  display (Nightly Day
date) = Utf8Builder
"nightly-" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Day -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Day
date

instance Show SnapName where
  show :: SnapName -> String
show = Text -> String
T.unpack (Text -> String) -> (SnapName -> Text) -> SnapName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (SnapName -> Utf8Builder) -> SnapName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapName -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display

instance ToJSON SnapName where
  toJSON :: SnapName -> Value
toJSON SnapName
syn = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> Utf8Builder -> Text
forall a b. (a -> b) -> a -> b
$ SnapName -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SnapName
syn

-- | Parse the short representation of a 'SnapName'.
--
-- @since 0.5.0.0
parseSnapName :: MonadThrow m => Text -> m SnapName
parseSnapName :: Text -> m SnapName
parseSnapName Text
t0 =
    case Maybe SnapName
lts Maybe SnapName -> Maybe SnapName -> Maybe SnapName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SnapName
nightly of
        Maybe SnapName
Nothing -> PantryException -> m SnapName
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PantryException -> m SnapName) -> PantryException -> m SnapName
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
ParseSnapNameException Text
t0
        Just SnapName
sn -> SnapName -> m SnapName
forall (m :: * -> *) a. Monad m => a -> m a
return SnapName
sn
  where
    lts :: Maybe SnapName
lts = do
        Text
t1 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"lts-" Text
t0
        Right (Int
x, Text
t2) <- Either String (Int, Text) -> Maybe (Either String (Int, Text))
forall a. a -> Maybe a
Just (Either String (Int, Text) -> Maybe (Either String (Int, Text)))
-> Either String (Int, Text) -> Maybe (Either String (Int, Text))
forall a b. (a -> b) -> a -> b
$ Reader Int
forall a. Integral a => Reader a
decimal Text
t1
        Text
t3 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"." Text
t2
        Right (Int
y, Text
"") <- Either String (Int, Text) -> Maybe (Either String (Int, Text))
forall a. a -> Maybe a
Just (Either String (Int, Text) -> Maybe (Either String (Int, Text)))
-> Either String (Int, Text) -> Maybe (Either String (Int, Text))
forall a b. (a -> b) -> a -> b
$ Reader Int
forall a. Integral a => Reader a
decimal Text
t3
        SnapName -> Maybe SnapName
forall (m :: * -> *) a. Monad m => a -> m a
return (SnapName -> Maybe SnapName) -> SnapName -> Maybe SnapName
forall a b. (a -> b) -> a -> b
$ Int -> Int -> SnapName
LTS Int
x Int
y
    nightly :: Maybe SnapName
nightly = do
        Text
t1 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"nightly-" Text
t0
        Day -> SnapName
Nightly (Day -> SnapName) -> Maybe Day -> Maybe SnapName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Day
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t1)

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

instance NFData RawSnapshotLocation

instance Display RawSnapshotLocation where
  display :: RawSnapshotLocation -> Utf8Builder
display (RSLCompiler WantedCompiler
compiler) = WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display WantedCompiler
compiler
  display (RSLUrl Text
url Maybe BlobKey
Nothing) = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url
  display (RSLUrl Text
url (Just BlobKey
blob)) = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
url Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" (" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> BlobKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display BlobKey
blob Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
")"
  display (RSLFilePath ResolvedPath File
resolved) = RelFilePath -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved)
  display (RSLSynonym SnapName
syn) = SnapName -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SnapName
syn


instance ToJSON RawSnapshotLocation where
  toJSON :: RawSnapshotLocation -> Value
toJSON (RSLCompiler WantedCompiler
compiler) = [(Text, Value)] -> Value
object [Text
"compiler" Text -> WantedCompiler -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WantedCompiler
compiler]
  toJSON (RSLUrl Text
url Maybe BlobKey
mblob) = [(Text, Value)] -> Value
object
    ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ Text
"url" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
url
    (Text, Value) -> [(Text, Value)] -> [(Text, Value)]
forall a. a -> [a] -> [a]
: [(Text, Value)]
-> (BlobKey -> [(Text, Value)]) -> Maybe BlobKey -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] BlobKey -> [(Text, Value)]
blobKeyPairs Maybe BlobKey
mblob
  toJSON (RSLFilePath ResolvedPath File
resolved) = [(Text, Value)] -> Value
object [Text
"filepath" Text -> RelFilePath -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ResolvedPath File -> RelFilePath
forall t. ResolvedPath t -> RelFilePath
resolvedRelative ResolvedPath File
resolved]
  toJSON (RSLSynonym SnapName
syn) = SnapName -> Value
forall a. ToJSON a => a -> Value
toJSON SnapName
syn

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

instance ToJSON SnapshotLocation where
  toJSON :: SnapshotLocation -> Value
toJSON SnapshotLocation
sl = RawSnapshotLocation -> Value
forall a. ToJSON a => a -> Value
toJSON (SnapshotLocation -> RawSnapshotLocation
toRawSL SnapshotLocation
sl)

instance FromJSON (WithJSONWarnings (Unresolved SnapshotLocation)) where
    parseJSON :: Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
parseJSON Value
v = Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
file Value
v Parser (WithJSONWarnings (Unresolved SnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
url Value
v Parser (WithJSONWarnings (Unresolved SnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
compiler Value
v
      where
        file :: Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
file = String
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"SLFilepath" ((Object -> WarningParser (Unresolved SnapshotLocation))
 -> Value
 -> Parser (WithJSONWarnings (Unresolved SnapshotLocation)))
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
           Text
ufp <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"filepath"
           Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved SnapshotLocation
 -> WarningParser (Unresolved SnapshotLocation))
-> Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation)
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO SnapshotLocation)
 -> Unresolved SnapshotLocation)
-> (Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir ->
             case Maybe (Path Abs Dir)
mdir of
               Maybe (Path Abs Dir)
Nothing -> PantryException -> IO SnapshotLocation
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PantryException -> IO SnapshotLocation)
-> PantryException -> IO SnapshotLocation
forall a b. (a -> b) -> a -> b
$ Text -> PantryException
InvalidFilePathSnapshot Text
ufp
               Just Path Abs Dir
dir -> do
                 Path Abs File
absolute <- Path Abs Dir -> String -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs File)
resolveFile Path Abs Dir
dir (Text -> String
T.unpack Text
ufp)
                 let fp :: ResolvedPath File
fp = RelFilePath -> Path Abs File -> ResolvedPath File
forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath Text
ufp) Path Abs File
absolute
                 SnapshotLocation -> IO SnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapshotLocation -> IO SnapshotLocation)
-> SnapshotLocation -> IO SnapshotLocation
forall a b. (a -> b) -> a -> b
$ ResolvedPath File -> SnapshotLocation
SLFilePath ResolvedPath File
fp
        url :: Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
url = String
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"SLUrl" ((Object -> WarningParser (Unresolved SnapshotLocation))
 -> Value
 -> Parser (WithJSONWarnings (Unresolved SnapshotLocation)))
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
          Text
url' <- Object
o Object -> Text -> WarningParser Text
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"url"
          SHA256
sha <- Object
o Object -> Text -> WarningParser SHA256
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"sha256"
          FileSize
size <- Object
o Object -> Text -> WarningParser FileSize
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"size"
          Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved SnapshotLocation
 -> WarningParser (Unresolved SnapshotLocation))
-> Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation)
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO SnapshotLocation)
 -> Unresolved SnapshotLocation)
-> (Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
_ -> SnapshotLocation -> IO SnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapshotLocation -> IO SnapshotLocation)
-> SnapshotLocation -> IO SnapshotLocation
forall a b. (a -> b) -> a -> b
$ Text -> BlobKey -> SnapshotLocation
SLUrl Text
url' (SHA256 -> FileSize -> BlobKey
BlobKey SHA256
sha FileSize
size)
        compiler :: Value -> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
compiler = String
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"SLCompiler" ((Object -> WarningParser (Unresolved SnapshotLocation))
 -> Value
 -> Parser (WithJSONWarnings (Unresolved SnapshotLocation)))
-> (Object -> WarningParser (Unresolved SnapshotLocation))
-> Value
-> Parser (WithJSONWarnings (Unresolved SnapshotLocation))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
          WantedCompiler
c <- Object
o Object -> Text -> WriterT WarningParserMonoid Parser WantedCompiler
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"compiler"
          Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved SnapshotLocation
 -> WarningParser (Unresolved SnapshotLocation))
-> Unresolved SnapshotLocation
-> WarningParser (Unresolved SnapshotLocation)
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir) -> IO SnapshotLocation)
 -> Unresolved SnapshotLocation)
-> (Maybe (Path Abs Dir) -> IO SnapshotLocation)
-> Unresolved SnapshotLocation
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
_ -> SnapshotLocation -> IO SnapshotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapshotLocation -> IO SnapshotLocation)
-> SnapshotLocation -> IO SnapshotLocation
forall a b. (a -> b) -> a -> b
$ WantedCompiler -> SnapshotLocation
SLCompiler WantedCompiler
c

-- | 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 -> String
(Int -> SnapshotPackage -> ShowS)
-> (SnapshotPackage -> String)
-> ([SnapshotPackage] -> ShowS)
-> Show SnapshotPackage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotPackage] -> ShowS
$cshowList :: [SnapshotPackage] -> ShowS
show :: SnapshotPackage -> String
$cshow :: SnapshotPackage -> String
showsPrec :: Int -> SnapshotPackage -> ShowS
$cshowsPrec :: Int -> SnapshotPackage -> ShowS
Show

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

instance NFData RawSnapshotLayer

instance ToJSON RawSnapshotLayer where
  toJSON :: RawSnapshotLayer -> Value
toJSON RawSnapshotLayer
rsnap = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Text
"resolver" Text -> RawSnapshotLocation -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RawSnapshotLayer -> RawSnapshotLocation
rslParent RawSnapshotLayer
rsnap]
    , [(Text, Value)]
-> (WantedCompiler -> [(Text, Value)])
-> Maybe WantedCompiler
-> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\WantedCompiler
compiler -> [Text
"compiler" Text -> WantedCompiler -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WantedCompiler
compiler]) (RawSnapshotLayer -> Maybe WantedCompiler
rslCompiler RawSnapshotLayer
rsnap)
    , [Text
"packages" Text -> [RawPackageLocationImmutable] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RawSnapshotLayer -> [RawPackageLocationImmutable]
rslLocations RawSnapshotLayer
rsnap]
    , if Set PackageName -> Bool
forall a. Set a -> Bool
Set.null (RawSnapshotLayer -> Set PackageName
rslDropPackages RawSnapshotLayer
rsnap)
        then []
        else [Text
"drop-packages" Text -> Set (CabalString PackageName) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PackageName -> CabalString PackageName)
-> Set PackageName -> Set (CabalString PackageName)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString (RawSnapshotLayer -> Set PackageName
rslDropPackages RawSnapshotLayer
rsnap)]
    , if Map PackageName (Map FlagName Bool) -> Bool
forall k a. Map k a -> Bool
Map.null (RawSnapshotLayer -> Map PackageName (Map FlagName Bool)
rslFlags RawSnapshotLayer
rsnap)
        then []
        else [Text
"flags" Text
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Map FlagName Bool -> Map (CabalString FlagName) Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map FlagName Bool -> Map (CabalString FlagName) Bool
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (Map PackageName (Map FlagName Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (RawSnapshotLayer -> Map PackageName (Map FlagName Bool)
rslFlags RawSnapshotLayer
rsnap))]
    , if Map PackageName Bool -> Bool
forall k a. Map k a -> Bool
Map.null (RawSnapshotLayer -> Map PackageName Bool
rslHidden RawSnapshotLayer
rsnap)
        then []
        else [Text
"hidden" Text -> Map (CabalString PackageName) Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Map PackageName Bool -> Map (CabalString PackageName) Bool
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (RawSnapshotLayer -> Map PackageName Bool
rslHidden RawSnapshotLayer
rsnap)]
    , if Map PackageName [Text] -> Bool
forall k a. Map k a -> Bool
Map.null (RawSnapshotLayer -> Map PackageName [Text]
rslGhcOptions RawSnapshotLayer
rsnap)
        then []
        else [Text
"ghc-options" Text -> Map (CabalString PackageName) [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Map PackageName [Text] -> Map (CabalString PackageName) [Text]
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (RawSnapshotLayer -> Map PackageName [Text]
rslGhcOptions RawSnapshotLayer
rsnap)]
    , [(Text, Value)]
-> (UTCTime -> [(Text, Value)]) -> Maybe UTCTime -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\UTCTime
time -> [Text
"publish-time" Text -> UTCTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UTCTime
time]) (RawSnapshotLayer -> Maybe UTCTime
rslPublishTime RawSnapshotLayer
rsnap)
    ]

instance FromJSON (WithJSONWarnings (Unresolved RawSnapshotLayer)) where
  parseJSON :: Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
parseJSON = String
-> (Object -> WarningParser (Unresolved RawSnapshotLayer))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"Snapshot" ((Object -> WarningParser (Unresolved RawSnapshotLayer))
 -> Value
 -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer)))
-> (Object -> WarningParser (Unresolved RawSnapshotLayer))
-> Value
-> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe Text
_ :: Maybe Text <- Object
o Object -> Text -> WarningParser (Maybe Text)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"name" -- 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)
mresolver <- WarningParser
  (Maybe (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> WarningParser (Maybe (Unresolved RawSnapshotLocation))
forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT (WarningParser
   (Maybe (WithJSONWarnings (Unresolved RawSnapshotLocation)))
 -> WarningParser (Maybe (Unresolved RawSnapshotLocation)))
-> WarningParser
     (Maybe (WithJSONWarnings (Unresolved RawSnapshotLocation)))
-> WarningParser (Maybe (Unresolved RawSnapshotLocation))
forall a b. (a -> b) -> a -> b
$ Object
o Object
-> [Text]
-> WarningParser
     (Maybe (WithJSONWarnings (Unresolved RawSnapshotLocation)))
forall a. FromJSON a => Object -> [Text] -> WarningParser (Maybe a)
...:? [Text
"snapshot", Text
"resolver"]
    Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
unresolvedSnapshotParent <-
      case (Maybe WantedCompiler
mcompiler, Maybe (Unresolved RawSnapshotLocation)
mresolver) of
        (Maybe WantedCompiler
Nothing, Maybe (Unresolved RawSnapshotLocation)
Nothing) -> String
-> WriterT
     WarningParserMonoid
     Parser
     (Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Snapshot must have either resolver or compiler"
        (Just WantedCompiler
compiler, Maybe (Unresolved RawSnapshotLocation)
Nothing) -> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> WriterT
     WarningParserMonoid
     Parser
     (Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
 -> WriterT
      WarningParserMonoid
      Parser
      (Unresolved (RawSnapshotLocation, Maybe WantedCompiler)))
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> WriterT
     WarningParserMonoid
     Parser
     (Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
forall a b. (a -> b) -> a -> b
$ (RawSnapshotLocation, Maybe WantedCompiler)
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WantedCompiler -> RawSnapshotLocation
RSLCompiler WantedCompiler
compiler, Maybe WantedCompiler
forall a. Maybe a
Nothing)
        (Maybe WantedCompiler
_, Just (Unresolved Maybe (Path Abs Dir) -> IO RawSnapshotLocation
usl)) -> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> WriterT
     WarningParserMonoid
     Parser
     (Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
 -> WriterT
      WarningParserMonoid
      Parser
      (Unresolved (RawSnapshotLocation, Maybe WantedCompiler)))
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> WriterT
     WarningParserMonoid
     Parser
     (Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
forall a b. (a -> b) -> a -> b
$ (Maybe (Path Abs Dir)
 -> IO (RawSnapshotLocation, Maybe WantedCompiler))
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
forall a. (Maybe (Path Abs Dir) -> IO a) -> Unresolved a
Unresolved ((Maybe (Path Abs Dir)
  -> IO (RawSnapshotLocation, Maybe WantedCompiler))
 -> Unresolved (RawSnapshotLocation, Maybe WantedCompiler))
-> (Maybe (Path Abs Dir)
    -> IO (RawSnapshotLocation, Maybe WantedCompiler))
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
forall a b. (a -> b) -> a -> b
$ \Maybe (Path Abs Dir)
mdir -> do
          RawSnapshotLocation
sl <- Maybe (Path Abs Dir) -> IO RawSnapshotLocation
usl Maybe (Path Abs Dir)
mdir
          case (RawSnapshotLocation
sl, Maybe WantedCompiler
mcompiler) of
            (RSLCompiler WantedCompiler
c1, Just WantedCompiler
c2) -> PantryException -> IO (RawSnapshotLocation, Maybe WantedCompiler)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PantryException -> IO (RawSnapshotLocation, Maybe WantedCompiler))
-> PantryException
-> IO (RawSnapshotLocation, Maybe WantedCompiler)
forall a b. (a -> b) -> a -> b
$ WantedCompiler -> WantedCompiler -> PantryException
InvalidOverrideCompiler WantedCompiler
c1 WantedCompiler
c2
            (RawSnapshotLocation, Maybe WantedCompiler)
_ -> (RawSnapshotLocation, Maybe WantedCompiler)
-> IO (RawSnapshotLocation, Maybe WantedCompiler)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSnapshotLocation
sl, Maybe WantedCompiler
mcompiler)

    [Unresolved (NonEmpty RawPackageLocationImmutable)]
unresolvedLocs <- WarningParser
  [WithJSONWarnings
     (Unresolved (NonEmpty RawPackageLocationImmutable))]
-> WarningParser
     [Unresolved (NonEmpty RawPackageLocationImmutable)]
forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT (Object
o Object
-> Text
-> WarningParser
     (Maybe
        [WithJSONWarnings
           (Unresolved (NonEmpty RawPackageLocationImmutable))])
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"packages" WarningParser
  (Maybe
     [WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable))])
-> [WithJSONWarnings
      (Unresolved (NonEmpty RawPackageLocationImmutable))]
-> WarningParser
     [WithJSONWarnings
        (Unresolved (NonEmpty RawPackageLocationImmutable))]
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= [])
    Set PackageName
rslDropPackages <- (CabalString PackageName -> PackageName)
-> Set (CabalString PackageName) -> Set PackageName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map CabalString PackageName -> PackageName
forall a. CabalString a -> a
unCabalString (Set (CabalString PackageName) -> Set PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
-> WriterT WarningParserMonoid Parser (Set PackageName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Text -> WarningParser (Maybe (Set (CabalString PackageName)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"drop-packages" WarningParser (Maybe (Set (CabalString PackageName)))
-> Set (CabalString PackageName)
-> WriterT
     WarningParserMonoid Parser (Set (CabalString PackageName))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Set (CabalString PackageName)
forall a. Set a
Set.empty)
    Map PackageName (Map FlagName Bool)
rslFlags <- (Map (CabalString PackageName) (Map FlagName Bool)
-> Map PackageName (Map FlagName Bool)
forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap (Map (CabalString PackageName) (Map FlagName Bool)
 -> Map PackageName (Map FlagName Bool))
-> (Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
    -> Map (CabalString PackageName) (Map FlagName Bool))
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> Map PackageName (Map FlagName Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (CabalString FlagName) Bool -> Map FlagName Bool)
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map (CabalString FlagName) Bool -> Map FlagName Bool
forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap) (Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
 -> Map PackageName (Map FlagName Bool))
-> WriterT
     WarningParserMonoid
     Parser
     (Map (CabalString PackageName) (Map (CabalString FlagName) Bool))
-> WriterT
     WarningParserMonoid Parser (Map PackageName (Map FlagName Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Text
-> WarningParser
     (Maybe
        (Map (CabalString PackageName) (Map (CabalString FlagName) Bool)))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"flags" WarningParser
  (Maybe
     (Map (CabalString PackageName) (Map (CabalString FlagName) Bool)))
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> WriterT
     WarningParserMonoid
     Parser
     (Map (CabalString PackageName) (Map (CabalString FlagName) Bool))
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
forall k a. Map k a
Map.empty)
    Map PackageName Bool
rslHidden <- Map (CabalString PackageName) Bool -> Map PackageName Bool
forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap (Map (CabalString PackageName) Bool -> Map PackageName Bool)
-> WriterT
     WarningParserMonoid Parser (Map (CabalString PackageName) Bool)
-> WriterT WarningParserMonoid Parser (Map PackageName Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Text
-> WarningParser (Maybe (Map (CabalString PackageName) Bool))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"hidden" WarningParser (Maybe (Map (CabalString PackageName) Bool))
-> Map (CabalString PackageName) Bool
-> WriterT
     WarningParserMonoid Parser (Map (CabalString PackageName) Bool)
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map (CabalString PackageName) Bool
forall k a. Map k a
Map.empty)
    Map PackageName [Text]
rslGhcOptions <- Map (CabalString PackageName) [Text] -> Map PackageName [Text]
forall a v. Map (CabalString a) v -> Map a v
unCabalStringMap (Map (CabalString PackageName) [Text] -> Map PackageName [Text])
-> WriterT
     WarningParserMonoid Parser (Map (CabalString PackageName) [Text])
-> WriterT WarningParserMonoid Parser (Map PackageName [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object
-> Text
-> WarningParser (Maybe (Map (CabalString PackageName) [Text]))
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"ghc-options" WarningParser (Maybe (Map (CabalString PackageName) [Text]))
-> Map (CabalString PackageName) [Text]
-> WriterT
     WarningParserMonoid Parser (Map (CabalString PackageName) [Text])
forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= Map (CabalString PackageName) [Text]
forall k a. Map k a
Map.empty)
    Maybe UTCTime
rslPublishTime <- Object
o Object -> Text -> WarningParser (Maybe UTCTime)
forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"publish-time"
    Unresolved RawSnapshotLayer
-> WarningParser (Unresolved RawSnapshotLayer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unresolved RawSnapshotLayer
 -> WarningParser (Unresolved RawSnapshotLayer))
-> Unresolved RawSnapshotLayer
-> WarningParser (Unresolved RawSnapshotLayer)
forall a b. (a -> b) -> a -> b
$ (\[RawPackageLocationImmutable]
rslLocations (RawSnapshotLocation
rslParent, Maybe WantedCompiler
rslCompiler) -> RawSnapshotLayer :: RawSnapshotLocation
-> Maybe WantedCompiler
-> [RawPackageLocationImmutable]
-> Set PackageName
-> Map PackageName (Map FlagName Bool)
-> Map PackageName Bool
-> Map PackageName [Text]
-> Maybe UTCTime
-> RawSnapshotLayer
RawSnapshotLayer {[RawPackageLocationImmutable]
Maybe UTCTime
Maybe WantedCompiler
Set PackageName
Map PackageName Bool
Map PackageName [Text]
Map PackageName (Map FlagName Bool)
RawSnapshotLocation
rslCompiler :: Maybe WantedCompiler
rslParent :: RawSnapshotLocation
rslLocations :: [RawPackageLocationImmutable]
rslPublishTime :: Maybe UTCTime
rslGhcOptions :: Map PackageName [Text]
rslHidden :: Map PackageName Bool
rslFlags :: Map PackageName (Map FlagName Bool)
rslDropPackages :: Set PackageName
rslPublishTime :: Maybe UTCTime
rslGhcOptions :: Map PackageName [Text]
rslHidden :: Map PackageName Bool
rslFlags :: Map PackageName (Map FlagName Bool)
rslDropPackages :: Set PackageName
rslLocations :: [RawPackageLocationImmutable]
rslCompiler :: Maybe WantedCompiler
rslParent :: RawSnapshotLocation
..})
      ([RawPackageLocationImmutable]
 -> (RawSnapshotLocation, Maybe WantedCompiler) -> RawSnapshotLayer)
-> Unresolved [RawPackageLocationImmutable]
-> Unresolved
     ((RawSnapshotLocation, Maybe WantedCompiler) -> RawSnapshotLayer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([[RawPackageLocationImmutable]] -> [RawPackageLocationImmutable]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[RawPackageLocationImmutable]] -> [RawPackageLocationImmutable])
-> ([NonEmpty RawPackageLocationImmutable]
    -> [[RawPackageLocationImmutable]])
-> [NonEmpty RawPackageLocationImmutable]
-> [RawPackageLocationImmutable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty RawPackageLocationImmutable
 -> [RawPackageLocationImmutable])
-> [NonEmpty RawPackageLocationImmutable]
-> [[RawPackageLocationImmutable]]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty RawPackageLocationImmutable
-> [RawPackageLocationImmutable]
forall a. NonEmpty a -> [a]
NE.toList) ([NonEmpty RawPackageLocationImmutable]
 -> [RawPackageLocationImmutable])
-> Unresolved [NonEmpty RawPackageLocationImmutable]
-> Unresolved [RawPackageLocationImmutable]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Unresolved (NonEmpty RawPackageLocationImmutable)]
-> Unresolved [NonEmpty RawPackageLocationImmutable]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Unresolved (NonEmpty RawPackageLocationImmutable)]
unresolvedLocs)
      Unresolved
  ((RawSnapshotLocation, Maybe WantedCompiler) -> RawSnapshotLayer)
-> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
-> Unresolved RawSnapshotLayer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Unresolved (RawSnapshotLocation, Maybe WantedCompiler)
unresolvedSnapshotParent

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

instance ToJSON SnapshotLayer where
  toJSON :: SnapshotLayer -> Value
toJSON SnapshotLayer
snap = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Text
"resolver" Text -> SnapshotLocation -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SnapshotLayer -> SnapshotLocation
slParent SnapshotLayer
snap]
    , [(Text, Value)]
-> (WantedCompiler -> [(Text, Value)])
-> Maybe WantedCompiler
-> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\WantedCompiler
compiler -> [Text
"compiler" Text -> WantedCompiler -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WantedCompiler
compiler]) (SnapshotLayer -> Maybe WantedCompiler
slCompiler SnapshotLayer
snap)
    , [Text
"packages" Text -> [PackageLocationImmutable] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SnapshotLayer -> [PackageLocationImmutable]
slLocations SnapshotLayer
snap]
    , if Set PackageName -> Bool
forall a. Set a -> Bool
Set.null (SnapshotLayer -> Set PackageName
slDropPackages SnapshotLayer
snap) then [] else [Text
"drop-packages" Text -> Set (CabalString PackageName) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PackageName -> CabalString PackageName)
-> Set PackageName -> Set (CabalString PackageName)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString (SnapshotLayer -> Set PackageName
slDropPackages SnapshotLayer
snap)]
    , if Map PackageName (Map FlagName Bool) -> Bool
forall k a. Map k a -> Bool
Map.null (SnapshotLayer -> Map PackageName (Map FlagName Bool)
slFlags SnapshotLayer
snap) then [] else [Text
"flags" Text
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Map FlagName Bool -> Map (CabalString FlagName) Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map FlagName Bool -> Map (CabalString FlagName) Bool
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (Map PackageName (Map FlagName Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (SnapshotLayer -> Map PackageName (Map FlagName Bool)
slFlags SnapshotLayer
snap))]
    , if Map PackageName Bool -> Bool
forall k a. Map k a -> Bool
Map.null (SnapshotLayer -> Map PackageName Bool
slHidden SnapshotLayer
snap) then [] else [Text
"hidden" Text -> Map (CabalString PackageName) Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Map PackageName Bool -> Map (CabalString PackageName) Bool
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (SnapshotLayer -> Map PackageName Bool
slHidden SnapshotLayer
snap)]
    , if Map PackageName [Text] -> Bool
forall k a. Map k a -> Bool
Map.null (SnapshotLayer -> Map PackageName [Text]
slGhcOptions SnapshotLayer
snap) then [] else [Text
"ghc-options" Text -> Map (CabalString PackageName) [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Map PackageName [Text] -> Map (CabalString PackageName) [Text]
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (SnapshotLayer -> Map PackageName [Text]
slGhcOptions SnapshotLayer
snap)]
    , [(Text, Value)]
-> (UTCTime -> [(Text, Value)]) -> Maybe UTCTime -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\UTCTime
time -> [Text
"publish-time" Text -> UTCTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UTCTime
time]) (SnapshotLayer -> Maybe UTCTime
slPublishTime SnapshotLayer
snap)
    ]

-- | Convert snapshot layer into its "raw" equivalent.
--
-- @since 0.1.0.0
toRawSnapshotLayer :: SnapshotLayer -> RawSnapshotLayer
toRawSnapshotLayer :: SnapshotLayer -> RawSnapshotLayer
toRawSnapshotLayer SnapshotLayer
sl = RawSnapshotLayer :: RawSnapshotLocation
-> Maybe WantedCompiler
-> [RawPackageLocationImmutable]
-> Set PackageName
-> Map PackageName (Map FlagName Bool)
-> Map PackageName Bool
-> Map PackageName [Text]
-> Maybe UTCTime
-> RawSnapshotLayer
RawSnapshotLayer
  { rslParent :: RawSnapshotLocation
rslParent = SnapshotLocation -> RawSnapshotLocation
toRawSL (SnapshotLayer -> SnapshotLocation
slParent SnapshotLayer
sl)
  , rslCompiler :: Maybe WantedCompiler
rslCompiler = SnapshotLayer -> Maybe WantedCompiler
slCompiler SnapshotLayer
sl
  , rslLocations :: [RawPackageLocationImmutable]
rslLocations = (PackageLocationImmutable -> RawPackageLocationImmutable)
-> [PackageLocationImmutable] -> [RawPackageLocationImmutable]
forall a b. (a -> b) -> [a] -> [b]
map PackageLocationImmutable -> RawPackageLocationImmutable
toRawPLI (SnapshotLayer -> [PackageLocationImmutable]
slLocations SnapshotLayer
sl)
  , rslDropPackages :: Set PackageName
rslDropPackages = SnapshotLayer -> Set PackageName
slDropPackages SnapshotLayer
sl
  , rslFlags :: Map PackageName (Map FlagName Bool)
rslFlags = SnapshotLayer -> Map PackageName (Map FlagName Bool)
slFlags SnapshotLayer
sl
  , rslHidden :: Map PackageName Bool
rslHidden = SnapshotLayer -> Map PackageName Bool
slHidden SnapshotLayer
sl
  , rslGhcOptions :: Map PackageName [Text]
rslGhcOptions = SnapshotLayer -> Map PackageName [Text]
slGhcOptions SnapshotLayer
sl
  , rslPublishTime :: Maybe UTCTime
rslPublishTime = SnapshotLayer -> Maybe UTCTime
slPublishTime SnapshotLayer
sl
  }

-- | 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 -> String
(Int -> SnapshotCacheHash -> ShowS)
-> (SnapshotCacheHash -> String)
-> ([SnapshotCacheHash] -> ShowS)
-> Show SnapshotCacheHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotCacheHash] -> ShowS
$cshowList :: [SnapshotCacheHash] -> ShowS
show :: SnapshotCacheHash -> String
$cshow :: SnapshotCacheHash -> String
showsPrec :: Int -> SnapshotCacheHash -> ShowS
$cshowsPrec :: Int -> SnapshotCacheHash -> ShowS
Show)

-- | Get the path to the global hints cache file
getGlobalHintsFile :: HasPantryConfig env => RIO env (Path Abs File)
getGlobalHintsFile :: RIO env (Path Abs File)
getGlobalHintsFile = do
  Path Abs Dir
root <- Getting (Path Abs Dir) env (Path Abs Dir) -> RIO env (Path Abs Dir)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Path Abs Dir) env (Path Abs Dir)
 -> RIO env (Path Abs Dir))
-> Getting (Path Abs Dir) env (Path Abs Dir)
-> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ (PantryConfig -> Const (Path Abs Dir) PantryConfig)
-> env -> Const (Path Abs Dir) env
forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigL((PantryConfig -> Const (Path Abs Dir) PantryConfig)
 -> env -> Const (Path Abs Dir) env)
-> ((Path Abs Dir -> Const (Path Abs Dir) (Path Abs Dir))
    -> PantryConfig -> Const (Path Abs Dir) PantryConfig)
-> Getting (Path Abs Dir) env (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PantryConfig -> Path Abs Dir)
-> SimpleGetter PantryConfig (Path Abs Dir)
forall s a. (s -> a) -> SimpleGetter s a
to PantryConfig -> Path Abs Dir
pcRootDir
  Path Rel File
globalHintsRelFile <- String -> RIO env (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
"global-hints-cache.yaml"
  Path Abs File -> RIO env (Path Abs File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File -> RIO env (Path Abs File))
-> Path Abs File -> RIO env (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
globalHintsRelFile

-- | 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 :: RawPackageLocationImmutable -> RIO env ()
warnMissingCabalFile RawPackageLocationImmutable
loc =
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$
  Utf8Builder
"DEPRECATED: The package at " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RawPackageLocationImmutable -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RawPackageLocationImmutable
loc Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
  Utf8Builder
" does not include a cabal file.\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
  Utf8Builder
"Instead, it includes an hpack package.yaml file for generating a cabal file.\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
  Utf8Builder
"This usage is deprecated; please see https://github.com/commercialhaskell/stack/issues/5210.\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
  Utf8Builder
"Support for this workflow will be removed in the future.\n"