cake3 0.5.2.0 → 0.6.0
raw patch · 10 files changed
+243/−83 lines, 10 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Development.Cake3: genTmpFile :: MonadMake m => String -> m File
- Development.Cake3: genTmpFileWithPrefix :: MonadMake m => String -> String -> m File
- Development.Cake3.Ext.UrWeb: toTmpFile :: MonadMake m => String -> Writer String a -> m File
- Development.Cake3.Monad: tmpFile :: MonadMake m => String -> m File
- Development.Cake3.Monad: tmpIndex :: MakeState -> Int
+ Development.Cake3: runMakeH :: MakeState -> (String -> IO b) -> IO (MakeState, b)
+ Development.Cake3: runMakeH_ :: MakeState -> (String -> IO b) -> IO b
+ Development.Cake3: splitDirectories :: FileLike a => a -> [String]
+ Development.Cake3: tool :: String -> Tool
+ Development.Cake3.Ext.UrWeb: UrpClientOnly :: String -> UrpHdrToken
+ Development.Cake3.Ext.UrWeb: UrpTable :: UrpRewrite
+ Development.Cake3.Ext.UrWeb: mkFileRule :: MonadMake m => String -> Writer String a -> m File
+ Development.Cake3.Ext.UrWeb: safeGet' :: MonadMake m => String -> UrpGen m ()
+ Development.Cake3.Ext.UrWeb: table :: UrpRewrite
+ Development.Cake3.Ext.UrWeb: tempPrefix :: File -> String
+ Development.Cake3.Monad: extraClean :: MakeState -> Set File
+ Development.Cake3.Monad: instance [overlap ok] MonadAction a m => RefInput a m Tool
+ Development.Cake3.Monad: tmp_file :: String -> File
+ Development.Cake3.Monad: tools :: (Foldable t, Monad m) => (t Tool) -> A' m ()
+ Development.Cake3.Types: Tool :: String -> Tool
+ Development.Cake3.Types: data Tool
+ Development.Cake3.Types: filterRecipesByTargets :: (Foldable t, Foldable t2) => t2 File -> t Recipe -> Set Recipe
+ Development.Cake3.Types: filterRecipesByTools :: Foldable t => [Tool] -> t Recipe -> Set Recipe
+ Development.Cake3.Types: filterRecipesByToolsDeep :: [Tool] -> Set Recipe -> Set Recipe
+ Development.Cake3.Types: instance Data Tool
+ Development.Cake3.Types: instance Eq Tool
+ Development.Cake3.Types: instance Ord Tool
+ Development.Cake3.Types: instance Show Tool
+ Development.Cake3.Types: instance Typeable Tool
+ Development.Cake3.Types: intermediateFiles :: Foldable t => t Recipe -> Set File
+ Development.Cake3.Types: queryPrereq :: Foldable t => t Recipe -> Set File
+ Development.Cake3.Types: rtools :: Recipe -> Set Tool
+ Development.Cake3.Types: tname :: Tool -> String
+ Development.Cake3.Types: tool :: String -> Tool
+ Development.Cake3.Utils.Slice: writeSliced :: File -> [(File, [Tool])] -> Make a -> IO ()
+ System.FilePath.Wrapper: escapeFile :: File -> FilePath
+ System.FilePath.Wrapper: splitDirectories :: FileLike a => a -> [String]
- Development.Cake3.Monad: MS :: Recipe -> Recipe -> Set Recipe -> Location -> Set File -> [File] -> Set File -> String -> String -> File -> Int -> MakeState
+ Development.Cake3.Monad: MS :: Recipe -> Recipe -> Set Recipe -> Location -> Set File -> [File] -> Set File -> String -> String -> File -> Set File -> MakeState
- Development.Cake3.Types: Recipe :: Set File -> Set File -> [Command] -> Set Variable -> String -> Set Flag -> Recipe
+ Development.Cake3.Types: Recipe :: Set File -> Set File -> [Command] -> Set Variable -> Set Tool -> String -> Set Flag -> Recipe
Files
- README.md +8/−0
- cake3.cabal +3/−2
- src/CakeScript.sh +14/−8
- src/Development/Cake3.hs +42/−22
- src/Development/Cake3/Ext/UrWeb.hs +20/−4
- src/Development/Cake3/Monad.hs +30/−17
- src/Development/Cake3/Types.hs +59/−13
- src/Development/Cake3/Utils/Slice.hs +52/−0
- src/Development/Cake3/Writer.hs +5/−17
- src/System/FilePath/Wrapper.hs +10/−0
README.md view
@@ -237,6 +237,14 @@ A/Cakefile.hs and do whatever you want to. Resulting makefiles will always be monolitic. + * *Cake3 may generate different versions of Makefile at once*++ We often want to generate developer's and end-user's makefiles. End-user+ version may want treat several rules as pre-executed. Cake3 easily allows us+ to do that by using 'slicing' utility. See ./Examples/GCC_SED/Cakefile.hs+ for details.++ ### Limitations #### Make syntax
cake3.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: cake3-version: 0.5.2.0+version: 0.6.0 synopsis: Third cake the Makefile EDSL description: Cake3 is a Makefile EDSL written in Haskell. Write your build logic in Haskell, obtain clean and safe Makefile, distribute it to the end-users.@@ -69,13 +69,14 @@ Development.Cake3.Monad Development.Cake3.Ext.UrWeb Development.Cake3.Utils.Find+ Development.Cake3.Utils.Slice Text.QuasiMake build-depends: base ==4.7.*, haskell-src-meta, template-haskell, filepath, containers, text, monadloc, mtl, bytestring, deepseq, system-filepath, text-format, directory, attoparsec, mime-types,- language-javascript, syb, parsec+ language-javascript, syb, parsec, process hs-source-dirs: src
src/CakeScript.sh view
@@ -13,7 +13,8 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE QuasiQuotes #-}-module ${1}_P(file, cakefiles, selfUpdate,filterDirectoryContentsRecursive) where+module ${1}_P(file, cakefiles, selfUpdate,filterDirectoryContentsRecursive,+cakegen, cake3) where import Control.Monad.Trans import Control.Monad.State@@ -43,16 +44,20 @@ "$TOP" -> map (file' rl) ($3) _ -> error "cakefiles are defined for top-level cake only" +cakegen = tool "./Cakegen"+cake3 = tool "cake3"+ selfUpdate :: Make [File] selfUpdate = do makefile <- outputFile <$> get (_,cg) <- rule2 $ do depend cakefiles produce (file "Cakegen")- shell [cmd|cake3|]+ shell [cmd|\$(cake3)|] (_,f) <- rule2 $ do+ depend cg produce makefile- shell [cmd|\$cg|]+ shell [cmd|\$(cakegen)|] return f filterDirectoryContentsRecursive :: (MonadIO m) => [String] -> m [File]@@ -132,11 +137,12 @@ T=`mktemp -d` cakes() {- find -type f '(' -name 'Cake*\.hs' -or -name 'Cake*\.lhs' \- -or -name '*Cake\.hs' -or -name '*Cake\.lhs' ')' \- -and -not -name '*_P.hs' \- | grep -v '^\.[a-zA-Z].*' \- | sort+ for l in `seq 1 1 10`; do+ find -L -mindepth $l -maxdepth $l -type f '(' -name 'Cake*\.hs' -or -name 'Cake*\.lhs' \+ -or -name '*Cake\.hs' -or -name '*Cake\.lhs' ')' \+ -and -not -name '*_P.hs' | sort+ done \+ | grep -v '^\.[a-zA-Z].*' } OIFS=$IFS
src/Development/Cake3.hs view
@@ -18,6 +18,8 @@ , Make , buildMake , runMake+ , runMakeH+ , runMakeH_ , writeMake , includeMakefile , MonadMake(..)@@ -42,8 +44,6 @@ , toFilePath , readFileForMake , genFile- , genTmpFile- , genTmpFileWithPrefix -- Make parts , prerequisites@@ -52,6 +52,7 @@ , cmd , makevar , extvar+ , tool , CommandGen'(..) , make , ProjectLocation(..)@@ -98,6 +99,8 @@ cwd <- liftIO $ getCurrentDirectory return $ ProjectLocation cwd cwd +-- | Converts string representation of Path into type-safe File. Internally,+-- files are stored as a relative offsets from the project root directory file' :: ProjectLocation -> String -> File file' pl f' = fromFilePath (addpoint (F.normalise rel)) where rel = makeRelative (root pl) ((off pl) </> f)@@ -105,34 +108,49 @@ addpoint "." = "." addpoint p = "."</>p -runMake'- :: File -- ^ Output file- -> Make a -- ^ Make builder+-- | A Generic Make monad runner. Execute the monad @mk@, provide the @output@+-- handler with Makefile encoded as a string. Note that Makefile may contain+-- rules which references the file itself by the name @makefile@. In case of+-- errors, print report to stderr and abort the execution with @fail@ call+runMakeH+ :: MakeState -- ^ Result of evalMake -> (String -> IO b) -- ^ Handler to output the file- -> IO b-runMake' makefile mk output = do- ms <- evalMake makefile mk+ -> IO (MakeState,b)+runMakeH ms output = do when (not $ L.null (warnings ms)) $ do hPutStr stderr (warnings ms) when (not $ L.null (errors ms)) $ do fail (errors ms) case buildMake ms of Left e -> fail e- Right s -> output s+ Right s -> do+ o <- output s+ return (ms,o) --- | Execute the Make monad, build the Makefile, write it to the output file. Also--- note, that errors (if any) go to the stderr. fail will be executed in such--- cases+-- | A Version of @runMakeH@ returning no state+runMakeH_+ :: MakeState -- ^ Result of evalMake+ -> (String -> IO b) -- ^ Handler to output the file+ -> IO b+runMakeH_ ms h = snd `liftM` (runMakeH ms h)++-- | Execute the @mk@ monad, return the Makefile as a String. In case of+-- errors, print report to stderr and abort the execution with @fail@ call+runMake :: Make a -> IO String+runMake mk = do+ ms <- evalMake defaultMakefile mk+ runMakeH_ ms return++-- | Execute the @mk@ monad, build the Makefile, write it to the output file.+-- In case of errors, print report to stderr and abort the execution with @fail@+-- call writeMake :: File -- ^ Output file -> Make a -- ^ Makefile builder -> IO ()-writeMake f mk = runMake' f mk (writeFile (toFilePath f))---- | A General Make runner. Executes the monad, returns the Makefile as a--- String. Errors go to stdout. fail is possible.-runMake :: Make a -> IO String-runMake mk = runMake' defaultMakefile mk return+writeMake f mk = do+ ms <- evalMake defaultMakefile mk+ runMakeH_ ms (writeFile (toFilePath f)) -- | Raise the recipe's priority (it will appear higher in the final Makefile) withPlacement :: (MonadMake m) => m (Recipe,a) -> m (Recipe,a)@@ -186,9 +204,11 @@ quote_dollar ('$':cs) = '$':'$':(quote_dollar cs) quote_dollar (c:cs) = c : (quote_dollar cs) -genTmpFile :: (MonadMake m) => String -> m File-genTmpFile cnt = tmpFile [] >>= \f -> genFile f cnt+-- FIXME: buggy function, breaks commutativity+-- genTmpFile :: (MonadMake m) => String -> m File+-- genTmpFile cnt = tmpFile [] >>= \f -> genFile f cnt -genTmpFileWithPrefix :: (MonadMake m) => String -> String -> m File-genTmpFileWithPrefix pfx cnt = tmpFile pfx >>= \f -> genFile f cnt+-- FIXME: buggy function, breaks commutativity+-- genTmpFileWithPrefix :: (MonadMake m) => String -> String -> m File+-- genTmpFileWithPrefix pfx cnt = tmpFile pfx >>= \f -> genFile f cnt
src/Development/Cake3/Ext/UrWeb.hs view
@@ -48,7 +48,7 @@ data UrpAllow = UrpMime | UrpUrl | UrpResponseHeader | UrpEnvVar | UrpHeader deriving(Show,Data,Typeable) -data UrpRewrite = UrpStyle | UrpAll+data UrpRewrite = UrpStyle | UrpAll | UrpTable deriving(Show,Data,Typeable) data UrpHdrToken = UrpDatabase String@@ -65,6 +65,7 @@ | UrpJSFunc String String String -- ^ Module name, UrWeb name, JavaScript name | UrpSafeGet String | UrpScript String+ | UrpClientOnly String deriving(Show,Data,Typeable) data UrpModToken@@ -168,6 +169,7 @@ instance ToUrpWord UrpRewrite where toUrpWord (UrpStyle) = "style" toUrpWord (UrpAll) = "all"+ toUrpWord (UrpTable) = "table" class ToUrpLine a where toUrpLine :: FilePath -> a -> String@@ -192,6 +194,7 @@ toUrpLine up (UrpSafeGet s) = printf "safeGet %s" (dropExtensions s) toUrpLine up (UrpJSFunc s1 s2 s3) = printf "jsFunc %s.%s = %s" s1 s2 s3 toUrpLine up (UrpScript s) = printf "script %s" s+ toUrpLine up (UrpClientOnly s) = printf "clientOnly %s" s toUrpLine up e = error $ "toUrpLine: unhandled case " ++ (show e) instance ToUrpLine UrpModToken where@@ -207,8 +210,14 @@ createDirectoryIfMissing True (takeDirectory f) writeFile f $ execWriter $ wr -toTmpFile pfx wr = genTmpFileWithPrefix pfx $ execWriter $ wr+tempPrefix :: File -> String+tempPrefix f = concat $ map (map nodot) $ splitDirectories f where+ nodot '.' = '_'+ nodot '/' = '_'+ nodot a = a +mkFileRule pfx wr = genFile (tmp_file pfx) $ execWriter $ wr+ line :: (MonadWriter String m) => String -> m () line s = tell (s++"\n") @@ -230,7 +239,7 @@ ".c" -> shell [cmd| $cc -c $i $incfl $(string flags) -o @(c .= "o") $(c) |] e -> error ("Unknown C-source extension " ++ e) - inp_in <- toTmpFile (takeFileName (urpfile .= "in")) $ do+ inp_in <- mkFileRule (tempPrefix (urpfile .= "in")) $ do forM hdr (line . toUrpLine (urpUp urpfile)) line "" forM mod (line . toUrpLine (urpUp urpfile))@@ -373,10 +382,14 @@ jsFunc m u j = addHdr $ UrpJSFunc m u j +safeGet' :: (MonadMake m) => String -> UrpGen m ()+safeGet' uri+ | otherwise = addHdr $ UrpSafeGet uri+ safeGet :: (MonadMake m) => File -> String -> UrpGen m () safeGet m fn | (takeExtension m) /= ".ur" = fail (printf "safeGet: not an Ur/Web module name specified (%s)" (toFilePath m))- | otherwise = addHdr $ UrpSafeGet (printf "%s/%s" (takeBaseName m) fn)+ | otherwise = safeGet' (printf "%s/%s" (takeBaseName m) fn) url = UrpUrl @@ -386,6 +399,8 @@ all = UrpAll +table = UrpTable+ env = UrpEnvVar hdr = UrpHeader@@ -525,6 +540,7 @@ forM_ jsdecls $ \decl -> do addHdr $ UrpJSFunc (modname jsmod) (urname decl) (jsname decl)+ addHdr $ UrpClientOnly $ (modname jsmod) ++ "." ++ (urname decl) toFile (jsmod ".urs") $ do forM_ jstypes $ \decl -> line (urtdecl decl) forM_ jsdecls $ \decl -> line (urdecl decl)
src/Development/Cake3/Monad.hs view
@@ -53,7 +53,7 @@ , postbuilds :: Recipe -- ^ Postbuild commands. , recipes :: Set Recipe- -- ^ The set of recipes+ -- ^ The set of recipes, to be checked and renderd as a Makefile , sloc :: Location -- ^ Current location. FIXME: fix or remove , makeDeps :: Set File@@ -68,12 +68,14 @@ -- ^ Warnings found so far , outputFile :: File -- ^ Name of the Makefile being generated- , tmpIndex :: Int+ -- , tmpIndex :: Int -- ^ Index to build temp names+ , extraClean :: Set File+ -- ^ extra clean files } -- Oh, such a boilerplate-initialMakeState mf = MS defr defr mempty mempty mempty mempty mempty mempty mempty mf 0 where+initialMakeState mf = MS defr defr mempty mempty mempty mempty mempty mempty mempty mf mempty where defr = emptyRecipe "<internal>" getPlacementPos :: Make Int@@ -86,11 +88,8 @@ addMakeDep :: File -> Make () addMakeDep f = modify (\ms -> ms { makeDeps = S.insert f (makeDeps ms) }) -tmpFile :: (MonadMake m) => String -> m File-tmpFile pfx = liftMake $ do- s <- get- put s{tmpIndex = (tmpIndex s)+1}- return (fromFilePath (".cake3" </> ("tmp"++ pfx ++ (show (tmpIndex s)))))+tmp_file :: String -> File+tmp_file pfx = (fromFilePath (".cake3" </> ("tmp_"++ pfx ))) -- | Add prebuild command prebuild, postbuild :: (MonadMake m) => CommandGen -> m ()@@ -103,19 +102,19 @@ pb <- fst <$> runA' (postbuilds s) (shell cmdg) put s { postbuilds = pb } --- | Find recipes without targets+-- | Find recipes without targets. Empty result means 'No errors' checkForEmptyTarget :: (Foldable f) => f Recipe -> String checkForEmptyTarget rs = foldl' checker mempty rs where checker es r | S.null (rtgt r) = es++e | otherwise = es where- e = printf "Error: Recipe without targets\n\t%s\n" (show r)+ e = printf "Error: No target declared for recipe\n\t%s\n" (show r) --- | Find recipes sharing a target+-- | Find recipes sharing a target. Empty result means 'No errors' checkForTargetConflicts :: (Foldable f) => f Recipe -> String checkForTargetConflicts rs = foldl' checker mempty (groupRecipes rs) where checker es rs | S.size rs > 1 = es++e | otherwise = es where- e = printf "Error: Recipes share one or more targets\n\t%s\n" (show rs)+ e = printf "Error: Recipes share one or more targets:\n\t%s\n" (show rs) -- | A Monad providing access to MakeState. TODO: not mention IO here.@@ -137,12 +136,15 @@ liftMake = lift . liftMake --- | Returns a MakeState+-- | Evaluate the Make monad @mf@, return MakeState containing the result. Name+-- @mf@ is used for self-referencing recipes. evalMake :: (Monad m) => File -> Make' m a -> m MakeState evalMake mf mk = do ms <- flip execStateT (initialMakeState mf) (unMake mk) return ms {- errors = checkForEmptyTarget (recipes ms) ++ checkForTargetConflicts (recipes ms)+ errors+ = checkForEmptyTarget (recipes ms)+ ++ checkForTargetConflicts (recipes ms) } modifyLoc f = modify $ \ms -> ms { sloc = f (sloc ms) }@@ -310,8 +312,8 @@ Nothing -> return mempty Just x -> refOutput x --- | Class of things which may be referenced using '\$(expr)' from inside--- of quasy-quoted shell expressions+-- | Class of things which may be referenced using '\$(expr)' syntax of the+-- quasy-quoted shell expressions class (MonadAction a m) => RefInput a m x where -- | Register the input item, return it's shell-script representation refInput :: x -> a Command@@ -349,6 +351,11 @@ variables [v] return_text $ printf "$(%s)" n +instance (MonadAction a m) => RefInput a m Tool where+ refInput t@(Tool x) = liftAction $ do+ tools [t]+ return_text x+ instance (MonadAction a m) => RefInput a m CakeString where refInput v@(CakeString s) = do return_text s@@ -369,11 +376,17 @@ -> A' m () produce x = refOutput x >> return () --- | Add variables to the list of variables referenced by the current recipe+-- | Add variables @vs@ to tracking list of the current recipe variables :: (Foldable t, Monad m) => (t Variable) -- ^ A set of variables to depend the recipe on -> A' m () variables vs = modify (\r -> r { rvars = foldl' (\a v -> S.insert v a) (rvars r) vs } )++-- | Add tools @ts@ to the tracking list of the current recipe+tools :: (Foldable t, Monad m)+ => (t Tool) -- ^ A set of tools used by this recipe+ -> A' m ()+tools ts = modify (\r -> r { rtools = foldl' (\a v -> S.insert v a) (rtools r) ts } ) -- | Add commands to the list of commands of a current recipe under -- construction. Warning: this function behaves like unsafeShell i.e. it doesn't
src/Development/Cake3/Types.hs view
@@ -2,11 +2,13 @@ module Development.Cake3.Types where import Control.Applicative+import Control.Monad (when)+import Control.Monad.Writer (MonadWriter, WriterT(..), execWriterT, execWriter, tell) import Data.Maybe import Data.Monoid import Data.Data import Data.Typeable-import Data.Foldable (Foldable(..), foldl')+import Data.Foldable (Foldable(..), foldl', forM_) import qualified Data.List as L import Data.List hiding(foldr, foldl') import qualified Data.Map as M@@ -16,7 +18,7 @@ import System.FilePath.Wrapper --- | The representation of Makefile variable+-- | The representation of Makefile variable. data Variable = Variable { vname :: String -- ^ The name of a variable@@ -25,8 +27,14 @@ -- environment) } deriving(Show, Eq, Ord, Data, Typeable) --- type Vars = Map String (Set Variable) +-- | The representation a tool used by the Makefile's recipe. Typical example+-- are 'gcc' or 'bison'+data Tool = Tool {+ tname :: String+ -- ^ Name of tool.+ } deriving(Show, Eq, Ord, Data, Typeable)+ -- | Command represents OS command line and consists of a list of fragments. -- Each fragment is either text (may contain spaces) or FilePath (spaces should -- be escaped)@@ -52,13 +60,18 @@ , rcmd :: [Command] -- ^ A list of shell commands , rvars :: Set Variable- -- ^ Container of variables+ -- ^ A set of variables employed in the recipe. The target Makefile should+ -- notice changes in those variables and rebuild the targets+ , rtools :: Set Tool+ -- ^ A set of tools employed in the recipe. Make , rloc :: String+ -- ^ Location (probably, doesn't function) , rflags :: Set Flag+ -- ^ Set of flags (Makefile-specific) } deriving(Show, Eq, Ord, Data, Typeable) emptyRecipe :: String -> Recipe-emptyRecipe loc = Recipe mempty mempty mempty mempty loc mempty+emptyRecipe loc = Recipe mempty mempty mempty mempty mempty loc mempty addPrerequisites :: Set File -> Recipe -> Recipe addPrerequisites p r = r { rsrc = p`mappend`(rsrc r)}@@ -85,13 +98,31 @@ all = L.map snd $ M.toList m in placed ++ (all \\ placed) +filterRecipesByTools :: (Foldable t) => [Tool] -> t Recipe -> Set Recipe+filterRecipesByTools ts rs = foldMap mp rs where+ mp r = (\match -> if match then S.singleton r else S.empty) $ or $ map (\t -> S.member t (rtools r)) ts++filterRecipesByTargets :: (Foldable t, Foldable t2) => t2 File -> t Recipe -> Set Recipe+filterRecipesByTargets ts rs = foldMap mp rs where+ mp r = (\(Any match) -> if match then S.singleton r else S.empty) $ foldMap (\t -> Any $ S.member t (rtgt r)) ts++filterRecipesByToolsDeep :: [Tool] -> Set Recipe -> Set Recipe+filterRecipesByToolsDeep ts rs = fdeep (queryPrereq ry) rn ry where+ ry = filterRecipesByTools ts rs+ rn = rs `S.difference` ry++ fdeep ts rn ry =+ let+ ry' = filterRecipesByTargets ts rn+ in+ if not $ S.null ry' then+ fdeep (queryPrereq ry') (rn `S.difference` ry') (ry `S.union` ry')+ else+ ry+ applyPlacement :: (Foldable t) => [File] -> t Recipe -> [Recipe] applyPlacement pl rs = flattern $ applyPlacement' pl (groupRecipes rs) --- applyPlacement2 :: (Foldable t) => [File] -> t File -> [File]--- applyPlacement2 pl fs = flattern $ applyPlacement' pl (groupSet S.singleton fs)- - transformRecipes :: (Applicative m) => (Recipe -> m (Set Recipe)) -> Set Recipe -> m (Set Recipe) transformRecipes f m = S.foldl' f' (pure mempty) m where f' a r = mappend <$> (f r) <*> a@@ -112,21 +143,36 @@ queryTargets :: (Foldable t) => t Recipe -> Set File queryTargets rs = foldl' (\a r -> a`mappend`(rtgt r)) mempty rs +queryPrereq :: (Foldable t) => t Recipe -> Set File+queryPrereq rs = foldl' (\a r -> a`mappend`(rsrc r)) mempty rs+ var :: String -> Maybe String -> Variable var n v = Variable n v --- | Declare the variable which is defined in the current Makefile and has it's--- default value+intermediateFiles :: (Foldable t) => t Recipe -> Set File+intermediateFiles rs = + execWriter $ do+ forM_ rs $ \r -> do+ when (not $ Phony `S.member` (rflags r)) $ do+ tell (rtgt r)++tool :: String -> Tool+tool = Tool++-- | Define the Makefile-level variable. Rules, referring to a variable,+-- 'notice' it's changes. makevar :: String -- ^ Variable name -> String -- ^ Default value -> Variable makevar n v = var n (Just v) --- | Declare the variable which is not defined in the target Makefile+-- | Declare the variable defined elsewhere. Typycally, environment variables+-- may be decalred with this functions. Variables are tracked by the cake3.+-- Rules, referring to a variable, 'notice' it's changes. extvar :: String -> Variable extvar n = var n Nothing --- | Special variable @$(MAKE)@+-- | Reref to special variable @$(MAKE)@ make = extvar "MAKE"
+ src/Development/Cake3/Utils/Slice.hs view
@@ -0,0 +1,52 @@++module Development.Cake3.Utils.Slice+where++import Control.Applicative+import Control.Monad.Trans+import qualified Data.Set as S+import Data.Set (Set)++import System.Directory+import System.Environment+import System.Process+import System.Exit+import System.IO+import Text.Printf++import System.FilePath.Wrapper+import Development.Cake3+import Development.Cake3.Types+import Development.Cake3.Monad+import Development.Cake3.Writer++-- | Build the full Makefile named @fo@ and a set of 'sliced' versions.+-- 'Slicing' here means filtering out all rules which depends on certain tools+-- (second element of @sls@) and all upstream rules.+writeSliced :: File -> [(File,[Tool])] -> Make a -> IO ()+writeSliced fo sls mk = do+ cwd <- currentDirLocation+ ms <- evalMake fo mk+ runMakeH ms (writeFile (toFilePath fo))++ ecs <- forM sls $ \(fs,ts) -> do++ ms <- evalMake fs mk+ let rs = filterRecipesByToolsDeep ts (recipes ms)+ let ts = S.toList $ queryTargets rs++ putStrLn $ printf "Writing %s" (escapeFile fs)+ runMakeH ms {+ recipes = (recipes ms) `S.difference` rs+ } (writeFile (toFilePath fs))++ putStrLn $ printf "Executing: make -f %s %s" (escapeFile fo) (unwords $ map escapeFile ts)+ ec <- system $ printf "make -f %s %s" (escapeFile fo) (unwords $ map escapeFile ts)++ return (ec,fs)++ forM_ ecs $ \(ec,sln) ->+ case ec of+ ExitFailure i -> fail $ printf "Non-zero exit code (%d) while building %s\n" i (escapeFile sln)+ _ -> return ()+
src/Development/Cake3/Writer.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+ module Development.Cake3.Writer (defaultMakefile,buildMake) where import Control.Applicative@@ -34,11 +35,6 @@ instance ToMakeText [Char] where toMakeText = id -escapeFile f = escapeFile' (toFilePath f)-escapeFile' [] = []-escapeFile' (' ':xs) = "\\ " ++ escapeFile' xs-escapeFile' (x:xs) = (x:(escapeFile' xs))- instance ToMakeText File where toMakeText = escapeFile @@ -173,13 +169,6 @@ flt True _ = True flt False r = (Phony `S.member`(rflags r)) && ((fromFilePath "clean")`S.member`(rtgt r)) -intermediateFiles :: (Foldable t) => t Recipe -> Set File-intermediateFiles rs = - execWriter $ do- forM_ rs $ \r -> do- when (not $ Phony `S.member` (rflags r)) $ do- tell (rtgt r)- cleanRuleLL :: Set File -> MakeLL Recipe cleanRuleLL fs = ruleLL $ do@@ -189,14 +178,13 @@ -- | Define a 'clean' phony target. The rule removes all targets except phony -- targets and the Makefile itself-defineClean :: File -> Set Recipe -> Set Recipe-defineClean mk rs =+defineClean :: File -> Set File -> Set Recipe+defineClean mk fs = runMakeLL "defineClean" $ do- let fs = intermediateFiles rs cleanRuleLL (fs `S.difference` (S.singleton mk)) return () --- | Rule referring to the +-- | Default Makefile location defaultMakefile :: File defaultMakefile = fromFilePath ("." </> "Makefile") @@ -259,7 +247,7 @@ $ fixMultiTarget [r] line "" line "endif"- writeRules $ defineClean (outputFile ms) (recipes ms)+ writeRules $ defineClean (outputFile ms) ((intermediateFiles (recipes ms))`mappend` (extraClean ms)) line "" hdr <- runLines $ do
src/System/FilePath/Wrapper.hs view
@@ -27,6 +27,13 @@ fromFilePath :: FilePath -> FileT FilePath fromFilePath f = FileT f +-- | Convert File back to FilePath with escaped spaces+escapeFile :: File -> FilePath+escapeFile f = escapeFile' (toFilePath f) where+ escapeFile' [] = []+ escapeFile' (' ':xs) = "\\ " ++ escapeFile' xs+ escapeFile' (x:xs) = (x:(escapeFile' xs))+ instance (Monoid a) => Monoid (FileT a) where mempty = FileT mempty mappend (FileT a) (FileT b) = FileT (a`mappend`b)@@ -43,6 +50,7 @@ takeExtensions :: a -> String dropExtensions :: a -> a dropExtension :: a -> a+ splitDirectories :: a -> [String] -- | Redefine standard @</>@ operator to work with Files (</>) :: (FileLike a) => a -> String -> a@@ -64,6 +72,7 @@ takeDirectory (FileT a) = FileT (takeDirectory a) dropExtensions (FileT a) = FileT (dropExtensions a) dropExtension (FileT a) = FileT (dropExtension a)+ splitDirectories (FileT a) = splitDirectories a instance FileLike FilePath where -- fromFilePath = id@@ -77,4 +86,5 @@ takeExtensions = F.takeExtensions dropExtensions = F.dropExtensions dropExtension = F.dropExtension+ splitDirectories = F.splitDirectories