module Stack.Types.Package where
import Control.DeepSeq
import Control.Exception hiding (try,catch)
import qualified Data.ByteString as S
import Data.Data
import Data.Function
import Data.List
import qualified Data.Map as M
import Data.Map.Strict (Map)
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Store (Store)
import Data.Store.Version (VersionConfig)
import Data.Store.VersionTagged (storeVersionConfig)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Word (Word64)
import Distribution.InstalledPackageInfo (PError)
import Distribution.License (License)
import Distribution.ModuleName (ModuleName)
import Distribution.Package hiding (Package,PackageName,packageName,packageVersion,PackageIdentifier)
import Distribution.PackageDescription (TestSuiteInterface)
import Distribution.System (Platform (..))
import GHC.Generics (Generic)
import Path as FL
import Prelude
import Stack.Types.BuildPlan (GitSHA1)
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.StackT (StackM)
import Stack.Types.Version
data PackageException
= PackageInvalidCabalFile (Maybe (Path Abs File)) PError
| PackageNoCabalFileFound (Path Abs Dir)
| PackageMultipleCabalFilesFound (Path Abs Dir) [Path Abs File]
| MismatchedCabalName (Path Abs File) PackageName
deriving Typeable
instance Exception PackageException
instance Show PackageException where
show (PackageInvalidCabalFile mfile err) =
"Unable to parse cabal file" ++
(case mfile of
Nothing -> ""
Just file -> ' ' : toFilePath file) ++
": " ++
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"
]
data Package =
Package {packageName :: !PackageName
,packageVersion :: !Version
,packageLicense :: !License
,packageFiles :: !GetPackageFiles
,packageDeps :: !(Map PackageName VersionRange)
,packageTools :: ![Dependency]
,packageAllDeps :: !(Set PackageName)
,packageGhcOptions :: ![Text]
,packageFlags :: !(Map FlagName Bool)
,packageDefaultFlags :: !(Map FlagName Bool)
,packageHasLibrary :: !Bool
,packageTests :: !(Map Text TestSuiteInterface)
,packageBenchmarks :: !(Set Text)
,packageExes :: !(Set Text)
,packageOpts :: !GetPackageOpts
,packageHasExposedModules :: !Bool
,packageSimpleType :: !Bool
,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 m. (StackM env m, HasEnvConfig env)
=> SourceMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> m (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 m env. (StackM env m, HasEnvConfig env)
=> Path Abs File
-> m (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
,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
= PSLocal LocalPackage
| PSUpstream Version InstallLocation (Map FlagName Bool) [Text] (Maybe GitSHA1)
deriving Show
instance PackageInstallInfo PackageSource where
piiVersion (PSLocal lp) = packageVersion $ lpPackage lp
piiVersion (PSUpstream v _ _ _ _) = v
piiLocation (PSLocal _) = Local
piiLocation (PSUpstream _ loc _ _ _) = loc
class PackageInstallInfo a where
piiVersion :: a -> Version
piiLocation :: a -> InstallLocation
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))
, lpNewBuildCache :: !(Map FilePath FileCacheInfo)
, lpFiles :: !(Set (Path Abs File))
}
deriving Show
data NamedComponent
= CLib
| CExe !Text
| CTest !Text
| CBench !Text
deriving (Show, Eq, Ord)
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
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 | Executable PackageIdentifier
deriving (Show, Eq, Ord)
installedPackageIdentifier :: Installed -> PackageIdentifier
installedPackageIdentifier (Library pid _) = pid
installedPackageIdentifier (Executable pid) = pid
installedVersion :: Installed -> Version
installedVersion = packageIdentifierVersion . installedPackageIdentifier