{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}

module Stack.Types.Package
 ( BuildInfoOpts (..)
 , ExeName (..)
 , FileCacheInfo (..)
 , GetPackageOpts (..)
 , InstallLocation (..)
 , InstallMap
 , Installed (..)
 , InstalledPackageLocation (..)
 , InstalledMap
 , LocalPackage (..)
 , MemoizedWith (..)
 , Package (..)
 , PackageConfig (..)
 , PackageException (..)
 , PackageLibraries (..)
 , PackageSource (..)
 , dotCabalCFilePath
 , dotCabalGetPath
 , dotCabalMain
 , dotCabalMainPath
 , dotCabalModule
 , dotCabalModulePath
 , installedPackageIdentifier
 , installedVersion
 , lpFiles
 , lpFilesForComponents
 , memoizeRefWith
 , packageDefinedFlags
 , packageIdent
 , packageIdentifier
 , psVersion
 , runMemoizedWith
 ) 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.CabalSpecVersion
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
import           Stack.Types.Dependency ( DepValue )
import           Stack.Types.PackageFile
                   ( GetPackageFiles (..), DotCabalDescriptor (..)
                   , DotCabalPath (..)
                   )

-- | Type representing exceptions thrown by functions exported by the

-- "Stack.Package" module.

data PackageException
  = PackageInvalidCabalFile
      !(Either PackageIdentifierRevision (Path Abs File))
      !(Maybe Version)
      ![PError]
      ![PWarning]
  | MismatchedCabalIdentifier !PackageIdentifierRevision !PackageIdentifier
  | CabalFileNameParseFail FilePath
  | CabalFileNameInvalidPackageName FilePath
  | ComponentNotParsedBug
  deriving (Int -> PackageException -> ShowS
[PackageException] -> ShowS
PackageException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageException] -> ShowS
$cshowList :: [PackageException] -> ShowS
show :: PackageException -> String
$cshow :: PackageException -> String
showsPrec :: Int -> PackageException -> ShowS
$cshowsPrec :: Int -> PackageException -> ShowS
Show, Typeable)

instance Exception PackageException where
    displayException :: PackageException -> String
displayException (PackageInvalidCabalFile Either PackageIdentifierRevision (Path Abs File)
loc Maybe Version
_mversion [PError]
errs [PWarning]
warnings) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Error: [S-8072]\n"
        , String
"Unable to parse Cabal file "
        , case Either PackageIdentifierRevision (Path Abs File)
loc of
            Left PackageIdentifierRevision
pir -> String
"for " forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (Utf8Builder -> Text
utf8BuilderToText (forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir))
            Right Path Abs File
fp -> 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map
            (\(PError Position
pos String
msg) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ String
"- "
                , Position -> String
showPos Position
pos
                , String
": "
                , String
msg
                ])
            [PError]
errs
        , [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map
            (\(PWarning PWarnType
_ Position
pos String
msg) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ String
"- "
                , Position -> String
showPos Position
pos
                , String
": "
                , String
msg
                ])
            [PWarning]
warnings
        ]
    displayException (MismatchedCabalIdentifier PackageIdentifierRevision
pir PackageIdentifier
ident) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Error: [S-5394]\n"
        , String
"Mismatched package identifier."
        , String
"\nFound:    "
        , PackageIdentifier -> String
packageIdentifierString PackageIdentifier
ident
        , String
"\nExpected: "
        , Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Utf8Builder -> Text
utf8BuilderToText forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Utf8Builder
display PackageIdentifierRevision
pir
        ]
    displayException (CabalFileNameParseFail String
fp) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Error: [S-2203]\n"
        , String
"Invalid file path for Cabal file, must have a .cabal extension: "
        , String
fp
        ]
    displayException (CabalFileNameInvalidPackageName String
fp) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Error: [S-8854]\n"
        , String
"Cabal file names must use valid package names followed by a .cabal \
          \extension, the following is invalid: "
        , String
fp
        ]
    displayException PackageException
ComponentNotParsedBug = String -> ShowS
bugReport String
"[S-4623]"
        String
"Component names should always parse as directory names."

-- | 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
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
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
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
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
Ord, Eq ExeName
Int -> ExeName -> Int
ExeName -> Int
forall a. Eq 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
forall a. (String -> a) -> IsString a
fromString :: String -> ExeName
$cfromString :: String -> ExeName
IsString, 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: ExeName -> ()
$crnf :: ExeName -> ()
NFData, Typeable ExeName
ExeName -> DataType
ExeName -> Constr
(forall b. Data b => b -> b) -> ExeName -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> ExeName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExeName -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ExeName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ExeName -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
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 -> CabalSpecVersion
packageCabalSpec :: !CabalSpecVersion          -- ^ Cabal spec range

          }
 deriving (Int -> Package -> ShowS
[Package] -> ShowS
Package -> String
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)

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 = forall k a. Map k a -> Set k
M.keysSet 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
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

-- | 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
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 = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Ord a => a -> a -> Ordering
compare Package -> PackageName
packageName

-- | Compares the package name.

instance Eq Package where
  == :: Package -> Package -> Bool
