1module MakeUtils (
2    PortOptions(..)
3  , PortOptionAssignments(..)
4  , portOptionAssignments
5  , boolAssignments
6  , Assignment(..)
7  , mkAssignment
8  , fakeTrue
9  , fakeToFalse
10  , mkAssignments
11  , isFakeAssignment
12  , assignmentToBool
13
14  , CommandOutput(..)
15  , evaluateMakeVar
16  , executeMakeTargets
17  , listPortOptions
18  , optionArguments
19  , optionsCount
20  ) where
21
22import Control.Monad
23import Data.Char (isSpace)
24import Data.List (dropWhileEnd, sort)
25import qualified Data.Map as M
26import qualified Data.Text as T
27import System.Exit
28import System.Process
29
30
31data PortOptions = PortOptions
32  {
33      portOptionsPlain :: [String]
34    , portOptionsSingleGroups :: M.Map String [String]
35    , portOptionsRadioGroups :: M.Map String [String]
36    , portOptionsMultiGroups :: M.Map String [String]
37  } deriving Show
38
39data PortOptionAssignments = PortOptionAssignments
40  {
41      poaAllOptions :: [String]
42    , poaAssignments :: [[Assignment]]
43  } deriving (Eq, Show)
44
45portOptionAssignments opts bools = PortOptionAssignments opts (mkAssignments bools)
46
47boolAssignments :: PortOptionAssignments -> [[Bool]]
48boolAssignments = (map . map) assignmentToBool
49                  . filter (not . any isFakeAssignment)
50                  . poaAssignments
51
52-- A special Tribool type, necessary to handle RADIO group types
53-- See Panopticum.makeAssignments function
54data Assignment = AFalse
55                | ATrue
56                | AFakeTrue
57  deriving (Eq, Ord, Show, Read)
58
59mkAssignment False = AFalse
60mkAssignment True = ATrue
61
62mkAssignments :: [[Bool]] -> [[Assignment]]
63mkAssignments = (map . map) mkAssignment
64
65assignmentToBool AFalse = False
66assignmentToBool ATrue = True
67assignmentToBool AFakeTrue = error "assignmentToBool: AFakeTrue"
68
69fakeTrue ATrue = AFakeTrue
70fakeTrue x = x
71
72fakeToFalse AFakeTrue = AFalse
73fakeToFalse x = x
74
75isFakeAssignment AFakeTrue = True
76isFakeAssignment _ = False
77
78
79data CommandOutput = CommandOutput {
80    commandStdout :: String
81  , commandStderr :: String
82}
83
84instance Show CommandOutput where
85  show (CommandOutput stdout stderr) = unlines ["stdout:", stdout, "", "stderr:", stderr]
86
87evaluateMakeVar :: String -> [String] -> Maybe String -> String -> IO (Either CommandOutput String)
88evaluateMakeVar makefileDir extraFlags mbJail varName = do
89  let makeArgs = ["-C", makefileDir] ++ extraFlags ++ ["-V", varName]
90      (program, args) = case mbJail of
91        Just jailName -> ("jexec", jailName : "make" : makeArgs)
92        Nothing -> ("make", makeArgs)
93  (result, stdout, stderr) <-
94    readCreateProcessWithExitCode (proc' program args) ""
95  return $ case result of
96    ExitSuccess -> Right $ dropWhileEnd isSpace stdout
97    _ -> Left $ CommandOutput stdout stderr
98
99
100listPortOptions :: FilePath -> [String] -> Maybe String -> IO (Either CommandOutput PortOptions)
101listPortOptions makefileDir extraFlags jail = do
102   eOptionsStr <- evaluateMakeVar makefileDir extraFlags jail "OPTIONS_DEFINE"
103   case eOptionsStr of
104      Left err -> return $ Left err
105      Right optionsStr -> do
106        -- if the first call didn't fail, we can safely pattern match here
107        Right optPlainGroupsStr <- evaluateMakeVar makefileDir extraFlags jail "OPTIONS_GROUP"
108        Right optSingleGroupsStr <- evaluateMakeVar makefileDir extraFlags jail "OPTIONS_SINGLE"
109        Right optRadioGroupsStr <- evaluateMakeVar makefileDir extraFlags jail "OPTIONS_RADIO"
110        Right optMultiGroupsStr <- evaluateMakeVar makefileDir extraFlags jail "OPTIONS_MULTI"
111
112        plainGroupOpts <- fmap concat $ forM (words optPlainGroupsStr) $ \g -> do
113          Right groupOpts <- evaluateMakeVar makefileDir extraFlags jail ("OPTIONS_GROUP_" ++ g)
114          return $ words groupOpts
115
116        singleGroupOpts <- fmap M.unions $ forM (words optSingleGroupsStr) $ \g -> do
117          Right groupOpts <- evaluateMakeVar makefileDir extraFlags jail ("OPTIONS_SINGLE_" ++ g)
118          return $ M.singleton g (sort $ words groupOpts)
119
120        radioGroupOpts <- fmap M.unions $ forM (words optRadioGroupsStr) $ \g -> do
121          Right groupOpts <- evaluateMakeVar makefileDir extraFlags jail ("OPTIONS_RADIO_" ++ g)
122          return $ M.singleton g (sort $ words groupOpts)
123
124        multiGroupOpts <- fmap M.unions $ forM (words optMultiGroupsStr) $ \g -> do
125          Right groupOpts <- evaluateMakeVar makefileDir extraFlags jail ("OPTIONS_MULTI_" ++ g)
126          return $ M.singleton g (sort $ words groupOpts)
127
128        return $ Right $ PortOptions (sort $ words optionsStr ++ plainGroupOpts) singleGroupOpts radioGroupOpts multiGroupOpts
129
130
131executeMakeTargets :: String -> [String] -> Maybe String -> [String] -> IO (Either CommandOutput String)
132executeMakeTargets makefileDir extraFlags mbJail targets = do
133  let makeArgs = ["-C", makefileDir] ++ extraFlags ++ targets
134      (program, args) = case mbJail of
135        Just jailName -> ("jexec", jailName : "make" : makeArgs)
136        Nothing -> ("make", makeArgs)
137  (result, stdout, stderr) <-
138    readCreateProcessWithExitCode (proc' program args) ""
139  return $ case result of
140    ExitSuccess -> Right stdout
141    _ -> Left $ CommandOutput stdout stderr
142
143
144proc' program args = (proc program args) {delegate_ctlc = True}
145
146
147optionArguments :: [String] -> [Bool] -> [String]
148optionArguments optNames optValues = ["WITH=" ++ withOptions, "WITHOUT=" ++ withoutOptions]
149  where
150    (withOptions, withoutOptions) = go [] [] $ zip optNames optValues
151    go with without [] = (unwords with, unwords without)
152    go with without ((name, value) : os) =
153      if value
154        then go (name : with) without os
155        else go with (name : without) os
156
157
158optionsCount :: PortOptions -> Int
159optionsCount (PortOptions plain single radio multi) = length plain + M.size single + M.size radio + M.size multi
160