Cabal/src/Distribution/Simple/HaskellSuite.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE RankNTypes #-}
   3
   4 module Distribution.Simple.HaskellSuite where
   5
   6 import Distribution.Compat.Prelude
   7 import Prelude ()
   8
   9 import qualified Data.List.NonEmpty as NE
  10
  11 import Distribution.InstalledPackageInfo hiding (includeDirs)
  12 import Distribution.Package
  13 import Distribution.PackageDescription
  14 import Distribution.Parsec (simpleParsec)
  15 import Distribution.Pretty
  16 import Distribution.Simple.BuildPaths
  17 import Distribution.Simple.Compiler
  18 import Distribution.Simple.Errors
  19 import Distribution.Simple.LocalBuildInfo
  20 import Distribution.Simple.PackageIndex as PackageIndex
  21 import Distribution.Simple.Program
  22 import Distribution.Simple.Program.Builtin
  23 import Distribution.Simple.Utils
  24 import Distribution.System (Platform)
  25 import Distribution.Utils.Path
  26 import Distribution.Verbosity
  27 import Distribution.Version
  28 import Language.Haskell.Extension
  29
  30 configure
  31   :: Verbosity
  32   -> Maybe FilePath
  33   -> Maybe FilePath
  34   -> ProgramDb
  35   -> IO (Compiler, Maybe Platform, ProgramDb)
  36 configure verbosity mbHcPath hcPkgPath progdb0 = do
  37   -- We have no idea how a haskell-suite tool is named, so we require at
  38   -- least some information from the user.
  39   hcPath <-
  40     let msg = "You have to provide name or path of a haskell-suite tool (-w PATH)"
  41      in maybe (dieWithException verbosity $ ProvideHaskellSuiteTool msg) return mbHcPath
  42
  43   when (isJust hcPkgPath) $
  44     warn verbosity "--with-hc-pkg option is ignored for haskell-suite"
  45
  46   (comp, confdCompiler, progdb1) <- configureCompiler hcPath progdb0
  47
  48   -- Update our pkg tool. It uses the same executable as the compiler, but
  49   -- all command start with "pkg"
  50   (confdPkg, _) <- requireProgram verbosity haskellSuitePkgProgram progdb1
  51   let progdb2 =
  52         updateProgram
  53           confdPkg
  54             { programLocation = programLocation confdCompiler
  55             , programDefaultArgs = ["pkg"]
  56             }
  57           progdb1
  58
  59   return (comp, Nothing, progdb2)
  60   where
  61     configureCompiler hcPath progdb0' = do
  62       let
  63         haskellSuiteProgram' =
  64           haskellSuiteProgram
  65             { programFindLocation = \v p -> findProgramOnSearchPath v p hcPath
  66             }
  67
  68       -- NB: cannot call requireProgram right away — it'd think that
  69       -- the program is already configured and won't reconfigure it again.
  70       -- Instead, call configureProgram directly first.
  71       progdb1 <- configureProgram verbosity haskellSuiteProgram' progdb0'
  72       (confdCompiler, progdb2) <- requireProgram verbosity haskellSuiteProgram' progdb1
  73
  74       extensions <- getExtensions verbosity confdCompiler
  75       languages <- getLanguages verbosity confdCompiler
  76       (compName, compVersion) <-
  77         getCompilerVersion verbosity confdCompiler
  78
  79       let
  80         comp =
  81           Compiler
  82             { compilerId = CompilerId (HaskellSuite compName) compVersion
  83             , compilerAbiTag = NoAbiTag
  84             , compilerCompat = []
  85             , compilerLanguages = languages
  86             , compilerExtensions = extensions
  87             , compilerProperties = mempty
  88             }
  89
  90       return (comp, confdCompiler, progdb2)
  91
  92 hstoolVersion :: Verbosity -> FilePath -> IO (Maybe Version)
  93 hstoolVersion = findProgramVersion "--hspkg-version" id
  94
  95 numericVersion :: Verbosity -> FilePath -> IO (Maybe Version)
  96 numericVersion = findProgramVersion "--compiler-version" (fromMaybe "" . safeLast . words)
  97
  98 getCompilerVersion :: Verbosity -> ConfiguredProgram -> IO (String, Version)
  99 getCompilerVersion verbosity prog = do
 100   output <- rawSystemStdout verbosity (programPath prog) ["--compiler-version"]
 101   let
 102     parts = words output
 103     name = concat $ safeInit parts -- there shouldn't be any spaces in the name anyway
 104     versionStr = fromMaybe "" $ safeLast parts
 105   version <-
 106     maybe
 107       (dieWithException verbosity CannotDetermineCompilerVersion)
 108       return
 109       $ simpleParsec versionStr
 110   return (name, version)
 111
 112 getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Maybe CompilerFlag)]
 113 getExtensions verbosity prog = do
 114   extStrs <-
 115     lines
 116       `fmap` rawSystemStdout verbosity (programPath prog) ["--supported-extensions"]
 117   return
 118     [(ext, Just $ "-X" ++ prettyShow ext) | Just ext <- map simpleParsec extStrs]
 119
 120 getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, CompilerFlag)]
 121 getLanguages verbosity prog = do
 122   langStrs <-
 123     lines
 124       `fmap` rawSystemStdout verbosity (programPath prog) ["--supported-languages"]
 125   return
 126     [(ext, "-G" ++ prettyShow ext) | Just ext <- map simpleParsec langStrs]
 127
 128 -- Other compilers do some kind of a packagedb stack check here. Not sure
 129 -- if we need something like that as well.
 130 getInstalledPackages
 131   :: Verbosity
 132   -> PackageDBStack
 133   -> ProgramDb
 134   -> IO InstalledPackageIndex
 135 getInstalledPackages verbosity packagedbs progdb =
 136   liftM (PackageIndex.fromList . concat) $ for packagedbs $ \packagedb ->
 137     do
 138       str <-
 139         getDbProgramOutput
 140           verbosity
 141           haskellSuitePkgProgram
 142           progdb
 143           ["dump", packageDbOpt packagedb]
 144           `catchExit` \_ -> dieWithException verbosity PkgDumpFailed
 145
 146       case parsePackages str of
 147         Right ok -> return ok
 148         _ -> dieWithException verbosity FailedToParseOutput
 149   where
 150     parsePackages str =
 151       case partitionEithers $ map (parseInstalledPackageInfo . toUTF8BS) (splitPkgs str) of
 152         ([], ok) -> Right [pkg | (_, pkg) <- ok]
 153         (msgss, _) -> Left (foldMap NE.toList msgss)
 154
 155     splitPkgs :: String -> [String]
 156     splitPkgs = map unlines . splitWith ("---" ==) . lines
 157       where
 158         splitWith :: (a -> Bool) -> [a] -> [[a]]
 159         splitWith p xs =
 160           ys : case zs of
 161             [] -> []
 162             _ : ws -> splitWith p ws
 163           where
 164             (ys, zs) = break p xs
 165
 166 buildLib
 167   :: Verbosity
 168   -> PackageDescription
 169   -> LocalBuildInfo
 170   -> Library
 171   -> ComponentLocalBuildInfo
 172   -> IO ()
 173 buildLib verbosity pkg_descr lbi lib clbi = do
 174   -- In future, there should be a mechanism for the compiler to request any
 175   -- number of the above parameters (or their parts) — in particular,
 176   -- pieces of PackageDescription.
 177   --
 178   -- For now, we only pass those that we know are used.
 179
 180   let odir = buildDir lbi
 181       bi = libBuildInfo lib
 182       srcDirs = map getSymbolicPath (hsSourceDirs bi) ++ [odir]
 183       dbStack = withPackageDB lbi
 184       language = fromMaybe Haskell98 (defaultLanguage bi)
 185       progdb = withPrograms lbi
 186       pkgid = packageId pkg_descr
 187
 188   runDbProgram verbosity haskellSuiteProgram progdb $
 189     ["compile", "--build-dir", odir]
 190       ++ concat [["-i", d] | d <- srcDirs]
 191       ++ concat
 192         [ ["-I", d]
 193         | d <-
 194             [ autogenComponentModulesDir lbi clbi
 195             , autogenPackageModulesDir lbi
 196             , odir
 197             ]
 198               ++ includeDirs bi
 199         ]
 200       ++ [packageDbOpt pkgDb | pkgDb <- dbStack]
 201       ++ ["--package-name", prettyShow pkgid]
 202       ++ concat
 203         [ ["--package-id", prettyShow ipkgid]
 204         | (ipkgid, _) <- componentPackageDeps clbi
 205         ]
 206       ++ ["-G", prettyShow language]
 207       ++ concat [["-X", prettyShow ex] | ex <- usedExtensions bi]
 208       ++ cppOptions (libBuildInfo lib)
 209       ++ [prettyShow modu | modu <- allLibModules lib clbi]
 210
 211 installLib
 212   :: Verbosity
 213   -> LocalBuildInfo
 214   -> FilePath
 215   -- ^ install location
 216   -> FilePath
 217   -- ^ install location for dynamic libraries
 218   -> FilePath
 219   -- ^ Build location
 220   -> PackageDescription
 221   -> Library
 222   -> ComponentLocalBuildInfo
 223   -> IO ()
 224 installLib verbosity lbi targetDir dynlibTargetDir builtDir pkg lib clbi = do
 225   let progdb = withPrograms lbi
 226   runDbProgram verbosity haskellSuitePkgProgram progdb $
 227     [ "install-library"
 228     , "--build-dir"
 229     , builtDir
 230     , "--target-dir"
 231     , targetDir
 232     , "--dynlib-target-dir"
 233     , dynlibTargetDir
 234     , "--package-id"
 235     , prettyShow $ packageId pkg
 236     ]
 237       ++ map prettyShow (allLibModules lib clbi)
 238
 239 registerPackage
 240   :: Verbosity
 241   -> ProgramDb
 242   -> PackageDBStack
 243   -> InstalledPackageInfo
 244   -> IO ()
 245 registerPackage verbosity progdb packageDbs installedPkgInfo = do
 246   (hspkg, _) <- requireProgram verbosity haskellSuitePkgProgram progdb
 247
 248   runProgramInvocation verbosity $
 249     ( programInvocation
 250         hspkg
 251         ["update", packageDbOpt $ registrationPackageDB packageDbs]
 252     )
 253       { progInvokeInput = Just $ IODataText $ showInstalledPackageInfo installedPkgInfo
 254       }
 255
 256 initPackageDB :: Verbosity -> ProgramDb -> FilePath -> IO ()
 257 initPackageDB verbosity progdb dbPath =
 258   runDbProgram
 259     verbosity
 260     haskellSuitePkgProgram
 261     progdb
 262     ["init", dbPath]
 263
 264 packageDbOpt :: PackageDB -> String
 265 packageDbOpt GlobalPackageDB = "--global"
 266 packageDbOpt UserPackageDB = "--user"
 267 packageDbOpt (SpecificPackageDB db) = "--package-db=" ++ db