(==) = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on 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) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"PSFilePath (", forall a. Show a => a -> String
show LocalPackage
lp, String
")"]
    show (PSRemote PackageLocationImmutable
pli Version
v FromSnapshot
fromSnapshot CommonPackage
_) =
        forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"PSRemote"
            , String
"(", forall a. Show a => a -> String
show PackageLocationImmutable
pli, String
")"
            , String
"(", forall a. Show a => a -> String
show Version
v, 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 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 -> 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
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 { forall env a. MemoizedWith env a -> RIO env a
unMemoizedWith :: RIO env a }
  deriving (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
<$ :: forall a b. a -> MemoizedWith env b -> MemoizedWith env a
$c<$ :: forall env a b. a -> MemoizedWith env b -> MemoizedWith env a
fmap :: forall a b. (a -> b) -> MemoizedWith env a -> MemoizedWith env b
$cfmap :: forall env a b.
(a -> b) -> MemoizedWith env a -> MemoizedWith env b
Functor, 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
<* :: forall a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env a
$c<* :: forall env a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env a
*> :: forall a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
$c*> :: forall env a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
liftA2 :: forall a b c.
(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
<*> :: forall a b.
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 :: forall a. a -> MemoizedWith env a
$cpure :: forall env a. a -> MemoizedWith env a
Applicative, 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 :: forall a. a -> MemoizedWith env a
$creturn :: forall env a. a -> MemoizedWith env a
>> :: forall a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
$c>> :: forall env a b.
MemoizedWith env a -> MemoizedWith env b -> MemoizedWith env b
>>= :: forall a 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
Monad)

memoizeRefWith :: MonadIO m => RIO env a -> m (MemoizedWith env a)
memoizeRefWith :: forall (m :: * -> *) env a.
MonadIO m =>
RIO env a -> m (MemoizedWith env a)
memoizeRefWith RIO env a
action = do
  IORef (Maybe (Either SomeException a))
ref <- forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef forall a. Maybe a
Nothing
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall env a. RIO env a -> MemoizedWith env a
MemoizedWith forall a b. (a -> b) -> a -> b
$ do
    Maybe (Either SomeException a)
mres <- 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res
        Maybe (Either SomeException a)
Nothing -> do
          Either SomeException a
res <- forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny RIO env a
action
          forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Maybe (Either SomeException a))
ref forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Either SomeException a
res
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO 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 :: forall env (m :: * -> *) a.
(HasEnvConfig env, MonadReader env m, MonadIO m) =>
MemoizedWith EnvConfig a -> m a
runMemoizedWith (MemoizedWith RIO EnvConfig a
action) = do
  EnvConfig
envConfig <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL
  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 :: forall env.
HasEnvConfig env =>
LocalPackage -> RIO env (Set (Path Abs File))
lpFiles = forall env (m :: * -> *) a.
(HasEnvConfig env, MonadReader env m, MonadIO m) =>
MemoizedWith EnvConfig a -> m a
runMemoizedWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
M.elems) 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 :: forall env.
HasEnvConfig env =>
Set NamedComponent -> LocalPackage -> RIO env (Set (Path Abs File))
lpFilesForComponents Set NamedComponent
components LocalPackage
lp = forall env (m :: * -> *) a.
(HasEnvConfig env, MonadReader env m, MonadIO m) =>
MemoizedWith EnvConfig a -> m a
runMemoizedWith 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
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat (forall k a. Map k a -> [a]
M.elems (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
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
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 = forall a. Semigroup a => a -> a -> a
(<>)

data InstalledPackageLocation = InstalledTo InstallLocation | ExtraGlobal
    deriving (Int -> InstalledPackageLocation -> ShowS
[InstalledPackageLocation] -> ShowS
InstalledPackageLocation -> String
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
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. 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
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
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
    [ Key
"hash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SHA256
hash'
    ]
instance FromJSON FileCacheInfo where
  parseJSON :: Value -> Parser FileCacheInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FileCacheInfo" forall a b. (a -> b) -> a -> b
$ \Object
o -> SHA256 -> FileCacheInfo
FileCacheInfo
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hash"

-- | Maybe get the module name from the .cabal descriptor.

dotCabalModule :: DotCabalDescriptor -> Maybe ModuleName
dotCabalModule :: DotCabalDescriptor -> Maybe ModuleName
dotCabalModule (DotCabalModule ModuleName
m) = forall a. a -> Maybe a
Just ModuleName
m
dotCabalModule DotCabalDescriptor
_ = 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) = forall a. a -> Maybe a
Just String
m
dotCabalMain DotCabalDescriptor
_ = forall a. Maybe a
Nothing

-- | Get the module path.

dotCabalModulePath :: DotCabalPath -> Maybe (Path Abs File)
dotCabalModulePath :: DotCabalPath -> Maybe (Path Abs File)
dotCabalModulePath (DotCabalModulePath Path Abs File
fp) = forall a. a -> Maybe a
Just Path Abs File
fp
dotCabalModulePath DotCabalPath
_ = 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) = forall a. a -> Maybe a
Just Path Abs File
fp
dotCabalMainPath DotCabalPath
_ = 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) = forall a. a -> Maybe a
Just Path Abs File
fp
dotCabalCFilePath DotCabalPath
_ = 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
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
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