{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Stack.Types.Package where
import Control.DeepSeq
import Control.Exception hiding (try,catch)
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Logger (MonadLogger)
import Control.Monad.Reader
import Data.Binary
import Data.Binary.VersionTagged
import qualified Data.ByteString as S
import Data.Data
import Data.Function
import Data.List
import Data.Map.Strict (Map)
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Distribution.InstalledPackageInfo (PError)
import Distribution.ModuleName (ModuleName)
import Distribution.Package hiding (Package,PackageName,packageName,packageVersion,PackageIdentifier)
import Distribution.System (Platform (..))
import Distribution.Text (display)
import GHC.Generics
import Path as FL
import Prelude
import Stack.Types.Compiler
import Stack.Types.Config
import Stack.Types.FlagName
import Stack.Types.GhcPkgId
import Stack.Types.PackageName
import Stack.Types.PackageIdentifier
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) =
"No .cabal file found in directory " ++
toFilePath dir
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
,packageFiles :: !GetPackageFiles
,packageDeps :: !(Map PackageName VersionRange)
,packageTools :: ![Dependency]
,packageAllDeps :: !(Set PackageName)
,packageFlags :: !(Map FlagName Bool)
,packageHasLibrary :: !Bool
,packageTests :: !(Set Text)
,packageBenchmarks :: !(Set Text)
,packageExes :: !(Set Text)
,packageOpts :: !GetPackageOpts
,packageHasExposedModules :: !Bool
,packageSimpleType :: !Bool
,packageDefinedFlags :: !(Set FlagName)
}
deriving (Show,Typeable)
newtype GetPackageOpts = GetPackageOpts
{ getPackageOpts :: forall env m. (MonadIO m,HasEnvConfig env, HasPlatform env, MonadThrow m, MonadReader env m, MonadLogger m, MonadCatch m)
=> SourceMap
-> InstalledMap
-> [PackageName]
-> Path Abs File
-> m (Map NamedComponent (Set ModuleName)
,Map NamedComponent (Set DotCabalPath)
,Map NamedComponent [String],[String])
}
instance Show GetPackageOpts where
show _ = "<GetPackageOpts>"
data CabalFileType
= AllFiles
| Modules
newtype GetPackageFiles = GetPackageFiles
{ getPackageFiles :: forall m env. (MonadIO m, MonadLogger m, MonadThrow m, MonadCatch m, MonadReader env m, HasPlatform env, 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 (Path Abs File) (Maybe String) [ModuleName]
instance Show PackageWarning where
show (UnlistedModulesWarning cabalfp component [unlistedModule]) =
concat
[ "module not listed in "
, toFilePath (filename cabalfp)
, (case component of
Nothing -> " for library"
Just c -> " for '" ++ c ++ "'")
, " component (add to other-modules): "
, display unlistedModule]
show (UnlistedModulesWarning cabalfp component unlistedModules) =
concat
[ "modules not listed in "
, toFilePath (filename cabalfp)
, (case component of
Nothing -> " for library"
Just c -> " for '" ++ c ++ "'")
, " component (add to other-modules):\n "
, intercalate "\n " (map display unlistedModules)]
data PackageConfig =
PackageConfig {packageConfigEnableTests :: !Bool
,packageConfigEnableBenchmarks :: !Bool
,packageConfigFlags :: !(Map FlagName Bool)
,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)
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 LocalPackageTB = LocalPackageTB
{ lptbPackage :: !Package
, lptbTests :: !(Set Text)
, lptbBenches :: !(Set Text)
}
deriving Show
data LocalPackage = LocalPackage
{ lpPackage :: !Package
, lpTestDeps :: !(Map PackageName VersionRange)
, lpBenchDeps :: !(Map PackageName VersionRange)
, lpExeComponents :: !(Maybe (Set Text))
, lpTestBench :: !(Maybe LocalPackageTB)
, lpDir :: !(Path Abs Dir)
, lpCabalFile :: !(Path Abs File)
, lpDirtyFiles :: !(Maybe (Set FilePath))
, lpNewBuildCache :: !(Map FilePath FileCacheInfo)
, lpFiles :: !(Set (Path Abs File))
, lpComponents :: !(Set NamedComponent)
}
deriving Show
lpWanted :: LocalPackage -> Bool
lpWanted lp = isJust (lpExeComponents lp) || isJust (lpTestBench lp)
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
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)
instance Binary FileCacheInfo
instance HasStructuralInfo FileCacheInfo
instance NFData FileCacheInfo
newtype ModTime = ModTime (Integer,Rational)
deriving (Ord,Show,Generic,Eq,NFData,Binary)
instance HasStructuralInfo ModTime
instance HasSemanticVersion ModTime
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 (Version, InstallLocation, Installed)
data Installed = Library PackageIdentifier GhcPkgId | Executable PackageIdentifier
deriving (Show, Eq, Ord)