{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ConstraintKinds #-}
module Stack.Types.Package where

import           Stack.Prelude
import qualified RIO.Text as T
import           Data.Aeson (ToJSON (..), FromJSON (..), (.=), (.:), object, withObject)
import qualified Data.Map as M
import qualified Data.Set as Set
import           Distribution.Parsec (PError (..), PWarning (..), showPos)
import qualified Distribution.SPDX.License as SPDX
import           Distribution.License (License)
import           Distribution.ModuleName (ModuleName)
import           Distribution.PackageDescription (TestSuiteInterface, BuildType)
import           Distribution.System (Platform (..))
import           Stack.Types.Compiler
import           Stack.Types.Config
import           Stack.Types.GhcPkgId
import           Stack.Types.NamedComponent
import           Stack.Types.SourceMap
import           Stack.Types.Version

-- | All exceptions thrown by the library.
data PackageException
  = PackageInvalidCabalFile
      !(Either PackageIdentifierRevision (Path Abs File))
      !(Maybe Version)
      ![PError]
      ![PWarning]
  | MismatchedCabalIdentifier !PackageIdentifierRevision !PackageIdentifier
  deriving Typeable
instance Exception PackageException
instance Show PackageException where
    show :: PackageException -> String
show (PackageInvalidCabalFile Either PackageIdentifierRevision (Path Abs File)
loc Maybe Version
_mversion [PError]
errs [PWarning]
warnings) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Unable to parse cabal file "
        , case Either PackageIdentifierRevision (Path Abs File)
loc of
            Left PackageIdentifierRevision
pir -> String
"for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (Utf8Builder -> Text
utf8BuilderToText (PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir))
            Right Path Abs File
fp -> Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp
        {-

         Not actually needed, the errors will indicate if a newer version exists.
         Also, it seems that this is set to Just the version even if we support it.

        , case mversion of
            Nothing -> ""
            Just version -> "\nRequires newer Cabal file parser version: " ++
                            versionString version
        -}
        , String
"\n\n"
        , [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (PError -> String) -> [PError] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
            (\(PError Position
pos String
msg) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ String
"- "
                , Position -> String
showPos Position
pos
                , String
": "
                , String
msg
                ])
            [PError]
errs
        , [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (PWarning -> String) -> [PWarning] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
            (\(PWarning PWarnType
_ Position
pos String
msg) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ String
"- "
                , Position -> String
showPos Position
pos
                , String
": "
                , String
msg
                ])
            [PWarning]
warnings
        ]
    show (MismatchedCabalIdentifier PackageIdentifierRevision
pir PackageIdentifier
ident) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Mismatched package identifier."
        , String
"\nFound:    "
        , PackageIdentifier -> String
packageIdentifierString PackageIdentifier
ident
        , String
"\nExpected: "
        , Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> Utf8Builder -> Text
forall a b. (a -> b) -> a -> b
$ PackageIdentifierRevision -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir
        ]

-- | Libraries in a package. Since Cabal 2.0, internal libraries are a
-- thing.
data PackageLibraries
  = NoLibraries
  | HasLibraries !(Set Text) -- ^ the foreign library names, sub libraries get built automatically without explicit component name passing
 deriving (Int -> PackageLibraries -> ShowS
[PackageLibraries] -> ShowS
PackageLibraries -> String
(Int -> PackageLibraries -> ShowS)
-> (PackageLibraries -> String)
-> ([PackageLibraries] -> ShowS)
-> Show PackageLibraries
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageLibraries] -> ShowS
$cshowList :: [PackageLibraries] -> ShowS
show :: PackageLibraries -> String
$cshow :: PackageLibraries -> String
showsPrec :: Int -> PackageLibraries -> ShowS
$cshowsPrec :: Int -> PackageLibraries -> ShowS
Show,Typeable)

-- | Name of an executable.
newtype ExeName = ExeName { ExeName -> Text
unExeName :: Text }
    deriving (Int -> ExeName -> ShowS
[ExeName] -> ShowS
ExeName -> String
(Int -> ExeName -> ShowS)
-> (ExeName -> String) -> ([ExeName] -> ShowS) -> Show ExeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExeName] -> ShowS
$cshowList :: [ExeName] -> ShowS
show :: ExeName -> String
$cshow :: ExeName -> String
showsPrec :: Int -> ExeName -> ShowS
$cshowsPrec :: Int -> ExeName -> ShowS
Show, ExeName -> ExeName -> Bool
(ExeName -> ExeName -> Bool)
-> (ExeName -> ExeName -> Bool) -> Eq ExeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExeName -> ExeName -> Bool
$c/= :: ExeName -> ExeName -> Bool
== :: ExeName -> ExeName -> Bool
$c== :: ExeName -> ExeName -> Bool
Eq, Eq ExeName
Eq ExeName
-> (ExeName -> ExeName -> Ordering)
-> (ExeName -> ExeName -> Bool)
-> (ExeName -> ExeName -> Bool)
-> (ExeName -> ExeName -> Bool)
-> (ExeName -> ExeName -> Bool)
-> (ExeName -> ExeName -> ExeName)
-> (ExeName -> ExeName -> ExeName)
-> Ord ExeName
ExeName -> ExeName -> Bool
ExeName -> ExeName -> Ordering
ExeName -> ExeName -> ExeName
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 :: ExeName -> ExeName -> ExeName
$cmin :: ExeName -> ExeName -> ExeName
max :: ExeName -> ExeName -> ExeName
$cmax :: ExeName -> ExeName -> ExeName
>= :: ExeName -> ExeName -> Bool
$c>= :: ExeName -> ExeName -> Bool
> :: ExeName -> ExeName -> Bool
$c> :: ExeName -> ExeName -> Bool
<= :: ExeName -> ExeName -> Bool
$c<= :: ExeName -> ExeName -> Bool
< :: ExeName -> ExeName -> Bool
$c< :: ExeName -> ExeName -> Bool
compare :: ExeName -> ExeName -> Ordering
$ccompare :: ExeName -> ExeName -> Ordering
$cp1Ord :: Eq ExeName
Ord, Int -> ExeName -> Int
ExeName -> Int
(Int -> ExeName -> Int) -> (ExeName -> Int) -> Hashable ExeName
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ExeName -> Int
$chash :: ExeName -> Int
hashWithSalt :: Int -> ExeName -> Int
$chashWithSalt :: Int -> ExeName -> Int
Hashable, String -> ExeName
(String -> ExeName) -> IsString ExeName
forall a. (String -> a) -> IsString a
fromString :: String -> ExeName
$cfromString :: String -> ExeName
IsString, (forall x. ExeName -> Rep ExeName x)
-> (forall x. Rep ExeName x -> ExeName) -> Generic ExeName
forall x. Rep ExeName x -> ExeName
forall x. ExeName -> Rep ExeName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExeName x -> ExeName
$cfrom :: forall x. ExeName -> Rep ExeName x
Generic, ExeName -> ()
(ExeName -> ()) -> NFData ExeName
forall a. (a -> ()) -> NFData a
rnf :: ExeName -> ()
$crnf :: ExeName -> ()
NFData, Typeable ExeName
DataType
Constr
Typeable ExeName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ExeName -> c ExeName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ExeName)
-> (ExeName -> Constr)
-> (ExeName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ExeName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExeName))
-> ((forall b. Data b => b -> b) -> ExeName -> ExeName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ExeName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ExeName -> r)
-> (forall u. (forall d. Data d => d -> u) -> ExeName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ExeName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ExeName -> m ExeName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ExeName -> m ExeName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ExeName -> m ExeName)
-> Data ExeName
ExeName -> DataType
ExeName -> Constr
(forall b. Data b => b -> b) -> ExeName -> ExeName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExeName -> c ExeName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExeName
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) -> ExeName -> u
forall u. (forall d. Data d => d -> u) -> ExeName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExeName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExeName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExeName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExeName -> c ExeName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExeName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExeName)
$cExeName :: Constr
$tExeName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ExeName -> m ExeName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
gmapMp :: (forall d. Data d => d -> m d) -> ExeName -> m ExeName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
gmapM :: (forall d. Data d => d -> m d) -> ExeName -> m ExeName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
gmapQi :: Int -> (forall d. Data d => d -> u) -> ExeName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExeName -> u
gmapQ :: (forall d. Data d => d -> u) -> ExeName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ExeName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExeName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExeName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExeName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExeName -> r
gmapT :: (forall b. Data b => b -> b) -> ExeName -> ExeName
$cgmapT :: (forall b. Data b => b -> b) -> ExeName -> ExeName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExeName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExeName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ExeName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExeName)
dataTypeOf :: ExeName -> DataType
$cdataTypeOf :: ExeName -> DataType
toConstr :: ExeName -> Constr
$ctoConstr :: ExeName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExeName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExeName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExeName -> c ExeName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExeName -> c ExeName
$cp1Data :: Typeable ExeName
Data, Typeable)

