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 qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Distribution.InstalledPackageInfo (PError)
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.PackageIdentifier
import Stack.Types.PackageName
import Stack.Types.Version
data PackageException
= PackageInvalidCabalFile (Either PackageIdentifierRevision (Path Abs File)) PError
| 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 err) = concat
[ "Unable to parse cabal file "
, case loc of
Left pir -> "for " ++ packageIdentifierRevisionString pir
Right fp -> toFilePath fp
, ": "
, show err
]
show (PackageNoCabalFileFound dir) = concat
[ "Stack looks for packages in the directories configured in"
, " the 'packages' variable defined in your stack.yaml\n"
, "The current entry points to " ++ toFilePath dir ++
" but no .cabal 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 :: !License
,packageFiles :: !GetPackageFiles
,packageDeps :: !(Map PackageName VersionRange)
,packageTools :: !(Map ExeName VersionRange)
,packageAllDeps :: !(Set PackageName)
,packageGhcOptions :: ![Text]
,packageFlags :: !(Map FlagName Bool)
,packageDefaultFlags :: !(Map FlagName Bool)
,packageLibraries :: !PackageLibraries
,packageTests :: !(Map Text TestSuiteInterface)
,packageBenchmarks :: !(Set Text)
,packageExes :: !(Set Text)
,packageOpts :: !GetPackageOpts
,packageHasExposedModules :: !Bool
,packageBuildType :: !(Maybe BuildType)
,packageSetupDeps :: !(Maybe (Map PackageName VersionRange))
}
deriving (Show,Typeable)
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 (Set ModuleName)
,Map NamedComponent (Set DotCabalPath)
,Map NamedComponent BuildInfoOpts)
}
instance Show GetPackageOpts where
show _ = "<GetPackageOpts>"
data BuildInfoOpts = BuildInfoOpts
{ bioOpts :: [String]
, bioOneWordOpts :: [String]
, bioPackageFlags :: [String]
, bioCabalMacros :: Maybe (Path Abs File)
} deriving Show
data CabalFileType
= AllFiles
| Modules
newtype GetPackageFiles = GetPackageFiles
{ getPackageFiles :: forall env. HasEnvConfig env
=> Path Abs File
-> RIO env
(Map NamedComponent (Set ModuleName)
,Map NamedComponent (Set DotCabalPath)
,Set (Path Abs File)
,[PackageWarning])
}
instance Show GetPackageFiles where
show _ = "<GetPackageFiles>"
data PackageWarning
= UnlistedModulesWarning (Maybe String) [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
renderComponent :: NamedComponent -> S.ByteString
renderComponent CLib = "lib"
renderComponent (CExe x) = "exe:" <> encodeUtf8 x
renderComponent (CTest x) = "test:" <> encodeUtf8 x
renderComponent (CBench x) = "bench:" <> encodeUtf8 x
renderPkgComponents :: [(PackageName, NamedComponent)] -> Text
renderPkgComponents = T.intercalate " " . map renderPkgComponent
renderPkgComponent :: (PackageName, NamedComponent) -> Text
renderPkgComponent (pkg, comp) = packageNameText pkg <> ":" <> decodeUtf8 (renderComponent comp)
exeComponents :: Set NamedComponent -> Set Text
exeComponents = Set.fromList . mapMaybe mExeName . Set.toList
where
mExeName (CExe name) = Just name
mExeName _ = Nothing
testComponents :: Set NamedComponent -> Set Text
testComponents = Set.fromList . mapMaybe mTestName . Set.toList
where
mTestName (CTest name) = Just name
mTestName _ = Nothing
benchComponents :: Set NamedComponent -> Set Text
benchComponents = Set.fromList . mapMaybe mBenchName . Set.toList
where
mBenchName (CBench name) = Just name
mBenchName _ = Nothing
isCLib :: NamedComponent -> Bool
isCLib CLib{} = True
isCLib _ = False
isCExe :: NamedComponent -> Bool
isCExe CExe{} = True
isCExe _ = False
isCTest :: NamedComponent -> Bool
isCTest CTest{} = True
isCTest _ = False
isCBench :: NamedComponent -> Bool
isCBench CBench{} = True
isCBench _ = False
lpFiles :: LocalPackage -> Set.Set (Path Abs File)
lpFiles = Set.unions . M.elems . lpComponentFiles
data InstallLocation = Snap | Local
deriving (Show, Eq)
instance Monoid InstallLocation where
mempty = Snap
mappend Local _ = Local
mappend _ Local = Local
mappend Snap Snap = Snap
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 License)
| Executable PackageIdentifier
deriving (Show, Eq)
installedPackageIdentifier :: Installed -> PackageIdentifier
installedPackageIdentifier (Library pid _ _) = pid
installedPackageIdentifier (Executable pid) = pid
installedVersion :: Installed -> Version
installedVersion = packageIdentifierVersion . installedPackageIdentifier