packages feed

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 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