-- | Some package info.
data Package =
  Package {Package -> PackageName
packageName :: !PackageName                    -- ^ Name of the package.
          ,Package -> Version
packageVersion :: !Version                     -- ^ Version of the package
          ,Package -> Either License License
packageLicense :: !(Either SPDX.License License) -- ^ The license the package was released under.
          ,Package -> GetPackageFiles
packageFiles :: !GetPackageFiles               -- ^ Get all files of the package.
          ,Package -> Map PackageName DepValue
packageDeps :: !(Map PackageName DepValue)     -- ^ Packages that the package depends on, both as libraries and build tools.
          ,Package -> Set ExeName
packageUnknownTools :: !(Set ExeName)          -- ^ Build tools specified in the legacy manner (build-tools:) that failed the hard-coded lookup.
          ,Package -> Set PackageName
packageAllDeps :: !(Set PackageName)           -- ^ Original dependencies (not sieved).
          ,Package -> [Text]
packageGhcOptions :: ![Text]                   -- ^ Ghc options used on package.
          ,Package -> [Text]
packageCabalConfigOpts :: ![Text]              -- ^ Additional options passed to ./Setup.hs configure
          ,Package -> Map FlagName Bool
packageFlags :: !(Map FlagName Bool)           -- ^ Flags used on package.
          ,Package -> Map FlagName Bool
packageDefaultFlags :: !(Map FlagName Bool)    -- ^ Defaults for unspecified flags.
          ,Package -> PackageLibraries
packageLibraries :: !PackageLibraries          -- ^ does the package have a buildable library stanza?
          ,Package -> Set Text
packageInternalLibraries :: !(Set Text)        -- ^ names of internal libraries
          ,Package -> Map Text TestSuiteInterface
packageTests :: !(Map Text TestSuiteInterface) -- ^ names and interfaces of test suites
          ,Package -> Set Text
packageBenchmarks :: !(Set Text)               -- ^ names of benchmarks
          ,Package -> Set Text
packageExes :: !(Set Text)                     -- ^ names of executables
          ,Package -> GetPackageOpts
packageOpts :: !GetPackageOpts                 -- ^ Args to pass to GHC.
          ,Package -> Bool
packageHasExposedModules :: !Bool              -- ^ Does the package have exposed modules?
          ,Package -> BuildType
packageBuildType :: !BuildType                 -- ^ Package build-type.
          ,Package -> Maybe (Map PackageName VersionRange)
packageSetupDeps :: !(Maybe (Map PackageName VersionRange))
                                                          -- ^ If present: custom-setup dependencies
          ,Package -> VersionRange
packageCabalSpec :: !VersionRange              -- ^ Cabal spec range
          }
 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,Typeable)

packageIdent :: Package -> PackageIdentifier
packageIdent :: Package -> PackageIdentifier
packageIdent Package
p = PackageName -> Version -> PackageIdentifier
PackageIdentifier (Package -> PackageName
packageName Package
p) (Package -> Version
packageVersion Package
p)

-- | The value for a map from dependency name. This contains both the
-- version range and the type of dependency, and provides a semigroup
-- instance.
data DepValue = DepValue
  { DepValue -> VersionRange
dvVersionRange :: !VersionRange
  , DepValue -> DepType
dvType :: !DepType
  }
  deriving (Int -> DepValue -> ShowS
[DepValue] -> ShowS
DepValue -> String
(Int -> DepValue -> ShowS)
-> (DepValue -> String) -> ([DepValue] -> ShowS) -> Show DepValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DepValue] -> ShowS
$cshowList :: [DepValue] -> ShowS
show :: DepValue -> String
$cshow :: DepValue -> String
showsPrec :: Int -> DepValue -> ShowS
$cshowsPrec :: Int -> DepValue -> ShowS
Show,Typeable)
instance Semigroup DepValue where
  DepValue VersionRange
a DepType
x <> :: DepValue -> DepValue -> DepValue
<> DepValue VersionRange
b DepType
y = VersionRange -> DepType -> DepValue
DepValue (VersionRange -> VersionRange -> VersionRange
intersectVersionRanges VersionRange
a VersionRange
b) (DepType
x DepType -> DepType -> DepType
forall a. Semigroup a => a -> a -> a
<> DepType
y)

