module Distribution.Simple.JHC (
configure, getInstalledPackages,
buildLib, buildExe,
installLib, installExe
) where
import Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(..), Executable(..)
, Library(..), libModules, hcOptions, usedExtensions )
import Distribution.InstalledPackageInfo
( emptyInstalledPackageInfo, )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.Simple.PackageIndex (PackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
import Distribution.Simple.BuildPaths
( autogenModulesDir, exeExtension )
import Distribution.Simple.Compiler
( CompilerFlavor(..), CompilerId(..), Compiler(..)
, PackageDBStack, Flag, languageToFlags, extensionsToFlags )
import Language.Haskell.Extension
( Language(Haskell98), Extension(..), KnownExtension(..))
import Distribution.Simple.Program
( ConfiguredProgram(..), jhcProgram, ProgramConfiguration
, userMaybeSpecifyPath, requireProgramVersion, lookupProgram
, rawSystemProgram, rawSystemProgramStdoutConf )
import Distribution.Version
( Version(..), orLaterVersion )
import Distribution.Package
( Package(..), InstalledPackageId(InstalledPackageId),
pkgName, pkgVersion, )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, writeFileAtomic
, installOrdinaryFile, installExecutableFile
, intercalate )
import System.FilePath ( (</>) )
import Distribution.Verbosity
import Distribution.Text
( Text(parse), display )
import Distribution.Compat.ReadP
( readP_to_S, string, skipSpaces )
import Data.List ( nub )
import Data.Char ( isSpace )
import Data.Maybe ( fromMaybe )
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramConfiguration -> IO (Compiler, ProgramConfiguration)
configure verbosity hcPath _hcPkgPath conf = do
(jhcProg, _, conf') <- requireProgramVersion ::
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity
jhcProgram :: ProgramjhcProgram (orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [0,7,2] [] :: [a][]))
(userMaybeSpecifyPath ::
String -> Maybe FilePath -> ProgramDb -> ProgramDbuserMaybeSpecifyPath "jhc" hcPath :: Maybe FilePathhcPath conf :: ProgramConfigurationconf)
let Just version = programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion jhcProg :: ConfiguredProgramjhcProg
comp = Compiler {
compilerId = CompilerId :: CompilerFlavor -> Version -> CompilerIdCompilerId JHC :: CompilerFlavorJHC version :: Versionversion,
compilerLanguages = jhcLanguages :: [(Language, Flag)]jhcLanguages,
compilerExtensions = jhcLanguageExtensions :: [(Extension, Flag)]jhcLanguageExtensions
}
return :: Monad m => forall a. a -> m areturn (comp :: Compilercomp, conf' :: ProgramDbconf')
jhcLanguages :: [(Language, Flag)]
jhcLanguages = [(Haskell98 :: LanguageHaskell98, "")]
jhcLanguageExtensions :: [(Extension, Flag)]
jhcLanguageExtensions =
[(EnableExtension :: KnownExtension -> ExtensionEnableExtension TypeSynonymInstances :: KnownExtensionTypeSynonymInstances , "")
,(DisableExtension :: KnownExtension -> ExtensionDisableExtension TypeSynonymInstances :: KnownExtensionTypeSynonymInstances , "")
,(EnableExtension :: KnownExtension -> ExtensionEnableExtension ForeignFunctionInterface :: KnownExtensionForeignFunctionInterface , "")
,(DisableExtension :: KnownExtension -> ExtensionDisableExtension ForeignFunctionInterface :: KnownExtensionForeignFunctionInterface , "")
,(EnableExtension :: KnownExtension -> ExtensionEnableExtension ImplicitPrelude :: KnownExtensionImplicitPrelude , "")
,(DisableExtension :: KnownExtension -> ExtensionDisableExtension ImplicitPrelude :: KnownExtensionImplicitPrelude , "--noprelude")
,(EnableExtension :: KnownExtension -> ExtensionEnableExtension CPP :: KnownExtensionCPP , "-fcpp")
,(DisableExtension :: KnownExtension -> ExtensionDisableExtension CPP :: KnownExtensionCPP , "-fno-cpp")
]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
getInstalledPackages verbosity _packageDBs conf = do
str <- rawSystemProgramStdoutConf ::
Verbosity
-> Program
-> ProgramConfiguration
-> [ProgArg]
-> IO StringrawSystemProgramStdoutConf verbosity :: Verbosityverbosity jhcProgram :: ProgramjhcProgram conf :: ProgramConfigurationconf ["--list-libraries"]
let pCheck :: [(a, String)] -> [a]
pCheck rs = [ r :: ar | (r,s) <- rs :: [(a, String)]rs, all :: (a -> Bool) -> [a] -> Boolall isSpace :: Char -> BoolisSpace s :: Strings ]
let parseLine ln =
pCheck :: [(a, String)] -> [a]pCheck (readP_to_S :: ReadP a a -> ReadS areadP_to_S
(skipSpaces :: ReadP r ()skipSpaces (>>) :: Monad m => forall a b. m a -> m b -> m b>> string :: String -> ReadP r Stringstring "Name:" (>>) :: Monad m => forall a b. m a -> m b -> m b>> skipSpaces :: ReadP r ()skipSpaces (>>) :: Monad m => forall a b. m a -> m b -> m b>> parse :: Text a => forall r. ReadP r aparse) ln :: Stringln)
return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$
fromList :: [InstalledPackageInfo] -> PackageIndexPackageIndex.fromList ($) :: (a -> b) -> a -> b$
map :: (a -> b) -> [a] -> [b]map (\p -> emptyInstalledPackageInfo :: InstalledPackageInfo_ memptyInstalledPackageInfo {
InstalledPackageInfo.installedPackageId =
InstalledPackageId :: String -> InstalledPackageIdInstalledPackageId (display :: Text a => a -> Stringdisplay p :: PackageIdp),
InstalledPackageInfo.sourcePackageId = p :: PackageIdp
}) ($) :: (a -> b) -> a -> b$
concatMap :: (a -> [b]) -> [a] -> [b]concatMap parseLine :: Text a => String -> [a]parseLine ($) :: (a -> b) -> a -> b$
lines :: String -> [String]lines str :: Stringstr
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity pkg_descr lbi lib clbi = do
let Just jhcProg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram jhcProgram :: ProgramjhcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
let libBi = libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib
let args = constructJHCCmdLine ::
LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [String]constructJHCCmdLine lbi :: LocalBuildInfolbi libBi :: BuildInfolibBi clbi :: ComponentLocalBuildInfoclbi (buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi) verbosity :: Verbosityverbosity
let pkgid = display :: Text a => a -> Stringdisplay (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg_descr :: PackageDescriptionpkg_descr)
pfile = buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> "jhc-pkg.conf"
hlfile= buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> (pkgid :: Stringpkgid (++) :: [a] -> [a] -> [a]++ ".hl")
writeFileAtomic :: FilePath -> String -> IO ()writeFileAtomic pfile :: FilePathpfile ($) :: (a -> b) -> a -> b$ jhcPkgConf :: PackageDescription -> StringjhcPkgConf pkg_descr :: PackageDescriptionpkg_descr
rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity jhcProg :: ConfiguredProgramjhcProg ($) :: (a -> b) -> a -> b$
["--build-hl="(++) :: [a] -> [a] -> [a]++pfile :: FilePathpfile, "-o", hlfile :: FilePathhlfile] (++) :: [a] -> [a] -> [a]++
args :: [String]args (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay (libModules :: Library -> [ModuleName]libModules lib :: Librarylib)
buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe verbosity _pkg_descr lbi exe clbi = do
let Just jhcProg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram jhcProgram :: ProgramjhcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
let exeBi = buildInfo :: Executable -> BuildInfobuildInfo exe :: Executableexe
let out = buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> exeName :: Executable -> StringexeName exe :: Executableexe
let args = constructJHCCmdLine ::
LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Verbosity
-> [String]constructJHCCmdLine lbi :: LocalBuildInfolbi exeBi :: BuildInfoexeBi clbi :: ComponentLocalBuildInfoclbi (buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi) verbosity :: Verbosityverbosity
rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity jhcProg :: ConfiguredProgramjhcProg (["-o",out :: FilePathout] (++) :: [a] -> [a] -> [a]++ args :: [String]args (++) :: [a] -> [a] -> [a]++ [modulePath :: Executable -> FilePathmodulePath exe :: Executableexe])
constructJHCCmdLine :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> Verbosity -> [String]
constructJHCCmdLine lbi bi clbi _odir verbosity =
(if verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= deafening :: Verbositydeafening then ["-v"] else [] :: [a][])
(++) :: [a] -> [a] -> [a]++ hcOptions :: CompilerFlavor -> BuildInfo -> [String]hcOptions JHC :: CompilerFlavorJHC bi :: BuildInfobi
(++) :: [a] -> [a] -> [a]++ languageToFlags :: Compiler -> Maybe Language -> [Flag]languageToFlags (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (defaultLanguage :: BuildInfo -> Maybe LanguagedefaultLanguage bi :: BuildInfobi)
(++) :: [a] -> [a] -> [a]++ extensionsToFlags :: Compiler -> [Extension] -> [Flag]extensionsToFlags (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (usedExtensions :: BuildInfo -> [Extension]usedExtensions bi :: BuildInfobi)
(++) :: [a] -> [a] -> [a]++ ["--noauto","-i-"]
(++) :: [a] -> [a] -> [a]++ concat :: [[a]] -> [a]concat [["-i", l :: FilePathl] | l <- nub :: Eq a => [a] -> [a]nub (hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi)]
(++) :: [a] -> [a] -> [a]++ ["-i", autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi]
(++) :: [a] -> [a] -> [a]++ ["-optc" (++) :: [a] -> [a] -> [a]++ opt :: Stringopt | opt <- ccOptions :: BuildInfo -> [String]PD.ccOptions bi :: BuildInfobi]
(++) :: [a] -> [a] -> [a]++ (concat :: [[a]] -> [a]concat [ ["-p", display :: Text a => a -> Stringdisplay (pkgName :: PackageIdentifier -> PackageNamepkgName pkgid :: Stringpkgid)]
| (_, pkgid) <- componentPackageDeps ::
ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]componentPackageDeps clbi :: ComponentLocalBuildInfoclbi ])
jhcPkgConf :: PackageDescription -> String
jhcPkgConf pd =
let sline name sel = name :: [Char]name (++) :: [a] -> [a] -> [a]++ ": "(++) :: [a] -> [a] -> [a]++sel :: PackageDescription -> [Char]sel pd :: PackageDescriptionpd
lib = fromMaybe :: a -> Maybe a -> afromMaybe (error :: [Char] -> aerror "no library available") (.) :: (b -> c) -> (a -> b) -> a -> c. library :: PackageDescription -> Maybe Librarylibrary
comma = intercalate :: [a] -> [[a]] -> [a]intercalate "," (.) :: (b -> c) -> (a -> b) -> a -> c. map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay
in unlines :: [String] -> Stringunlines [sline :: [Char] -> (PackageDescription -> [Char]) -> [Char]sline "name" (display :: Text a => a -> Stringdisplay (.) :: (b -> c) -> (a -> b) -> a -> c. pkgName :: PackageIdentifier -> PackageNamepkgName (.) :: (b -> c) -> (a -> b) -> a -> c. packageId :: Package pkg => pkg -> PackageIdentifierpackageId)
,sline :: [Char] -> (PackageDescription -> [Char]) -> [Char]sline "version" (display :: Text a => a -> Stringdisplay (.) :: (b -> c) -> (a -> b) -> a -> c. pkgVersion :: PackageIdentifier -> VersionpkgVersion (.) :: (b -> c) -> (a -> b) -> a -> c. packageId :: Package pkg => pkg -> PackageIdentifierpackageId)
,sline :: [Char] -> (PackageDescription -> [Char]) -> [Char]sline "exposed-modules" (comma :: [ModuleName] -> [Char]comma (.) :: (b -> c) -> (a -> b) -> a -> c. exposedModules :: Library -> [ModuleName]PD.exposedModules (.) :: (b -> c) -> (a -> b) -> a -> c. lib :: Librarylib)
,sline :: [Char] -> (PackageDescription -> [Char]) -> [Char]sline "hidden-modules" (comma :: [ModuleName] -> [Char]comma (.) :: (b -> c) -> (a -> b) -> a -> c. otherModules :: BuildInfo -> [ModuleName]otherModules (.) :: (b -> c) -> (a -> b) -> a -> c. libBuildInfo :: Library -> BuildInfolibBuildInfo (.) :: (b -> c) -> (a -> b) -> a -> c. lib :: Librarylib)
]
installLib :: Verbosity -> FilePath -> FilePath -> PackageDescription -> Library -> IO ()
installLib verb dest build_dir pkg_descr _ = do
let p = display :: Text a => a -> Stringdisplay (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg_descr :: PackageDescriptionpkg_descr)(++) :: [a] -> [a] -> [a]++".hl"
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verb :: Verbosityverb True :: BoolTrue dest :: FilePathdest
installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()installOrdinaryFile verb :: Verbosityverb (build_dir :: FilePathbuild_dir (</>) :: FilePath -> FilePath -> FilePath</> p :: PackageIdp) (dest :: FilePathdest (</>) :: FilePath -> FilePath -> FilePath</> p :: PackageIdp)
installExe :: Verbosity -> FilePath -> FilePath -> (FilePath,FilePath) -> PackageDescription -> Executable -> IO ()
installExe verb dest build_dir (progprefix,progsuffix) _ exe = do
let exe_name = exeName :: Executable -> StringexeName exe :: Executableexe
src = exe_name :: Stringexe_name (</>) :: FilePath -> FilePath -> FilePath</> exeExtension :: StringexeExtension
out = (progprefix :: FilePathprogprefix (++) :: [a] -> [a] -> [a]++ exe_name :: Stringexe_name (++) :: [a] -> [a] -> [a]++ progsuffix :: FilePathprogsuffix) (</>) :: FilePath -> FilePath -> FilePath</> exeExtension :: StringexeExtension
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verb :: Verbosityverb True :: BoolTrue dest :: FilePathdest
installExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()installExecutableFile verb :: Verbosityverb (build_dir :: FilePathbuild_dir (</>) :: FilePath -> FilePath -> FilePath</> src :: FilePathsrc) (dest :: FilePathdest (</>) :: FilePath -> FilePath -> FilePath</> out :: FilePathout)