Commit 4e5f1b74 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Move generic helper functions to Util.hs.

parent 9d1a489b
......@@ -9,8 +9,7 @@ module Base (
Stage (..),
Args, arg,
joinArgs, joinArgsWithSpaces,
filterOut,
replaceChar
filterOut
) where
import Development.Shake hiding ((*>))
......@@ -43,8 +42,3 @@ joinArgs = intercalateArgs ""
filterOut :: Args -> [String] -> Args
filterOut args list = filter (`notElem` list) <$> args
replaceChar :: Char -> Char -> String -> String
replaceChar from to = (go from) . if from == '/' then go '\\' else id
where
go from' = map (\c -> if c == from' then to else c)
......@@ -20,8 +20,8 @@ import Control.Monad hiding (when, unless)
import qualified Data.HashMap.Strict as M
import qualified Prelude
import Prelude hiding (not, (&&), (||))
import Data.Char
import Base
import Util
import Config
data Builder = Ar | Ld | Gcc | Alex | Happy | HsColour | GhcCabal | GhcPkg Stage | Ghc Stage
......@@ -241,7 +241,6 @@ instance ToCondition a => AndOr Flag a where
newtype ConfigKey = ConfigKey String deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
askConfigWithDefault :: String -> Action String -> Action String
askConfigWithDefault key defaultAction = do
maybeValue <- askOracle $ ConfigKey key
......@@ -266,20 +265,20 @@ packagaDataOptionWithDefault file key defaultAction = do
Just value -> return value
Nothing -> do
result <- defaultAction
return result
return result -- TODO: simplify
data PackageDataKey = Modules | SrcDirs
packagaDataOption :: FilePath -> PackageDataKey -> Action String
packagaDataOption file key = do
let keyName = replaceChar '/' '_' $ takeDirectory file ++ case key of
let keyName = replaceIf isSlash '_' $ takeDirectory file ++ case key of
Modules -> "_MODULES"
SrcDirs -> "_HS_SRC_DIRS"
packagaDataOptionWithDefault file keyName $ error $ "\nCannot find key '"
++ keyName
++ "' in "
++ file
++ "."
++ "." -- TODO: Improve formatting
oracleRules :: Rules ()
......
......@@ -4,6 +4,7 @@ module Package (
) where
import Base
import Util
import Ways
import Oracles
......@@ -129,7 +130,7 @@ buildPackageData pkg @ (Package name path _) (stage, dist, settings) =
when (registerPackage settings) $ run (GhcPkg stage) ghcPkgArgs
let pkgDataFile = path </> dist </> "package-data.mk"
pkgData <- lines <$> liftIO (readFile pkgDataFile)
length pkgData `seq` writeFileLines pkgDataFile $ map (replaceChar '/' '_') $ filter ('$' `notElem`) pkgData
length pkgData `seq` writeFileLines pkgDataFile $ map (replaceIf isSlash '_') $ filter ('$' `notElem`) pkgData
where
cabalArgs, ghcPkgArgs :: Args
cabalArgs = mconcat
......@@ -225,7 +226,7 @@ buildPackageDeps pkg @ (Package name path _) (stage, dist, settings) =
autogen = dist </> "build" </> "autogen"
mods <- words <$> packagaDataOption pkgData Modules
src <- getDirectoryFiles "" $ do
start <- map (replaceChar '.' '/') mods
start <- map (replaceEq '.' '/') mods
end <- [".hs", ".lhs"]
return $ path ++ "//" ++ start ++ end
run (Ghc stage) $ mconcat
......
module Util (
module Data.Char,
isSlash,
replaceIf, replaceEq
) where
import Data.Char
isSlash :: Char -> Bool
isSlash = (`elem` ['/', '\\'])
replaceIf :: (a -> Bool) -> a -> [a] -> [a]
replaceIf p to = map (\from -> if p from then to else from)
replaceEq :: Eq a => a -> a -> [a] -> [a]
replaceEq from = replaceIf (== from)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment