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