-- | Is this package being used as a library, or just as a build tool?
-- If the former, we need to ensure that a library actually
-- exists. See
-- <https://github.com/commercialhaskell/stack/issues/2195>
data DepType = AsLibrary | AsBuildTool
  deriving (Int -> DepType -> ShowS
[DepType] -> ShowS
DepType -> String
(Int -> DepType -> ShowS)
-> (DepType -> String) -> ([DepType] -> ShowS) -> Show DepType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DepType] -> ShowS
$cshowList :: [DepType] -> ShowS
show :: DepType -> String
$cshow :: DepType -> String
showsPrec :: Int -> DepType -> ShowS
$cshowsPrec :: Int -> DepType -> ShowS
Show, DepType -> DepType -> Bool
(DepType -> DepType -> Bool)
-> (DepType -> DepType -> Bool) -> Eq DepType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DepType -> DepType -> Bool
$c/= :: DepType -> DepType -> Bool
== :: DepType -> DepType -> Bool
$c== :: DepType -> DepType -> Bool
Eq)
instance Semigroup DepType where
  DepType
AsLibrary <> :: DepType -> DepType -> DepType
<> DepType
_ = DepType
AsLibrary
  DepType
AsBuildTool <> DepType
x = DepType
x

packageIdentifier :: Package -> PackageIdentifier
packageIdentifier :: Package -> PackageIdentifier
packageIdentifier Package
pkg =
    PackageName -> Version -> PackageIdentifier
PackageIdentifier (Package -> PackageName
packageName Package
pkg) (Package -> Version
packageVersion Package
pkg)

packageDefinedFlags :: Package -> Set FlagName
packageDefinedFlags :: Package -> Set FlagName
packageDefinedFlags = Map FlagName Bool -> Set FlagName
forall k a. Map k a -> Set k
M.keysSet (Map FlagName Bool -> Set FlagName)
-> (Package -> Map FlagName Bool) -> Package -> Set FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> Map FlagName Bool
packageDefaultFlags

type InstallMap = Map PackageName (InstallLocation, Version)

-- | Files that the package depends on, relative to package directory.
-- Argument is the location of the .cabal file
newtype GetPackageOpts = GetPackageOpts
    { GetPackageOpts
-> forall env.
   HasEnvConfig env =>
   InstallMap
   -> InstalledMap
   -> [PackageName]
   -> [PackageName]
   -> Path Abs File
   -> RIO
        env
        (Map NamedComponent (Map ModuleName (Path Abs File)),
         Map NamedComponent [DotCabalPath],
         Map NamedComponent BuildInfoOpts)
getPackageOpts :: forall env. HasEnvConfig env
                     => InstallMap
                     -> InstalledMap
                     -> [PackageName]
                     -> [PackageName]
                     -> Path Abs File
                     -> RIO env
                          (Map NamedComponent (Map ModuleName (Path Abs File))
                          ,Map NamedComponent [DotCabalPath]
                          ,Map NamedComponent BuildInfoOpts)
    }
instance Show GetPackageOpts where
    show :: GetPackageOpts -> String
show GetPackageOpts
_ = String
"<GetPackageOpts>"

-- | GHC options based on cabal information and ghc-options.
data BuildInfoOpts = BuildInfoOpts
    { BuildInfoOpts -> [String]
bioOpts :: [String]
    , BuildInfoOpts -> [String]
bioOneWordOpts :: [String]
    , BuildInfoOpts -> [String]
bioPackageFlags :: [String]
    -- ^ These options can safely have 'nubOrd' applied to them, as
    -- there are no multi-word options (see
    -- https://github.com/commercialhaskell/stack/issues/1255)
    , BuildInfoOpts -> Path Abs File
bioCabalMacros :: Path Abs File
    } deriving Int -> BuildInfoOpts -> ShowS
[BuildInfoOpts] -> ShowS
BuildInfoOpts -> String
(Int -> BuildInfoOpts -> ShowS)
-> (BuildInfoOpts -> String)
-> ([BuildInfoOpts] -> ShowS)
-> Show BuildInfoOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildInfoOpts] -> ShowS
$cshowList :: [BuildInfoOpts] -> ShowS
show :: BuildInfoOpts -> String
$cshow :: BuildInfoOpts -> String
showsPrec :: Int -> BuildInfoOpts -> ShowS
$cshowsPrec :: Int -> BuildInfoOpts -> ShowS
Show

-- | Files to get for a cabal package.
data CabalFileType
    = AllFiles
    | Modules

-- | Files that the package depends on, relative to package directory.
-- Argument is the location of the .cabal file
newtype GetPackageFiles = GetPackageFiles
    { GetPackageFiles
-> forall env.
   HasEnvConfig env =>
   Path Abs File
   -> RIO
        env
        (Map NamedComponent (Map ModuleName (Path Abs File)),
         Map NamedComponent [DotCabalPath], Set (Path Abs File),
         [PackageWarning])
getPackageFiles :: forall env. HasEnvConfig env
                      => Path Abs File
                      -> RIO env
                           (Map NamedComponent (Map ModuleName (Path Abs File))
                           ,Map NamedComponent [DotCabalPath]
                           ,Set (Path Abs File)
                           ,[PackageWarning])
    }
instance Show GetPackageFiles where
    show :: GetPackageFiles -> String
show GetPackageFiles
_ = String
"<GetPackageFiles>"

-- | Warning generated when reading a package
data PackageWarning
    = UnlistedModulesWarning NamedComponent [ModuleName]
      -- ^ Modules found that are not listed in cabal file

    -- TODO: bring this back - see
    -- https://github.com/commercialhaskell/stack/issues/2649
    {-
    | MissingModulesWarning (Path Abs File) (Maybe String) [ModuleName]
      -- ^ Modules not found in file system, which are listed in cabal file
    -}

