Implement expression for GhcM builder.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Fri, 24 Jul 2015 03:13:30 +0000 (04:13 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Fri, 24 Jul 2015 03:13:30 +0000 (04:13 +0100)
src/Settings/Args.hs
src/Settings/GhcM.hs [new file with mode: 0644]
src/Settings/Util.hs

index 3031093..ed35b23 100644 (file)
@@ -3,6 +3,7 @@ module Settings.Args (
     ) where
 
 import Settings.User
+import Settings.GhcM
 import Settings.GhcPkg
 import Settings.GhcCabal
 import Expression
@@ -16,4 +17,5 @@ defaultArgs :: Args
 defaultArgs = mconcat
     [ cabalArgs
     , ghcPkgArgs
+    , ghcMArgs
     , customPackageArgs ]
diff --git a/src/Settings/GhcM.hs b/src/Settings/GhcM.hs
new file mode 100644 (file)
index 0000000..9e58cd5
--- /dev/null
@@ -0,0 +1,158 @@
+module Settings.GhcM (ghcMArgs) where
+
+import Way
+import Util
+import Stage
+import Builder
+import Package
+import Switches
+import Expression
+import Oracles.Flag
+import Oracles.PackageData
+import Settings.Util
+import Settings.Ways
+import Settings.TargetDirectory
+import Development.Shake
+
+ghcMArgs :: Args
+ghcMArgs = do
+    stage <- asks getStage
+    builder (GhcM stage) ? do
+        pkg     <- asks getPackage
+        cppArgs <- askPkgDataList CppArgs
+        hsArgs  <- askPkgDataList HsArgs
+        hsSrcs  <- askHsSources
+        ways    <- fromDiffExpr Settings.Ways.ways
+        let buildPath = unifyPath $ targetPath stage pkg </> "build"
+        mconcat
+            [ arg "-M"
+            , packageGhcArgs
+            , includeGhcArgs
+            , append . map ("-optP" ++) $ cppArgs
+            , arg $ "-odir " ++ buildPath
+            , arg $ "-stubdir " ++ buildPath
+            , arg $ "-hidir " ++ buildPath
+            , arg $ "-dep-makefile " ++ buildPath </> "haskell.deps"
+            , append . map (\way -> "-dep-suffix " ++ wayPrefix way) $ ways
+            , append hsArgs
+            , append hsSrcs ]
+
+packageGhcArgs :: Args
+packageGhcArgs = do
+    stage              <- asks getStage
+    supportsPackageKey <- lift . flag $ SupportsPackageKey
+    pkgKey             <- askPkgData     PackageKey
+    pkgDepKeys         <- askPkgDataList DepKeys
+    pkgDeps            <- askPkgDataList Deps
+    mconcat
+        [ arg "-hide-all-packages"
+        , arg "-no-user-package-db"
+        , arg "-include-pkg-deps"
+        , stage0 ? arg "-package-db libraries/bootstrapping.conf"
+        , if supportsPackageKey || stage /= Stage0
+          then mconcat [ arg $ "-this-package-key " ++ pkgKey
+                       , append . map ("-package-key " ++) $ pkgDepKeys ]
+          else mconcat [ arg $ "-package-name" ++ pkgKey
+                       , append . map ("-package " ++) $ pkgDeps ]]
+
+includeGhcArgs :: Args
+includeGhcArgs = do
+    stage       <- asks getStage
+    pkg         <- asks getPackage
+    srcDirs     <- askPkgDataList SrcDirs
+    includeDirs <- askPkgDataList IncludeDirs
+    let buildPath   = unifyPath $ targetPath stage pkg </> "build"
+        autogenPath = unifyPath $ buildPath </> "autogen"
+    mconcat
+        [ arg "-i"
+        , append . map (\dir -> "-i" ++ pkgPath pkg </> dir) $ srcDirs
+        , arg $ "-i" ++ buildPath
+        , arg $ "-i" ++ autogenPath
+        , arg $ "-I" ++ buildPath
+        , arg $ "-I" ++ autogenPath
+        , append . map (\dir -> "-I" ++ pkgPath pkg </> dir) $ includeDirs
+        , arg "-optP-include" -- TODO: Shall we also add -cpp?
+        , arg $ "-optP" ++ autogenPath </> "cabal_macros.h" ]
+
+askHsSources :: Expr [FilePath]
+askHsSources = do
+    stage   <- asks getStage
+    pkg     <- asks getPackage
+    srcDirs <- askPkgDataList SrcDirs
+    let autogenPath = unifyPath $ targetPath stage pkg </> "build/autogen"
+        dirs        = autogenPath : map (pkgPath pkg </>) srcDirs
+    askModuleFiles dirs [".hs", ".lhs"]
+
+askModuleFiles :: [FilePath] -> [String] -> Expr [FilePath]
+askModuleFiles directories suffixes = do
+    modules <- askPkgDataList Modules
+    let modPaths = map (replaceEq '.' pathSeparator) modules
+    files <- lift $ forM [ dir </> modPath ++ suffix
+                         | dir     <- directories
+                         , modPath <- modPaths
+                         , suffix  <- suffixes
+                         ] $ \file -> do
+                             let dir = takeDirectory file
+                             dirExists <- doesDirectoryExist dir
+                             return [ unifyPath file | dirExists ]
+    result <- lift $ getDirectoryFiles "" (concat files)
+    return $ map unifyPath result
+
+
+-- $1_$2_$3_ALL_CC_OPTS = \
+-- $$(WAY_$3_CC_OPTS) \
+-- $$($1_$2_DIST_GCC_CC_OPTS) \
+-- $$($1_$2_$3_CC_OPTS) \
+-- $$($$(basename $$<)_CC_OPTS) \
+-- $$($1_$2_EXTRA_CC_OPTS) \
+-- $$(EXTRA_CC_OPTS)
+--
+-- $1_$2_DIST_CC_OPTS = \
+-- $$(SRC_CC_OPTS) \
+-- $$($1_CC_OPTS) \
+-- -I$1/$2/build/autogen \
+-- $$(foreach dir,$$(filter-out /%,$$($1_$2_INCLUDE_DIRS)),-I$1/$$(dir)) \
+-- $$(foreach dir,$$(filter /%,$$($1_$2_INCLUDE_DIRS)),-I$$(dir)) \
+-- $$($1_$2_CC_OPTS) \
+-- $$($1_$2_CPP_OPTS) \
+-- $$($1_$2_CC_INC_FLAGS) \
+-- $$($1_$2_DEP_CC_OPTS) \
+-- $$(SRC_CC_WARNING_OPTS)
+
+-- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
+-- gccArgs :: FilePath -> Package -> TodoItem -> Args
+-- gccArgs sourceFile (Package _ path _ _) (stage, dist, settings) =
+--     let pathDist = path </> dist
+--         buildDir = pathDist </> "build"
+--         depFile  = buildDir </> takeFileName sourceFile <.> "deps"
+--     in args [ args ["-E", "-MM"] -- TODO: add a Cpp Builder instead
+--             , args $ CcArgs pathDist
+--             , commonCcArgs          -- TODO: remove?
+--             , customCcArgs settings -- TODO: Replace by customCppArgs?
+--             , commonCcWarninigArgs  -- TODO: remove?
+--             , includeGccArgs path dist
+--             , args ["-MF", unifyPath depFile]
+--             , args ["-x", "c"]
+--             , arg $ unifyPath sourceFile ]
+
+-- buildRule :: Package -> TodoItem -> Rules ()
+-- buildRule pkg @ (Package name path _ _) todo @ (stage, dist, settings) = do
+--     let pathDist = path </> dist
+--         buildDir = pathDist </> "build"
+
+--     (buildDir </> "haskell.deps") %> \_ -> do
+--         run (Ghc stage) $ ghcArgs pkg todo
+--         -- Finally, record the argument list
+--         need [argListPath argListDir pkg stage]
+
+--     (buildDir </> "c.deps") %> \out -> do
+--         srcs <- args $ CSrcs pathDist
+--         deps <- fmap concat $ forM srcs $ \src -> do
+--             let srcPath = path </> src
+--                 depFile = buildDir </> takeFileName src <.> "deps"
+--             run (Gcc stage) $ gccArgs srcPath pkg todo
+--             liftIO $ readFile depFile
+--         writeFileChanged out deps
+--         liftIO $ removeFiles buildDir ["*.c.deps"]
+--         -- Finally, record the argument list
+--         need [argListPath argListDir pkg stage]
index 5f0d035..74cb4e2 100644 (file)
@@ -2,6 +2,7 @@ module Settings.Util (
     -- Primitive settings elements
     arg, argPath, argM,
     argSetting, argSettingList,
+    askPkgData, askPkgDataList,
     appendCcArgs,
     needBuilder
     -- argBuilderPath, argStagedBuilderPath,
@@ -17,7 +18,9 @@ import Builder
 import Expression
 import Oracles.Base
 import Oracles.Setting
+import Oracles.PackageData
 import Settings.User
+import Settings.TargetDirectory
 
 -- A single argument.
 arg :: String -> Args
@@ -36,6 +39,20 @@ argSetting = argM . setting
 argSettingList :: SettingList -> Args
 argSettingList = appendM . settingList
 
+askPkgData :: (FilePath -> PackageData) -> Expr String
+askPkgData key = do
+    stage <- asks getStage
+    pkg   <- asks getPackage
+    let path = targetPath stage pkg
+    lift . pkgData . key $ path
+
+askPkgDataList :: (FilePath -> PackageDataList) -> Expr [String]
+askPkgDataList key = do
+    stage <- asks getStage
+    pkg   <- asks getPackage
+    let path = targetPath stage pkg
+    lift . pkgDataList . key $ path
+
 -- Pass arguments to Gcc and corresponding lists of sub-arguments of GhcCabal
 appendCcArgs :: [String] -> Args
 appendCcArgs xs = do