Util.hs 3.46 KB
Newer Older
1
{-# LANGUAGE NoImplicitPrelude #-}
Andrey Mokhov's avatar
Andrey Mokhov committed
2

Andrey Mokhov's avatar
Andrey Mokhov committed
3
module Settings.Util (
4
    -- Primitive settings elements
Andrey Mokhov's avatar
Andrey Mokhov committed
5
    arg, argM, args,
6
    argConfig, argStagedConfig, argConfigList, argStagedConfigList,
Andrey Mokhov's avatar
Andrey Mokhov committed
7
    ccArgs,
8
9
10
11
12
13
    -- argBuilderPath, argStagedBuilderPath,
    -- argPackageKey, argPackageDeps, argPackageDepKeys, argSrcDirs,
    -- argIncludeDirs, argDepIncludeDirs,
    -- argConcat, argConcatPath, argConcatSpace,
    -- argPairs, argPrefix, argPrefixPath,
    -- argPackageConstraints,
Andrey Mokhov's avatar
Andrey Mokhov committed
14
15
    ) where

16
17
18
19
20
import Base hiding (Args, arg, args)
import Oracles hiding (not)
import Expression

-- A single argument
21
arg :: String -> Settings
Andrey Mokhov's avatar
Andrey Mokhov committed
22
23
24
25
arg = append . return

argM :: Action String -> Settings
argM = appendM . fmap return
26
27

-- A list of arguments
28
args :: [String] -> Settings
Andrey Mokhov's avatar
Andrey Mokhov committed
29
args = append
30

31
argConfig :: String -> Settings
Andrey Mokhov's avatar
Andrey Mokhov committed
32
argConfig = appendM . fmap return . askConfig
33

34
argConfigList :: String -> Settings
Andrey Mokhov's avatar
Andrey Mokhov committed
35
argConfigList = appendM . fmap words . askConfig
36
37
38
39

stagedKey :: Stage -> String -> String
stagedKey stage key = key ++ "-stage" ++ show stage

40
argStagedConfig :: String -> Settings
41
42
43
44
argStagedConfig key = do
    stage <- asks getStage
    argConfig (stagedKey stage key)

45
argStagedConfigList :: String -> Settings
46
47
48
49
argStagedConfigList key = do
    stage <- asks getStage
    argConfigList (stagedKey stage key)

50
-- Pass arguments to Gcc and corresponding lists of sub-arguments of GhcCabal
Andrey Mokhov's avatar
Andrey Mokhov committed
51
52
ccArgs :: [String] -> Settings
ccArgs args = do
53
54
    stage <- asks getStage
    mconcat [ builder (Gcc stage) ? append args
55
56
            , builder GhcCabal    ? appendSub "--configure-option=CFLAGS" args
            , builder GhcCabal    ? appendSub "--gcc-options" args ]
57

58
59
60
61




62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
-- packageData :: Arity -> String -> Settings
-- packageData arity key =
--     return $ EnvironmentParameter $ PackageData arity key Nothing Nothing

-- -- Accessing key value pairs from package-data.mk files
-- argPackageKey :: Settings
-- argPackageKey = packageData Single "PACKAGE_KEY"

-- argPackageDeps :: Settings
-- argPackageDeps = packageData Multiple "DEPS"

-- argPackageDepKeys :: Settings
-- argPackageDepKeys = packageData Multiple "DEP_KEYS"

-- argSrcDirs :: Settings
-- argSrcDirs = packageData Multiple "HS_SRC_DIRS"

-- argIncludeDirs :: Settings
-- argIncludeDirs = packageData Multiple "INCLUDE_DIRS"

-- argDepIncludeDirs :: Settings
-- argDepIncludeDirs = packageData Multiple "DEP_INCLUDE_DIRS_SINGLE_QUOTED"

-- argPackageConstraints :: Packages -> Settings
-- argPackageConstraints = return . EnvironmentParameter . PackageConstraints

-- -- Concatenate arguments: arg1 ++ arg2 ++ ...
-- argConcat :: Settings -> Settings
-- argConcat = return . Fold Concat

-- -- </>-concatenate arguments: arg1 </> arg2 </> ...
-- argConcatPath :: Settings -> Settings
-- argConcatPath = return . Fold ConcatPath

-- -- Concatene arguments (space separated): arg1 ++ " " ++ arg2 ++ ...
-- argConcatSpace :: Settings -> Settings
-- argConcatSpace = return . Fold ConcatSpace

-- -- An ordered list of pairs of arguments: prefix |> arg1, prefix |> arg2, ...
-- argPairs :: String -> Settings -> Settings
-- argPairs prefix settings = settings >>= (arg prefix |>) . return

-- -- An ordered list of prefixed arguments: prefix ++ arg1, prefix ++ arg2, ...
-- argPrefix :: String -> Settings -> Settings
-- argPrefix prefix = fmap (Fold Concat . (arg prefix |>) . return)

-- -- An ordered list of prefixed arguments: prefix </> arg1, prefix </> arg2, ...
-- argPrefixPath :: String -> Settings -> Settings
-- argPrefixPath prefix = fmap (Fold ConcatPath . (arg prefix |>) . return)