-- | Package build configuration
data PackageConfig =
  PackageConfig {PackageConfig -> Bool
packageConfigEnableTests :: !Bool                -- ^ Are tests enabled?
                ,PackageConfig -> Bool
packageConfigEnableBenchmarks :: !Bool           -- ^ Are benchmarks enabled?
                ,PackageConfig -> Map FlagName Bool
packageConfigFlags :: !(Map FlagName Bool)       -- ^ Configured flags.
                ,PackageConfig -> [Text]
packageConfigGhcOptions :: ![Text]               -- ^ Configured ghc options.
                ,PackageConfig -> [Text]
packageConfigCabalConfigOpts :: ![Text]          -- ^ ./Setup.hs configure options
                ,PackageConfig -> ActualCompiler
packageConfigCompilerVersion :: ActualCompiler   -- ^ GHC version
                ,PackageConfig -> Platform
packageConfigPlatform :: !Platform               -- ^ host platform
                }
 deriving (Int -> PackageConfig -> ShowS
[PackageConfig] -> ShowS
PackageConfig -> String
(Int -> PackageConfig -> ShowS)
-> (PackageConfig -> String)
-> ([PackageConfig] -> ShowS)
-> Show PackageConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageConfig] -> ShowS
$cshowList :: [PackageConfig] -> ShowS
show :: PackageConfig -> String
$cshow :: PackageConfig -> String
showsPrec :: Int -> PackageConfig -> ShowS
$cshowsPrec :: Int -> PackageConfig -> ShowS
Show,Typeable)

-- | Compares the package name.
instance Ord Package where
  compare :: Package -> Package -> Ordering
compare = (PackageName -> PackageName -> Ordering)
-> (Package -> PackageName) -> Package -> Package -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on PackageName -> PackageName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Package -> PackageName
packageName

-- | Compares the package name.
instance Eq Package where
  == :: Package -> Package -> Bool
(==) = (PackageName -> PackageName -> Bool)
-> (Package -> PackageName) -> Package -> Package -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
(==) Package -> PackageName
packageName

-- | Where the package's source is located: local directory or package index
data PackageSource
  = PSFilePath LocalPackage
  -- ^ Package which exist on the filesystem
  | PSRemote PackageLocationImmutable Version FromSnapshot CommonPackage
  -- ^ Package which is downloaded remotely.

instance Show PackageSource where
    show :: PackageSource -> String
show (PSFilePath LocalPackage
lp) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"PSFilePath (", LocalPackage -> String
forall a. Show a => a -> String
show LocalPackage
lp, String
")"]
    show (PSRemote PackageLocationImmutable
pli Version
v FromSnapshot
fromSnapshot CommonPackage
_) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"PSRemote"
            , String
"(", PackageLocationImmutable -> String
forall a. Show a => a -> String
show PackageLocationImmutable
pli, String
")"
            , String
"(", Version -> String
forall a. Show a => a -> String
show Version
v, String
")"
            , FromSnapshot -> String
forall a. Show a => a -> String
show FromSnapshot
fromSnapshot
            , String
"<CommonPackage>"
            ]


psVersion :: PackageSource -> Version
psVersion :: PackageSource -> Version
psVersion (PSFilePath LocalPackage
lp) = Package -> Version
packageVersion (Package -> Version) -> Package -> Version
forall a b. (a -> b) -> a -> b
$ LocalPackage -> Package
lpPackage LocalPackage
lp
psVersion (PSRemote PackageLocationImmutable
_ Version
v FromSnapshot
_ CommonPackage
_) = Version
v

-- | Information on a locally available package of source code
data LocalPackage = LocalPackage
    { LocalPackage -> Package
lpPackage       :: !Package
    -- ^ The @Package@ info itself, after resolution with package flags,
    -- with tests and benchmarks disabled
    , LocalPackage -> Set NamedComponent
lpComponents    :: !(Set NamedComponent)
    -- ^ Components to build, not including the library component.
    , LocalPackage -> Set NamedComponent
lpUnbuildable   :: !(Set NamedComponent)
    -- ^ Components explicitly requested for build, that are marked
    -- "buildable: false".
    , LocalPackage -> Bool
lpWanted        :: !Bool -- FIXME Should completely drop this "wanted" terminology, it's unclear
    -- ^ Whether this package is wanted as a target.
    , LocalPackage -> Map PackageName VersionRange
lpTestDeps      :: !(Map PackageName VersionRange)
    -- ^ Used for determining if we can use --enable-tests in a normal build.
    , LocalPackage -> Map PackageName VersionRange
lpBenchDeps     :: !(Map PackageName VersionRange)
    -- ^ Used for determining if we can use --enable-benchmarks in a normal
    -- build.
    , LocalPackage -> Maybe Package
lpTestBench     :: !(Maybe Package)
    -- ^ This stores the 'Package' with tests and benchmarks enabled, if
    -- either is asked for by the user.
    , LocalPackage -> Path Abs File
lpCabalFile     :: !(Path Abs File)
    -- ^ The .cabal file
    , LocalPackage -> Bool
lpBuildHaddocks :: !Bool
    , LocalPackage -> Bool
lpForceDirty    :: !Bool
    , LocalPackage -> MemoizedWith EnvConfig (Maybe (Set String))
lpDirtyFiles    :: !(MemoizedWith EnvConfig (Maybe (Set FilePath)))
    -- ^ Nothing == not dirty, Just == dirty. Note that the Set may be empty if
    -- we forced the build to treat packages as dirty. Also, the Set may not
    -- include all modified files.
    , LocalPackage
-> MemoizedWith
     EnvConfig (Map NamedComponent (Map String FileCacheInfo))
lpNewBuildCaches :: !(MemoizedWith EnvConfig (Map NamedComponent (Map FilePath FileCacheInfo)))
    -- ^ current state of the files
    , LocalPackage
-> MemoizedWith
     EnvConfig (Map NamedComponent (Set (Path Abs File)))
lpComponentFiles :: !(MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File))))
    -- ^ all files used by this package
    }
    deriving Int -> LocalPackage -> ShowS
[LocalPackage] -> ShowS
LocalPackage -> String
(Int -> LocalPackage -> ShowS)
-> (LocalPackage -> String)
-> ([LocalPackage] -> ShowS)
-> Show LocalPackage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalPackage] -> ShowS
$cshowList :: [LocalPackage] -> ShowS
show :: LocalPackage -> String
$cshow :: LocalPackage -> String
showsPrec :: Int -> LocalPackage -> ShowS
$cshowsPrec :: Int -> LocalPackage -> ShowS
Show

newtype MemoizedWith env a = MemoizedWith { MemoizedWith env a -> RIO env a
unMemoizedWith :: RIO env a }
  deriving (a -> MemoizedWith env b -> MemoizedWith env a
(a -> b) -> MemoizedWith env a -> MemoizedWith env b
(forall a b. (a -> b) -> MemoizedWith env a -> MemoizedWith env b)
-> (forall a b. a -> MemoizedWith env b -> MemoizedWith env a)
-> Functor (MemoizedWith env)
forall a b. a -> MemoizedWith env b -> MemoizedWith env a
forall a b. (a -> b) -> MemoizedWith env a -> MemoizedWith env b
forall env a b. a -> MemoizedWith env b -> MemoizedWith env a
forall env a b.
(a -> b) -> MemoizedWith env a -> MemoizedWith env b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MemoizedWith env b -> MemoizedWith env a
$c<$ :: forall env a b. a -> MemoizedWith env b -> MemoizedWith env a
fmap :: (a -> b) -> MemoizedWith env a -> MemoizedWith env b
$cfmap :: forall env a b.
(a -> b) -> MemoizedWith env a -> MemoizedWith env b
Functor, Functor (MemoizedWith env)
a -> MemoizedWith env a
Functor (MemoizedWith env)
-> (forall a. a -> MemoizedWith env a)
-> (forall a b.
    MemoizedWith env (a -> b)
    -> MemoizedWith env a -> MemoizedWith env b)
-> (forall a b c.
    (a -> b -> c)
    -> MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env c)
-> (forall a b.
    MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b)
-> (forall a b.
    MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env a)
-> Applicative (MemoizedWith env)
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env a
MemoizedWith env (a -> b)
-> MemoizedWith env a -> MemoizedWith env b
(a -> b -> c)
-> MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env c
forall env. Functor (MemoizedWith env)
forall a. a -> MemoizedWith env a
forall env a. a -> MemoizedWith env a
forall a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env a
forall a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
forall a b.
MemoizedWith env (a -> b)
-> MemoizedWith env a -> MemoizedWith env b
forall env a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env a
forall env a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
forall env a b.
MemoizedWith env (a -> b)
-> MemoizedWith env a -> MemoizedWith env b
forall a b c.
(a -> b -> c)
-> MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env c
forall env a b c.
(a -> b -> c)
-> MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env a
$c<* :: forall env a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env a
*> :: MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
$c*> :: forall env a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
liftA2 :: (a -> b -> c)
-> MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env c
$cliftA2 :: forall env a b c.
(a -> b -> c)
-> MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env c
<*> :: MemoizedWith env (a -> b)
-> MemoizedWith env a -> MemoizedWith env b
$c<*> :: forall env a b.
MemoizedWith env (a -> b)
-> MemoizedWith env a -> MemoizedWith env b
pure :: a -> MemoizedWith env a
$cpure :: forall env a. a -> MemoizedWith env a
$cp1Applicative :: forall env. Functor (MemoizedWith env)
Applicative, Applicative (MemoizedWith env)
a -> MemoizedWith env a
Applicative (MemoizedWith env)
-> (forall a b.
    MemoizedWith env a
    -> (a -> MemoizedWith env b) -> MemoizedWith env b)
-> (forall a b.
    MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b)
-> (forall a. a -> MemoizedWith env a)
-> Monad (MemoizedWith env)
MemoizedWith env a
-> (a -> MemoizedWith env b) -> MemoizedWith env b
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
forall env. Applicative (MemoizedWith env)
forall a. a -> MemoizedWith env a
forall env a. a -> MemoizedWith env a
forall a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
forall a b.
MemoizedWith env a
-> (a -> MemoizedWith env b) -> MemoizedWith env b
forall env a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
forall env a b.
MemoizedWith env a
-> (a -> MemoizedWith env b) -> MemoizedWith env b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> MemoizedWith env a
$creturn :: forall env a. a -> MemoizedWith env a
>> :: MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
$c>> :: forall env a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
>>= :: MemoizedWith env a
-> (a -> MemoizedWith env b) -> MemoizedWith env b
$c>>= :: forall env a b.
MemoizedWith env a
-> (a -> MemoizedWith env b) -> MemoizedWith env b
$cp1Monad :: forall env. Applicative (MemoizedWith env)
Monad)

memoizeRefWith :: MonadIO m => RIO env a -> m (MemoizedWith env a)
memoizeRefWith :: RIO env a -> m (MemoizedWith env a)
memoizeRefWith RIO env a
action = do
  IORef (Maybe (Either SomeException a))
ref <- Maybe (Either SomeException a)
-> m (IORef (Maybe (Either SomeException a)))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Maybe (Either SomeException a)
forall a. Maybe a
Nothing
  MemoizedWith env a -> m (MemoizedWith env a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoizedWith env a -> m (MemoizedWith env a))
-> MemoizedWith env a -> m (MemoizedWith env a)
forall a b. (a -> b) -> a -> b
$ RIO env a -> MemoizedWith env a
forall env a. RIO env a -> MemoizedWith env a
MemoizedWith (RIO env a -> MemoizedWith env a)
-> RIO env a -> MemoizedWith env a
forall a b. (a -> b) -> a -> b
$ do
    Maybe (Either SomeException a)
mres <- IORef (Maybe (Either SomeException a))
-> RIO env (Maybe (Either SomeException a))
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (Maybe (Either SomeException a))
ref
    Either SomeException a
res <-
      case Maybe (Either SomeException a)
mres of
        Just Either SomeException a
res -> Either SomeException a -> RIO env (Either SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res
        Maybe (Either SomeException a)
Nothing -> do
          Either SomeException a
res <- RIO env a -> RIO env (Either SomeException a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny RIO env a
action
          IORef (Maybe (Either SomeException a))
-> Maybe (Either SomeException a) -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Maybe (Either SomeException a))
ref (Maybe (Either SomeException a) -> RIO env ())
-> Maybe (Either SomeException a) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> Maybe (Either SomeException a)
forall a. a -> Maybe a
Just Either SomeException a
res
          Either SomeException a -> RIO env (Either SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res
    (SomeException -> RIO env a)
-> (a -> RIO env a) -> Either SomeException a -> RIO env a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> RIO env a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res

runMemoizedWith
  :: (HasEnvConfig env, MonadReader env m, MonadIO m)
  => MemoizedWith EnvConfig a
  -> m a
runMemoizedWith :: MemoizedWith EnvConfig a -> m a
runMemoizedWith (MemoizedWith RIO EnvConfig a
action) = do
  EnvConfig
envConfig <- Getting EnvConfig env EnvConfig -> m EnvConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting EnvConfig env EnvConfig
forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL
  EnvConfig -> RIO EnvConfig a -> m a
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO EnvConfig
envConfig RIO EnvConfig a
action

instance Show (MemoizedWith env a) where
  show :: MemoizedWith env a -> String
show MemoizedWith env a
_ = String
"<<MemoizedWith>>"

lpFiles :: HasEnvConfig env => LocalPackage -> RIO env (Set.Set (Path Abs File))
lpFiles :: LocalPackage -> RIO env (Set (Path Abs File))
lpFiles = MemoizedWith EnvConfig (Set (Path Abs File))
-> RIO env (Set (Path Abs File))
forall env (m :: * -> *) a.
(HasEnvConfig env, MonadReader env m, MonadIO m) =>
MemoizedWith EnvConfig a -> m a
runMemoizedWith (MemoizedWith EnvConfig (Set (Path Abs File))
 -> RIO env (Set (Path Abs File)))
-> (LocalPackage -> MemoizedWith EnvConfig (Set (Path Abs File)))
-> LocalPackage
-> RIO env (Set (Path Abs File))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map NamedComponent (Set (Path Abs File)) -> Set (Path Abs File))
-> MemoizedWith
     EnvConfig (Map NamedComponent (Set (Path Abs File)))
-> MemoizedWith EnvConfig (Set (Path Abs File))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Set (Path Abs File)] -> Set (Path Abs File)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set (Path Abs File)] -> Set (Path Abs File))
-> (Map NamedComponent (Set (Path Abs File))
    -> [Set (Path Abs File)])
