{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ConstraintKinds #-}
module Stack.Types.Package where
import Stack.Prelude
import qualified Data.ByteString as S
import Data.List
import qualified Data.Map as M
import qualified Data.Set as Set
import Data.Store.Version (VersionConfig)
import Data.Store.VersionTagged (storeVersionConfig)
import Distribution.Parsec.Common (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 Path as FL
import Stack.Types.BuildPlan (PackageLocation, PackageLocationIndex (..), ExeName)
import Stack.Types.Compiler
import Stack.Types.Config
import Stack.Types.FlagName
import Stack.Types.GhcPkgId
import Stack.Types.NamedComponent
import Stack.Types.PackageIdentifier
import Stack.Types.PackageName
import Stack.Types.Version
data PackageException
= PackageInvalidCabalFile
!(Either PackageIdentifierRevision (Path Abs File))
!(Maybe Version)
![PError]
![PWarning]
| PackageNoCabalFileFound (Path Abs Dir)
| PackageMultipleCabalFilesFound (Path Abs Dir) [Path Abs File]
| MismatchedCabalName (Path Abs File) PackageName
| MismatchedCabalIdentifier !PackageIdentifierRevision !PackageIdentifier
deriving Typeable
instance Exception PackageException
instance Show PackageException where
show (PackageInvalidCabalFile loc _mversion errs warnings) = concat
[ "Unable to parse cabal file "
, case loc of
Left pir -> "for " ++ packageIdentifierRevisionString pir
Right fp -> toFilePath fp
, "\n\n"
, unlines $ map
(\(PError pos msg) -> concat
[ "- "
, showPos pos
, ": "
, msg
])
errs
, unlines $ map
(\(PWarning _ pos msg) -> concat
[ "- "
, showPos pos
, ": "
, msg
])
warnings
]
show (PackageNoCabalFileFound dir) = concat
[ "Stack looks for packages in the directories configured in"
, " the 'packages' and 'extra-deps' fields defined in your stack.yaml\n"
, "The current entry points to "
, toFilePath dir
, " but no .cabal or package.yaml file could be found there."
]
show (PackageMultipleCabalFilesFound dir files) =
"Multiple .cabal files found in directory " ++
toFilePath dir ++
": " ++
intercalate ", " (map (toFilePath . filename) files)
show (MismatchedCabalName fp name) = concat
[ "cabal file path "
, toFilePath fp
, " does not match the package name it defines.\n"
, "Please rename the file to: "
, packageNameString name
, ".cabal\n"
, "For more information, see: https://github.com/commercialhaskell/stack/issues/317"
]
show (MismatchedCabalIdentifier pir ident) = concat
[ "Mismatched package identifier."
, "\nFound: "
, packageIdentifierString ident
, "\nExpected: "
, packageIdentifierRevisionString pir
]
data PackageLibraries
= NoLibraries
| HasLibraries !(Set Text)
deriving (Show,Typeable)
data Package =
Package {packageName :: !PackageName
,packageVersion :: !Version
,packageLicense :: !(Either SPDX.License License)
,packageFiles :: !GetPackageFiles
,packageDeps :: !(Map PackageName DepValue)
,packageUnknownTools :: !(Set ExeName)
,packageAllDeps :: !(Set PackageName)
,packageGhcOptions :: ![Text]
,packageFlags :: !(Map FlagName Bool)
,packageDefaultFlags :: !(Map FlagName Bool)
,packageLibraries :: !PackageLibraries
,packageInternalLibraries :: !(Set Text)
,packageTests :: !(Map Text TestSuiteInterface)
,packageBenchmarks :: !(Set Text)
,packageExes :: !(Set Text)
,packageOpts :: !GetPackageOpts
,packageHasExposedModules :: !Bool
,packageBuildType :: !BuildType
,packageSetupDeps :: !(Maybe (Map PackageName VersionRange))
}
deriving (Show,Typeable)
data DepValue = DepValue
{ dvVersionRange :: !VersionRange
, dvType :: !DepType
}
deriving (Show,Typeable)
instance Semigroup DepValue where
DepValue a x <> DepValue b y = DepValue (intersectVersionRanges a b) (x <> y)
data DepType = AsLibrary | AsBuildTool
deriving (Show, Eq)
instance Semigroup DepType where
AsLibrary <> _ = AsLibrary
AsBuildTool <> x = x
packageIdentifier :: Package -> PackageIdentifier
packageIdentifier pkg =
PackageIdentifier (packageName pkg) (packageVersion pkg)
packageDefinedFlags :: Package -> Set FlagName
packageDefinedFlags = M.keysSet . packageDefaultFlags
newtype GetPackageOpts = GetPackageOpts
{ getPackageOpts :: forall env. HasEnvConfig env
=> SourceMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> RIO env
(Map NamedComponent (Map ModuleName (Path Abs File))
,Map NamedComponent (Set DotCabalPath)
,Map NamedComponent BuildInfoOpts)
}
instance Show GetPackageOpts where
show _ = "<GetPackageOpts>"
data BuildInfoOpts = BuildInfoOpts
{ bioOpts :: [String]
, bioOneWordOpts :: [String]
, bioPackageFlags :: [String]
, bioCabalMacros :: Path Abs File
} deriving Show
data CabalFileType
= AllFiles
| Modules
newtype GetPackageFiles = GetPackageFiles
{ getPackageFiles :: forall env. HasEnvConfig env
=> Path Abs File
-> RIO env
(Map NamedComponent (Map ModuleName (Path Abs File))
,Map NamedComponent (Set DotCabalPath)
,Set (Path Abs File)
,[PackageWarning])
}
instance Show GetPackageFiles where
show _ = "<GetPackageFiles>"
data PackageWarning
= UnlistedModulesWarning NamedComponent [ModuleName]
data PackageConfig =
PackageConfig {packageConfigEnableTests :: !Bool
,packageConfigEnableBenchmarks :: !Bool
,packageConfigFlags :: !(Map FlagName Bool)
,packageConfigGhcOptions :: ![Text]
,packageConfigCompilerVersion
:: !(CompilerVersion 'CVActual)
,packageConfigPlatform :: !Platform
}
deriving (Show,Typeable)
instance Ord Package where
compare = on compare packageName
instance Eq Package where
(==) = on (==) packageName
type SourceMap = Map PackageName PackageSource
data PackageSource
= PSFiles LocalPackage InstallLocation
| PSIndex InstallLocation (Map FlagName Bool) [Text] PackageIdentifierRevision
deriving Show
piiVersion :: PackageSource -> Version
piiVersion (PSFiles lp _) = packageVersion $ lpPackage lp
piiVersion (PSIndex _ _ _ (PackageIdentifierRevision (PackageIdentifier _ v) _)) = v
piiLocation :: PackageSource -> InstallLocation
piiLocation (PSFiles _ loc) = loc
piiLocation (PSIndex loc _ _ _) = loc
piiPackageLocation :: PackageSource -> PackageLocationIndex FilePath
piiPackageLocation (PSFiles lp _) = PLOther (lpLocation lp)
piiPackageLocation (PSIndex _ _ _ pir) = PLIndex pir
data LocalPackage = LocalPackage
{ lpPackage :: !Package
, lpComponents :: !(Set NamedComponent)
, lpUnbuildable :: !(Set NamedComponent)
, lpWanted :: !Bool
, lpTestDeps :: !(Map PackageName VersionRange)
, lpBenchDeps :: !(Map PackageName VersionRange)
, lpTestBench :: !(Maybe Package)
, lpDir :: !(Path Abs Dir)
, lpCabalFile :: !(Path Abs File)
, lpForceDirty :: !Bool
, lpDirtyFiles :: !(Maybe (Set FilePath))
, lpNewBuildCaches :: !(Map NamedComponent (Map FilePath FileCacheInfo))
, lpComponentFiles :: !(Map NamedComponent (Set (Path Abs File)))
, lpLocation :: !(PackageLocation FilePath)
}
deriving Show
lpFiles :: LocalPackage -> Set.Set (Path Abs File)
lpFiles = Set.unions . M.elems . lpComponentFiles
data InstallLocation = Snap | Local
deriving (Show, Eq)
instance Semigroup InstallLocation where
Local <> _ = Local
_ <> Local = Local
Snap <> Snap = Snap
instance Monoid InstallLocation where
mempty = Snap
mappend = (<>)
data InstalledPackageLocation = InstalledTo InstallLocation | ExtraGlobal
deriving (Show, Eq)
data FileCacheInfo = FileCacheInfo
{ fciModTime :: !ModTime
, fciSize :: !Word64
, fciHash :: !S.ByteString
}
deriving (Generic, Show, Eq, Data, Typeable)
instance Store FileCacheInfo
instance NFData FileCacheInfo
newtype ModTime = ModTime (Integer,Rational)
deriving (Ord, Show, Generic, Eq, NFData, Store, Data, Typeable)
modTimeVC :: VersionConfig ModTime
modTimeVC = storeVersionConfig "mod-time-v1" "UBECpUI0JvM_SBOnRNdaiF9_yOU="
testSuccessVC :: VersionConfig Bool
testSuccessVC = storeVersionConfig "test-v1" "jC_GB0SGtbpRQbDlm7oQJP7thu8="
data DotCabalDescriptor
= DotCabalModule !ModuleName
| DotCabalMain !FilePath
| DotCabalFile !FilePath
| DotCabalCFile !FilePath
deriving (Eq,Ord,Show)
dotCabalModule :: DotCabalDescriptor -> Maybe ModuleName
dotCabalModule (DotCabalModule m) = Just m
dotCabalModule _ = Nothing
dotCabalMain :: DotCabalDescriptor -> Maybe FilePath
dotCabalMain (DotCabalMain m) = Just m
dotCabalMain _ = Nothing
data DotCabalPath
= DotCabalModulePath !(Path Abs File)
| DotCabalMainPath !(Path Abs File)
| DotCabalFilePath !(Path Abs File)
| DotCabalCFilePath !(Path Abs File)
deriving (Eq,Ord,Show)
dotCabalModulePath :: DotCabalPath -> Maybe (Path Abs File)
dotCabalModulePath (DotCabalModulePath fp) = Just fp
dotCabalModulePath _ = Nothing
dotCabalMainPath :: DotCabalPath -> Maybe (Path Abs File)
dotCabalMainPath (DotCabalMainPath fp) = Just fp
dotCabalMainPath _ = Nothing
dotCabalCFilePath :: DotCabalPath -> Maybe (Path Abs File)
dotCabalCFilePath (DotCabalCFilePath fp) = Just fp
dotCabalCFilePath _ = Nothing
dotCabalGetPath :: DotCabalPath -> Path Abs File
dotCabalGetPath dcp =
case dcp of
DotCabalModulePath fp -> fp
DotCabalMainPath fp -> fp
DotCabalFilePath fp -> fp
DotCabalCFilePath fp -> fp
type InstalledMap = Map PackageName (InstallLocation, Installed)
data Installed
= Library PackageIdentifier GhcPkgId (Maybe (Either SPDX.License License))
| Executable PackageIdentifier
deriving (Show, Eq)
installedPackageIdentifier :: Installed -> PackageIdentifier
installedPackageIdentifier (Library pid _ _) = pid
installedPackageIdentifier (Executable pid) = pid
installedVersion :: Installed -> Version
installedVersion = packageIdentifierVersion . installedPackageIdentifier