module Distribution.Simple.HaskellSuite where
import Prelude ()
import Distribution.Compat.Prelude
import qualified Data.List.NonEmpty as NE
import Distribution.Simple.Program
import Distribution.Simple.Compiler
import Distribution.Simple.Utils
import Distribution.Simple.BuildPaths
import Distribution.Verbosity
import Distribution.Version
import Distribution.Pretty
import Distribution.Parsec (simpleParsec)
import Distribution.Package
import Distribution.InstalledPackageInfo hiding (includeDirs)
import Distribution.Simple.PackageIndex as PackageIndex
import Distribution.PackageDescription
import Distribution.Simple.LocalBuildInfo
import Distribution.System (Platform)
import Language.Haskell.Extension
import Distribution.Simple.Program.Builtin
configure
:: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb)
configure verbosity mbHcPath hcPkgPath progdb0 = do
hcPath <-
let msg = "You have to provide name or path of a haskell-suite tool (-w PATH)"
in maybe (die' verbosity msg) return mbHcPath
when (isJust hcPkgPath) $
warn verbosity "--with-hc-pkg option is ignored for haskell-suite"
(comp, confdCompiler, progdb1) <- configureCompiler hcPath progdb0
(confdPkg, _) <- requireProgram verbosity haskellSuitePkgProgram progdb1
let progdb2 =
updateProgram
confdPkg
{ programLocation = programLocation confdCompiler
, programDefaultArgs = ["pkg"]
}
progdb1
return (comp, Nothing, progdb2)
where
configureCompiler hcPath progdb0' = do
let
haskellSuiteProgram' =
haskellSuiteProgram
{ programFindLocation = \v p -> findProgramOnSearchPath v p hcPath }
progdb1 <- configureProgram verbosity haskellSuiteProgram' progdb0'
(confdCompiler, progdb2) <- requireProgram verbosity haskellSuiteProgram' progdb1
extensions <- getExtensions verbosity confdCompiler
languages <- getLanguages verbosity confdCompiler
(compName, compVersion) <-
getCompilerVersion verbosity confdCompiler
let
comp = Compiler {
compilerId = CompilerId (HaskellSuite compName) compVersion,
compilerAbiTag = NoAbiTag,
compilerCompat = [],
compilerLanguages = languages,
compilerExtensions = extensions,
compilerProperties = mempty
}
return (comp, confdCompiler, progdb2)
hstoolVersion :: Verbosity -> FilePath -> IO (Maybe Version)
hstoolVersion = findProgramVersion "--hspkg-version" id
numericVersion :: Verbosity -> FilePath -> IO (Maybe Version)
numericVersion = findProgramVersion "--compiler-version" (fromMaybe "" . safeLast . words)
getCompilerVersion :: Verbosity -> ConfiguredProgram -> IO (String, Version)
getCompilerVersion verbosity prog = do
output <- rawSystemStdout verbosity (programPath prog) ["--compiler-version"]
let
parts = words output
name = concat $ safeInit parts
versionStr = fromMaybe "" $ safeLast parts
version <-
maybe (die' verbosity "haskell-suite: couldn't determine compiler version") return $
simpleParsec versionStr
return (name, version)
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Maybe CompilerFlag)]
getExtensions verbosity prog = do
extStrs <-
lines `fmap`
rawSystemStdout verbosity (programPath prog) ["--supported-extensions"]
return
[ (ext, Just $ "-X" ++ prettyShow ext) | Just ext <- map simpleParsec extStrs ]
getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, CompilerFlag)]
getLanguages verbosity prog = do
langStrs <-
lines `fmap`
rawSystemStdout verbosity (programPath prog) ["--supported-languages"]
return
[ (ext, "-G" ++ prettyShow ext) | Just ext <- map simpleParsec langStrs ]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages verbosity packagedbs progdb =
liftM (PackageIndex.fromList . concat) $ for packagedbs $ \packagedb ->
do str <-
getDbProgramOutput verbosity haskellSuitePkgProgram progdb
["dump", packageDbOpt packagedb]
`catchExit` \_ -> die' verbosity $ "pkg dump failed"
case parsePackages str of
Right ok -> return ok
_ -> die' verbosity "failed to parse output of 'pkg dump'"
where
parsePackages str =
case partitionEithers $ map (parseInstalledPackageInfo . toUTF8BS) (splitPkgs str) of
([], ok) -> Right [ pkg | (_, pkg) <- ok ]
(msgss, _) -> Left (foldMap NE.toList msgss)
splitPkgs :: String -> [String]
splitPkgs = map unlines . splitWith ("---" ==) . lines
where
splitWith :: (a -> Bool) -> [a] -> [[a]]
splitWith p xs = ys : case zs of
[] -> []
_:ws -> splitWith p ws
where (ys,zs) = break p xs
buildLib
:: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity pkg_descr lbi lib clbi = do
let odir = buildDir lbi
bi = libBuildInfo lib
srcDirs = hsSourceDirs bi ++ [odir]
dbStack = withPackageDB lbi
language = fromMaybe Haskell98 (defaultLanguage bi)
progdb = withPrograms lbi
pkgid = packageId pkg_descr
runDbProgram verbosity haskellSuiteProgram progdb $
[ "compile", "--build-dir", odir ] ++
concat [ ["-i", d] | d <- srcDirs ] ++
concat [ ["-I", d] | d <- [autogenComponentModulesDir lbi clbi
,autogenPackageModulesDir lbi
,odir] ++ includeDirs bi ] ++
[ packageDbOpt pkgDb | pkgDb <- dbStack ] ++
[ "--package-name", prettyShow pkgid ] ++
concat [ ["--package-id", prettyShow ipkgid ]
| (ipkgid, _) <- componentPackageDeps clbi ] ++
["-G", prettyShow language] ++
concat [ ["-X", prettyShow ex] | ex <- usedExtensions bi ] ++
cppOptions (libBuildInfo lib) ++
[ prettyShow modu | modu <- allLibModules lib clbi ]
installLib
:: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib verbosity lbi targetDir dynlibTargetDir builtDir pkg lib clbi = do
let progdb = withPrograms lbi
runDbProgram verbosity haskellSuitePkgProgram progdb $
[ "install-library"
, "--build-dir", builtDir
, "--target-dir", targetDir
, "--dynlib-target-dir", dynlibTargetDir
, "--package-id", prettyShow $ packageId pkg
] ++ map prettyShow (allLibModules lib clbi)
registerPackage
:: Verbosity
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> IO ()
registerPackage verbosity progdb packageDbs installedPkgInfo = do
(hspkg, _) <- requireProgram verbosity haskellSuitePkgProgram progdb
runProgramInvocation verbosity $
(programInvocation hspkg
["update", packageDbOpt $ registrationPackageDB packageDbs])
{ progInvokeInput = Just $ IODataText $ showInstalledPackageInfo installedPkgInfo }
initPackageDB :: Verbosity -> ProgramDb -> FilePath -> IO ()
initPackageDB verbosity progdb dbPath =
runDbProgram verbosity haskellSuitePkgProgram progdb
["init", dbPath]
packageDbOpt :: PackageDB -> String
packageDbOpt GlobalPackageDB = "--global"
packageDbOpt UserPackageDB = "--user"
packageDbOpt (SpecificPackageDB db) = "--package-db=" ++ db