-> Map NamedComponent (Set (Path Abs File))
-> Set (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NamedComponent (Set (Path Abs File)) -> [Set (Path Abs File)]
forall k a. Map k a -> [a]
M.elems) (MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
 -> MemoizedWith EnvConfig (Set (Path Abs File)))
-> (LocalPackage
    -> MemoizedWith
         EnvConfig (Map NamedComponent (Set (Path Abs File))))
-> LocalPackage
-> MemoizedWith EnvConfig (Set (Path Abs File))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalPackage
-> MemoizedWith
     EnvConfig (Map NamedComponent (Set (Path Abs File)))
lpComponentFiles

lpFilesForComponents :: HasEnvConfig env
                     => Set NamedComponent
                     -> LocalPackage
                     -> RIO env (Set.Set (Path Abs File))
lpFilesForComponents :: Set NamedComponent -> LocalPackage -> RIO env (Set (Path Abs File))
lpFilesForComponents Set NamedComponent
components LocalPackage
lp = MemoizedWith EnvConfig (Set (Path Abs File))
-> RIO env (Set (Path Abs File))
forall env (m :: * -> *) a.
(HasEnvConfig env, MonadReader env m, MonadIO m) =>
MemoizedWith EnvConfig a -> m a
runMemoizedWith (MemoizedWith EnvConfig (Set (Path Abs File))
 -> RIO env (Set (Path Abs File)))
-> MemoizedWith EnvConfig (Set (Path Abs File))
-> RIO env (Set (Path Abs File))
forall a b. (a -> b) -> a -> b
$ do
  Map NamedComponent (Set (Path Abs File))
componentFiles <- LocalPackage
-> MemoizedWith
     EnvConfig (Map NamedComponent (Set (Path Abs File)))
lpComponentFiles LocalPackage
lp
  Set (Path Abs File) -> MemoizedWith EnvConfig (Set (Path Abs File))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set (Path Abs File)
 -> MemoizedWith EnvConfig (Set (Path Abs File)))
-> Set (Path Abs File)
-> MemoizedWith EnvConfig (Set (Path Abs File))
forall a b. (a -> b) -> a -> b
$ [Set (Path Abs File)] -> Set (Path Abs File)
forall a. Monoid a => [a] -> a
mconcat (Map NamedComponent (Set (Path Abs File)) -> [Set (Path Abs File)]
forall k a. Map k a -> [a]
M.elems (Map NamedComponent (Set (Path Abs File))
-> Set NamedComponent -> Map NamedComponent (Set (Path Abs File))
forall k a. Ord k => Map k a -> Set k -> Map k a
M.restrictKeys Map NamedComponent (Set (Path Abs File))
componentFiles Set NamedComponent
components))

-- | A location to install a package into, either snapshot or local
data InstallLocation = Snap | Local
    deriving (Int -> InstallLocation -> ShowS
[InstallLocation] -> ShowS
InstallLocation -> String
(Int -> InstallLocation -> ShowS)
-> (InstallLocation -> String)
-> ([InstallLocation] -> ShowS)
-> Show InstallLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstallLocation] -> ShowS
$cshowList :: [InstallLocation] -> ShowS
show :: InstallLocation -> String
$cshow :: InstallLocation -> String
showsPrec :: Int -> InstallLocation -> ShowS
$cshowsPrec :: Int -> InstallLocation -> ShowS
Show, InstallLocation -> InstallLocation -> Bool
(InstallLocation -> InstallLocation -> Bool)
-> (InstallLocation -> InstallLocation -> Bool)
-> Eq InstallLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstallLocation -> InstallLocation -> Bool
$c/= :: InstallLocation -> InstallLocation -> Bool
== :: InstallLocation -> InstallLocation -> Bool
$c== :: InstallLocation -> InstallLocation -> Bool
Eq)
instance Semigroup InstallLocation where
    InstallLocation
Local <> :: InstallLocation -> InstallLocation -> InstallLocation
<> InstallLocation
_ = InstallLocation
Local
    InstallLocation
_ <> InstallLocation
Local = InstallLocation
Local
    InstallLocation
Snap <> InstallLocation
Snap = InstallLocation
Snap
instance Monoid InstallLocation where
    mempty :: InstallLocation
mempty = InstallLocation
Snap
    mappend :: InstallLocation -> InstallLocation -> InstallLocation
mappend = InstallLocation -> InstallLocation -> InstallLocation
forall a. Semigroup a => a -> a -> a
(<>)

data InstalledPackageLocation = InstalledTo InstallLocation | ExtraGlobal
    deriving (Int -> InstalledPackageLocation -> ShowS
[InstalledPackageLocation] -> ShowS
InstalledPackageLocation -> String
(Int -> InstalledPackageLocation -> ShowS)
-> (InstalledPackageLocation -> String)
-> ([InstalledPackageLocation] -> ShowS)
-> Show InstalledPackageLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstalledPackageLocation] -> ShowS
$cshowList :: [InstalledPackageLocation] -> ShowS
show :: InstalledPackageLocation -> String
$cshow :: InstalledPackageLocation -> String
showsPrec :: Int -> InstalledPackageLocation -> ShowS
$cshowsPrec :: Int -> InstalledPackageLocation -> ShowS
Show, InstalledPackageLocation -> InstalledPackageLocation -> Bool
(InstalledPackageLocation -> InstalledPackageLocation -> Bool)
-> (InstalledPackageLocation -> InstalledPackageLocation -> Bool)
-> Eq InstalledPackageLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstalledPackageLocation -> InstalledPackageLocation -> Bool
$c/= :: InstalledPackageLocation -> InstalledPackageLocation -> Bool
== :: InstalledPackageLocation -> InstalledPackageLocation -> Bool
$c== :: InstalledPackageLocation -> InstalledPackageLocation -> Bool
Eq)

newtype FileCacheInfo = FileCacheInfo
    { FileCacheInfo -> SHA256
fciHash :: SHA256
    }
    deriving ((forall x. FileCacheInfo -> Rep FileCacheInfo x)
-> (forall x. Rep FileCacheInfo x -> FileCacheInfo)
-> Generic FileCacheInfo
forall x. Rep FileCacheInfo x -> FileCacheInfo
forall x. FileCacheInfo -> Rep FileCacheInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileCacheInfo x -> FileCacheInfo
$cfrom :: forall x. FileCacheInfo -> Rep FileCacheInfo x
Generic, Int -> FileCacheInfo -> ShowS
[FileCacheInfo] -> ShowS
FileCacheInfo -> String
(Int -> FileCacheInfo -> ShowS)
-> (FileCacheInfo -> String)
-> ([FileCacheInfo] -> ShowS)
-> Show FileCacheInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileCacheInfo] -> ShowS
$cshowList :: [FileCacheInfo] -> ShowS
show :: FileCacheInfo -> String
$cshow :: FileCacheInfo -> String
showsPrec :: Int -> FileCacheInfo -> ShowS
$cshowsPrec :: Int -> FileCacheInfo -> ShowS
Show, FileCacheInfo -> FileCacheInfo -> Bool
(FileCacheInfo -> FileCacheInfo -> Bool)
-> (FileCacheInfo -> FileCacheInfo -> Bool) -> Eq FileCacheInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileCacheInfo -> FileCacheInfo -> Bool
$c/= :: FileCacheInfo -> FileCacheInfo -> Bool
== :: FileCacheInfo -> FileCacheInfo -> Bool
$c== :: FileCacheInfo -> FileCacheInfo -> Bool
Eq, Typeable)
instance NFData FileCacheInfo

-- Provided for storing the BuildCache values in a file. But maybe
-- JSON/YAML isn't the right choice here, worth considering.
instance ToJSON FileCacheInfo where
  toJSON :: FileCacheInfo -> Value
toJSON (FileCacheInfo SHA256
hash') = [Pair] -> Value
object
    [ Text
"hash" Text -> SHA256 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SHA256
hash'
    ]
instance FromJSON FileCacheInfo where
  parseJSON :: Value -> Parser FileCacheInfo
parseJSON = String
-> (Object -> Parser FileCacheInfo)
-> Value
-> Parser FileCacheInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FileCacheInfo" ((Object -> Parser FileCacheInfo) -> Value -> Parser FileCacheInfo)
-> (Object -> Parser FileCacheInfo)
-> Value
-> Parser FileCacheInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> SHA256 -> FileCacheInfo
FileCacheInfo
    (SHA256 -> FileCacheInfo) -> Parser SHA256 -> Parser FileCacheInfo
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
"hash"

-- | A descriptor from a .cabal file indicating one of the following:
--
-- exposed-modules: Foo
-- other-modules: Foo
-- or
-- main-is: Foo.hs
--
data DotCabalDescriptor
    = DotCabalModule !ModuleName
    | DotCabalMain !FilePath
    | DotCabalFile !FilePath
    | DotCabalCFile !FilePath
    deriving (DotCabalDescriptor -> DotCabalDescriptor -> Bool
(DotCabalDescriptor -> DotCabalDescriptor -> Bool)
-> (DotCabalDescriptor -> DotCabalDescriptor -> Bool)
-> Eq DotCabalDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
$c/= :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
== :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
$c== :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
Eq,Eq DotCabalDescriptor
Eq DotCabalDescriptor
-> (DotCabalDescriptor -> DotCabalDescriptor -> Ordering)
-> (DotCabalDescriptor -> DotCabalDescriptor -> Bool)
-> (DotCabalDescriptor -> DotCabalDescriptor -> Bool)
-> (DotCabalDescriptor -> DotCabalDescriptor -> Bool)
-> (DotCabalDescriptor -> DotCabalDescriptor -> Bool)
-> (DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor)
-> (DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor)
-> Ord DotCabalDescriptor
DotCabalDescriptor -> DotCabalDescriptor -> Bool
DotCabalDescriptor -> DotCabalDescriptor -> Ordering
DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor
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 :: DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor
$cmin :: DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor
max :: DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor
$cmax :: DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor
>= :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
$c>= :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
> :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
$c> :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
<= :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
$c<= :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
< :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
$c< :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
compare :: DotCabalDescriptor -> DotCabalDescriptor -> Ordering
$ccompare :: DotCabalDescriptor -> DotCabalDescriptor -> Ordering
$cp1Ord :: Eq DotCabalDescriptor
Ord,Int -> DotCabalDescriptor -> ShowS
[DotCabalDescriptor] -> ShowS
DotCabalDescriptor -> String
(Int -> DotCabalDescriptor -> ShowS)
-> (DotCabalDescriptor -> String)
-> ([DotCabalDescriptor] -> ShowS)
-> Show DotCabalDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotCabalDescriptor] -> ShowS
$cshowList :: [DotCabalDescriptor] -> ShowS
show :: DotCabalDescriptor -> String
$cshow :: DotCabalDescriptor -> String
showsPrec :: Int -> DotCabalDescriptor -> ShowS
$cshowsPrec :: Int -> DotCabalDescriptor -> ShowS
Show)

-- | Maybe get the module name from the .cabal descriptor.
dotCabalModule :: DotCabalDescriptor -> Maybe ModuleName
dotCabalModule :: DotCabalDescriptor -> Maybe ModuleName
dotCabalModule (DotCabalModule ModuleName
m) = ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
m
dotCabalModule DotCabalDescriptor
_ = Maybe ModuleName
forall a. Maybe a
Nothing

-- | Maybe get the main name from the .cabal descriptor.
dotCabalMain :: DotCabalDescriptor -> Maybe FilePath
dotCabalMain :: DotCabalDescriptor -> Maybe String
dotCabalMain (DotCabalMain String
m) = String -> Maybe String
forall a. a -> Maybe a
Just String
m
dotCabalMain DotCabalDescriptor
_ = Maybe String
forall a. Maybe a
Nothing

-- | A path resolved from the .cabal file, which is either main-is or
-- an exposed/internal/referenced module.
data DotCabalPath
    = DotCabalModulePath !(Path Abs File)
    | DotCabalMainPath !(Path Abs File)
    | DotCabalFilePath !(Path Abs File)
    | DotCabalCFilePath !(Path Abs File)
    deriving (DotCabalPath -> DotCabalPath -> Bool
(DotCabalPath -> DotCabalPath -> Bool)
-> (DotCabalPath -> DotCabalPath -> Bool) -> Eq DotCabalPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotCabalPath -> DotCabalPath -> Bool
$c/= :: DotCabalPath -> DotCabalPath -> Bool
== :: DotCabalPath -> DotCabalPath -> Bool
$c== :: DotCabalPath -> DotCabalPath -> Bool
Eq,Eq DotCabalPath
Eq DotCabalPath
-> (DotCabalPath -> DotCabalPath -> Ordering)
-> (DotCabalPath -> DotCabalPath -> Bool)
-> (DotCabalPath -> DotCabalPath -> Bool)
-> (DotCabalPath -> DotCabalPath -> Bool)
-> (DotCabalPath -> DotCabalPath -> Bool)
-> (DotCabalPath -> DotCabalPath -> DotCabalPath)
-> (DotCabalPath -> DotCabalPath -> DotCabalPath)
-> Ord DotCabalPath
DotCabalPath -> DotCabalPath -> Bool
DotCabalPath -> DotCabalPath -> Ordering
DotCabalPath -> DotCabalPath -> DotCabalPath
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 :: DotCabalPath -> DotCabalPath -> DotCabalPath
$cmin :: DotCabalPath -> DotCabalPath -> DotCabalPath
max :: DotCabalPath -> DotCabalPath -> DotCabalPath
$cmax :: DotCabalPath -> DotCabalPath -> DotCabalPath
>= :: DotCabalPath -> DotCabalPath -> Bool
$c>= :: DotCabalPath -> DotCabalPath -> Bool
> :: DotCabalPath -> DotCabalPath -> Bool
$c> :: DotCabalPath -> DotCabalPath -> Bool
<= :: DotCabalPath -> DotCabalPath -> Bool
$c<= :: DotCabalPath -> DotCabalPath -> Bool
< :: DotCabalPath -> DotCabalPath -> Bool
$c< :: DotCabalPath -> DotCabalPath -> Bool
compare :: DotCabalPath -> DotCabalPath -> Ordering
$ccompare :: DotCabalPath -> DotCabalPath -> Ordering
$cp1Ord :: Eq DotCabalPath
Ord,Int -> DotCabalPath -> ShowS
[DotCabalPath] -> ShowS
DotCabalPath -> String
(Int -> DotCabalPath -> ShowS)
-> (DotCabalPath -> String)
-> ([DotCabalPath] -> ShowS)
-> Show DotCabalPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotCabalPath] -> ShowS
$cshowList :: [DotCabalPath] -> ShowS
show :: DotCabalPath -> String
$cshow :: DotCabalPath -> String
showsPrec :: Int -> DotCabalPath -> ShowS
$cshowsPrec :: Int -> DotCabalPath -> ShowS
Show)

-- | Get the module path.
dotCabalModulePath :: DotCabalPath -> Maybe (Path Abs File)
dotCabalModulePath :: DotCabalPath -> Maybe (Path Abs File)
dotCabalModulePath (DotCabalModulePath Path Abs File
fp) = Path Abs File -> Maybe (Path Abs File)
forall a. a -> Maybe a
Just Path Abs File
fp
dotCabalModulePath DotCabalPath
_ = Maybe (Path Abs File)
forall a. Maybe a
Nothing

-- | Get the main path.
dotCabalMainPath :: DotCabalPath -> Maybe (Path Abs File)
dotCabalMainPath :: DotCabalPath -> Maybe (Path Abs File)
dotCabalMainPath (DotCabalMainPath Path Abs File
fp) = Path Abs File -> Maybe (Path Abs File)
forall a. a -> Maybe a
Just Path Abs File
fp
dotCabalMainPath DotCabalPath
_ = Maybe (Path Abs File)
forall a. Maybe a
Nothing

-- | Get the c file path.
dotCabalCFilePath :: DotCabalPath -> Maybe (Path Abs File)
dotCabalCFilePath :: DotCabalPath -> Maybe (Path Abs File)
dotCabalCFilePath (DotCabalCFilePath Path Abs File
fp) = Path Abs File -> Maybe (Path Abs File)
forall a. a -> Maybe a
Just Path Abs File
fp
dotCabalCFilePath DotCabalPath
_ = Maybe (Path Abs File)
forall a. Maybe a
Nothing

-- | Get the path.
dotCabalGetPath :: DotCabalPath -> Path Abs File
dotCabalGetPath :: DotCabalPath -> Path Abs File
dotCabalGetPath DotCabalPath
dcp =
    case DotCabalPath
dcp of
        DotCabalModulePath Path Abs File
fp -> Path Abs File
fp
        DotCabalMainPath Path Abs File
fp -> Path Abs File
fp
        DotCabalFilePath Path Abs File
fp -> Path Abs File
fp
        DotCabalCFilePath Path Abs File
fp -> Path Abs File
fp

type InstalledMap = Map PackageName (InstallLocation, Installed)

data Installed
    = Library PackageIdentifier GhcPkgId (Maybe (Either SPDX.License License))
    | Executable PackageIdentifier
    deriving (Int -> Installed -> ShowS
[Installed] -> ShowS
Installed -> String
(Int -> Installed -> ShowS)
-> (Installed -> String)
-> ([Installed] -> ShowS)
-> Show Installed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Installed] -> ShowS
$cshowList :: [Installed] -> ShowS
show :: Installed -> String
$cshow :: Installed -> String
showsPrec :: Int -> Installed -> ShowS
$cshowsPrec :: Int -> Installed -> ShowS
Show, Installed -> Installed -> Bool
(Installed -> Installed -> Bool)
-> (Installed -> Installed -> Bool) -> Eq Installed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Installed -> Installed -> Bool
$c/= :: Installed -> Installed -> Bool
== :: Installed -> Installed -> Bool
$c== :: Installed -> Installed -> Bool
Eq)

installedPackageIdentifier :: Installed -> PackageIdentifier
installedPackageIdentifier :: Installed -> PackageIdentifier
installedPackageIdentifier (Library PackageIdentifier
pid GhcPkgId
_ Maybe (Either License License)
_) = PackageIdentifier
pid
installedPackageIdentifier (Executable PackageIdentifier
pid) = PackageIdentifier
pid

-- | Get the installed Version.
installedVersion :: Installed -> Version
installedVersion :: Installed -> Version
installedVersion Installed
i =
  let PackageIdentifier PackageName
_ Version
version = Installed -> PackageIdentifier
installedPackageIdentifier Installed
i
   in Version
version