cake3 0.2.1.0 → 0.3.0.0
raw patch · 7 files changed
+185/−79 lines, 7 files
Files
- cake3.cabal +5/−2
- src/Development/Cake3.hs +23/−15
- src/Development/Cake3/Ext/UrWeb.hs +145/−53
- src/Development/Cake3/Ext/UrWeb/UrEmbed.hs +2/−4
- src/Development/Cake3/Monad.hs +3/−0
- src/Development/Cake3/Writer.hs +4/−5
- src/System/FilePath/Wrapper.hs +3/−0
cake3.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: cake3-version: 0.2.1.0+version: 0.3.0.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.@@ -54,13 +54,16 @@ . * Execute the application to obtain the Makefile .- See the README on the GitHub <https://github.com/grwlf/cake3> for more information.+ See the README on the GitHub <https://github.com/grwlf/cake3> for more+ information. Distribution contains several example projects. . /Changes/ . * 0.1 - Initial release . * 0.2 - Redesign (simplify) monadic interface, add support for prebuild/postbuild actions.+ .+ * 0.3 - API changes, improve documentation, improve UrWeb extension category: Development
src/Development/Cake3.hs view
@@ -130,8 +130,7 @@ runMake :: Make a -> IO String runMake mk = runMake' defaultMakefile mk return --- | Execute Make action, place the recipe above all other recipes (it will be--- higher in the final Makefile)+-- | Raise the recipe's priority (it will appear higher in the final Makefile) withPlacement :: (MonadMake m) => m (Recipe,a) -> m (Recipe,a) withPlacement mk = do (r,a) <- mk@@ -145,33 +144,42 @@ -- > phony "clean" -- > unsafeShell [cmd|rm $elf $os $d|] -- >-phony :: String -> A ()+phony ::+ String -- ^ A name of phony target+ -> A () phony name = do produce (W.fromFilePath name :: File) markPhony --- | Build a Recipe using recipe builder @act. Don't change recipe's priority.-rule2 :: (MonadMake m) => A a -> m (Recipe,a)+-- | Build a Recipe using recipe builder provided, than record the Recipe to the+-- MakeState. Return the copy of Recipe (which should not be changed in future)+-- and the result of recipe builder. The typical recipe builder result is the+-- list of it's targets.+--+-- /Example/+-- Lets declare a rule which builds "main.o" out of "main.c" and "CFLAGS"+-- variable+--+-- > let c = file "main.c"+-- > rule $ shell [cmd| gcc -c $(extvar "CFLAGS") -o @(c.="o") $c |]+--+rule2 :: (MonadMake m)+ => A a -- ^ Recipe builder+ -> m (Recipe,a) -- ^ The recipe itself and the recipe builder's result rule2 act = liftMake $ do loc <- getLoc (r,a) <- runA loc act addRecipe r return (r,a) --- | Version of rule2 which places it's recipe above all other recipies.------ > let c = file "main.c"------ Declare a rule to build "main.o" out of "main.c" and "CFLAGS" variable------ > rule $ shell [cmd| gcc -c $(extvar "CFLAGS") -o @(c.="o") $c |]---+-- | A version of rule2. Rule places it's recipe above all recipies defined so+-- far. rule- :: A a -- ^ Rule builder+ :: A a -- ^ Recipe builder -> Make a rule act = snd <$> withPlacement (rule2 act) --- | Version of rule2, without Make monad set explicitly+-- | A version of rule, without monad set explicitly rule' :: (MonadMake m) => A a -> m a rule' act = liftMake $ snd <$> withPlacement (rule2 act)
src/Development/Cake3/Ext/UrWeb.hs view
@@ -39,10 +39,10 @@ import Development.Cake3.Monad import Development.Cake3 -data UrpAllow = UrpMime | UrpUrl+data UrpAllow = UrpMime | UrpUrl | UrpResponseHeader deriving(Show,Data,Typeable) -data UrpRewrite = UrpStyle+data UrpRewrite = UrpStyle | UrpAll deriving(Show,Data,Typeable) data UrpHdrToken = UrpDatabase String@@ -52,10 +52,13 @@ | UrpLibrary File | UrpDebug | UrpInclude File- | UrpLink File+ | UrpLink File String+ | UrpSrc File String String+ | UrpPkgConfig String | UrpFFI File- | UrpJSFunc String String+ | UrpJSFunc String String String -- ^ Module name, UrWeb name, JavaScript name | UrpSafeGet String+ | UrpScript String deriving(Show,Data,Typeable) data UrpModToken@@ -83,10 +86,23 @@ instance (MonadAction a m) => RefInput a m UWExe where refInput (UWExe u) = refInput (urpExe u) +class UrpLike x where+ toUrp :: x -> Urp+ tempfiles :: x -> [File]+ tempfiles = (\x -> (urpObjs x) ++ maybeToList (urpSql' x) ++ maybeToList (urpExe' x)) . toUrp +instance UrpLike Urp where+ toUrp = id++instance UrpLike UWLib where+ toUrp (UWLib x) = x+instance UrpLike UWExe where+ toUrp (UWExe x) = x+ urpDeps :: Urp -> [File] urpDeps (Urp _ _ hdr mod) = foldl' scan2 (foldl' scan1 mempty hdr) mod where- scan1 a (UrpLink f) = f:a+ scan1 a (UrpLink f _) = f:a+ scan1 a (UrpSrc f _ _) = (f.="o"):a scan1 a (UrpInclude f) = f:a scan1 a _ = a scan2 a (UrpModule1 f) = f:a@@ -104,18 +120,28 @@ Nothing -> error "ur project defines no SQL file" Just sql -> sql +urpSrcs (Urp _ _ hdr _) = foldl' scan [] hdr where+ scan a (UrpSrc f cfl lfl) = (f,cfl):a+ scan a _ = a+ urpObjs (Urp _ _ hdr _) = foldl' scan [] hdr where- scan a (UrpLink f) = f:a+ scan a (UrpSrc f _ lfl) = (f.="o"):a+ scan a (UrpLink f lfl) = (f):a scan a _ = a urpLibs (Urp _ _ hdr _) = foldl' scan [] hdr where scan a (UrpLibrary f) = f:a scan a _ = a +urpExe' = uexe urpExe u = case uexe u of Nothing -> error "ur project defines no EXE file" Just exe -> exe +urpPkgCfg (Urp _ _ hdr _) = foldl' scan [] hdr where+ scan a (UrpPkgConfig s) = s:a+ scan a _ = a+ data UrpState = UrpState { urpst :: Urp } deriving (Show)@@ -128,24 +154,35 @@ instance ToUrpWord UrpAllow where toUrpWord (UrpMime) = "mime" toUrpWord (UrpUrl) = "url"+ toUrpWord (UrpResponseHeader) = "responseHeader" instance ToUrpWord UrpRewrite where toUrpWord (UrpStyle) = "style"+ toUrpWord (UrpAll) = "all" class ToUrpLine a where toUrpLine :: FilePath -> a -> String +maskPkgCfg s = "%" ++ (map toUpper s) ++ "%"+ instance ToUrpLine UrpHdrToken where toUrpLine up (UrpDatabase dbs) = printf "database %s" dbs toUrpLine up (UrpSql f) = printf "sql %s" (up </> toFilePath f) toUrpLine up (UrpAllow a s) = printf "allow %s %s" (toUrpWord a) s toUrpLine up (UrpRewrite a s) = printf "rewrite %s %s" (toUrpWord a) s- toUrpLine up (UrpLibrary f) = printf "library %s" (up </> toFilePath (dropExtensions f))+ toUrpLine up (UrpLibrary f)+ | (takeFileName f) == "lib.urp" = printf "library %s" (up </> toFilePath (takeDirectory f))+ | otherwise = printf "library %s" (up </> toFilePath (dropExtension f)) toUrpLine up (UrpDebug) = printf "debug" toUrpLine up (UrpInclude f) = printf "include %s" (up </> toFilePath f)- toUrpLine up (UrpLink f) = printf "link %s" (up </> toFilePath f)+ toUrpLine up (UrpLink f lfl) = printf "link %s %s" lfl (up </> toFilePath f)+ toUrpLine up (UrpSrc f _ lfl) = printf "link %s %s" lfl (up </> toFilePath (f.="o"))+ toUrpLine up (UrpPkgConfig s) = printf "link %s" (maskPkgCfg s) toUrpLine up (UrpFFI s) = printf "ffi %s" (up </> toFilePath (dropExtensions s)) 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 e = error $ "toUrpLine: unhandled case " ++ (show e) instance ToUrpLine UrpModToken where toUrpLine up (UrpModule1 f) = up </> toFilePath (dropExtensions f)@@ -155,40 +192,53 @@ newtype UrpGen m a = UrpGen { unUrpGen :: StateT UrpState m a } deriving(Functor, Applicative, Monad, MonadState UrpState, MonadMake, MonadIO) -instance (Monad m) => MonadAction (UrpGen (A' m)) m where- liftAction a = UrpGen (lift a)+-- instance (Monad m) => MonadAction (UrpGen (A' m)) m where+-- liftAction a = UrpGen (lift a) toFile f wr = liftIO $ writeFile (toFilePath f) $ execWriter $ wr line :: (MonadWriter String m) => String -> m () line s = tell (s++"\n") -uwlib :: File -> UrpGen (A' (Make' IO)) () -> Make UWLib+uwlib :: File -> UrpGen (Make' IO) () -> Make UWLib uwlib urpfile m = do- (_,u) <- rule2 $ do- ((),s) <- runStateT (unUrpGen m) (defState urpfile)- let u@(Urp _ _ hdr mod) = urpst s- let up = urpUp urpfile+ ((),s) <- runStateT (unUrpGen m) (defState urpfile)+ let u@(Urp _ _ hdr mod) = urpst s+ let pkgcfg = (urpPkgCfg u) - toFile urpfile $ do- forM hdr (line . toUrpLine up)+ inp <- rule' $ do+ let inp = urpfile .= "urp.in"+ toFile inp $ do+ forM hdr (line . toUrpLine (urpUp urpfile)) line ""- forM mod (line . toUrpLine up)+ forM mod (line . toUrpLine (urpUp urpfile)) - forM_ (urpObjs u) $ \o -> do- let incl = makevar "URINCL" "$(shell urweb -print-cinclude)"+ forM_ (urpSrcs u) $ \(c,fl) -> do+ let flags = concat $ fl : map (\p -> printf "$(shell pkg-config --cflags %s) " p) (urpPkgCfg u)+ let i = makevar "URINCL" "-I$(shell urweb -print-cinclude) " let cc = makevar "URCC" "$(shell $(shell urweb -print-ccompiler) -print-prog-name=gcc)"+ let cpp = makevar "URCPP" "$(shell $(shell urweb -print-ccompiler) -print-prog-name=g++)" rule2 $ do- shell [cmd| $cc -c -I $incl -o @o $(o .= "c") |]+ case takeExtension c of+ ".cpp" -> shell [cmd| $cpp -c $i $(string flags) -o @(c .= "o") $(c) |]+ ".c" -> shell [cmd| $cc -c $i -o $(string flags) @(c .= "o") $(c) |]+ e -> error ("Unknown C-source extension " ++ e) depend (urpDeps u) depend (urpLibs u)- shell [cmd|touch @urpfile|]- return u+ shell [cmd|touch @inp|] + rule' $ do+ let cpy = [cmd|cat $inp|] :: CommandGen' (Make' IO)+ let l = foldl' (\a p -> do+ let l = makevar (map toUpper $ printf "lib%s" p) (printf "$(shell pkg-config --libs %s)" p)+ [cmd| $a | sed 's@@$(string $ maskPkgCfg p)@@$l@@' |]+ ) cpy pkgcfg+ shell [cmd| $l > @urpfile |]+ return $ UWLib u -uwapp :: String -> File -> UrpGen (A' (Make' IO)) () -> Make UWExe+uwapp :: String -> File -> UrpGen (Make' IO) () -> Make UWExe uwapp opts urpfile m = do (UWLib u') <- uwlib urpfile m let u = u' { uexe = Just (urpfile .= "exe") }@@ -198,6 +248,7 @@ case urpSql' u of Nothing -> return () Just sql -> produce sql+ depend (makevar "URVERSION" "$(shell urweb -version)") unsafeShell [cmd|urweb $(string opts) $((takeDirectory urpfile)</>(takeBaseName urpfile))|] return $ UWExe u @@ -218,35 +269,57 @@ urpUp :: File -> FilePath urpUp f = F.joinPath $ map (const "..") $ filter (/= ".") $ F.splitDirectories $ F.takeDirectory $ toFilePath f -newtype UrEmbed = Urembed File- deriving (Show)+-- | Dir name , file to embed+-- data UrEmbed = Urembed File File+-- deriving (Show) -data UrpLibReference- = UrpLibStandalone File - | UrpLibInternal UWLib- | UrpLibEmbed UrEmbed- deriving(Show)+-- data UrpLibReference+-- = UrpLibStandaloneMake File +-- | UrpLibStandaloneMake2 File +-- | UrpLibInternal UWLib+-- | UrpLibEmbed File File+-- deriving(Show) -library' :: (MonadMake m) => File -> UrpGen m ()-library' l = do- when ((takeExtension l) /= ".urp") $ do- fail "library declaration for %s should ends with '.urp'" (toFilePath l)- addHdr $ UrpLibrary l+-- | A general method of including a library into the UrWeb project.+library' :: (MonadMake m)+ => Make [File] -- ^ A monadic action, returning a list of libraries to include+ -> UrpGen m ()+library' ml = do+ ls <- liftMake ml+ forM_ ls $ \l -> do+ when ((takeExtension l) /= ".urp") $ do+ fail $ printf "library declaration for %s should ends with '.urp'" (toFilePath l)+ addHdr $ UrpLibrary l -library :: (MonadMake m) => UrpLibReference -> UrpGen m ()-library (UrpLibStandalone l) = do- library' l- when ((toFilePath $ takeDirectory l) /= ".") $ do- prebuild [cmd| $(make) -C $(takeDirectory l) |]-library (UrpLibInternal (UWLib u)) = library' (urp u)-library (UrpLibEmbed ue) = error "urembed is not defined"+-- | Include a library defined somewhere in the current project+library :: (MonadMake m) => UWLib -> UrpGen m ()+library (UWLib u) = library' $ do+ return [urp u] -standalone f = UrpLibStandalone f-internal u = UrpLibInternal u-embed e = UrpLibEmbed e+-- | Build a file using external Makefile facility.+externalMake' ::+ File -- ^ External Makefile+ -> File -- ^ External file to refer to+ -> Make [File]+externalMake' mk f = do+ prebuild [cmd|$(make) -C $(string $ toFilePath $ takeDirectory mk) -f $(string $ takeFileName mk)|]+ return [f] -module_ :: (MonadMake m) => UrpModToken -> UrpGen m ()+-- | Build a file from external project. It is expected, that this project has a+-- 'Makwfile' in it's root directory+externalMake ::+ File -- ^ File from the external project to build+ -> Make [File]+externalMake f = externalMake' (takeDirectory f </> "Makefile") f++-- | Build a file from external project. It is expected, that this project has a+-- fiel.mk (a Makefile with an unusual name) in it's root directory+externalMake2 :: File -> Make [File]+externalMake2 f = externalMake' ((takeDirectory f </> takeFileName f) .= "mk") f++ur, module_ :: (MonadMake m) => UrpModToken -> UrpGen m () module_ = addMod+ur = addMod pair f = UrpModule2 (f.="ur") (f.="urs") single f = UrpModule1 f@@ -258,16 +331,25 @@ include :: (MonadMake m) => File -> UrpGen m () include f = addHdr $ UrpInclude f +link' :: (MonadMake m) => File -> String -> UrpGen m ()+link' f fl = addHdr $ UrpLink f fl+ link :: (MonadMake m) => File -> UrpGen m ()-link f = addHdr $ UrpLink f+link f = link' f [] +csrc' :: (MonadMake m) => File -> String -> String -> UrpGen m ()+csrc' f cfl lfl = addHdr $ UrpSrc f cfl lfl++csrc :: (MonadMake m) => File -> UrpGen m ()+csrc f = csrc' f [] []+ ffi :: (MonadMake m) => File -> UrpGen m () ffi s = addHdr $ UrpFFI s sql :: (MonadMake m) => File -> UrpGen m () sql f = addHdr $ UrpSql f -jsFunc n s = addHdr $ UrpJSFunc n s+jsFunc m u j = addHdr $ UrpJSFunc m u j safeGet s = addHdr $ UrpSafeGet s @@ -277,14 +359,24 @@ style = UrpStyle +all = UrpAll++responseHeader = UrpResponseHeader++script :: (MonadMake m) => String -> UrpGen m ()+script s = addHdr $ UrpScript s+ guessMime inf = fixup $ BS.unpack (defaultMimeLookup (fromString inf)) where fixup "application/javascript" = "text/javascript" fixup m = m +pkgconfig :: (MonadMake m) => String -> UrpGen m ()+pkgconfig l = addHdr $ UrpPkgConfig l+ data JSFunc = JSFunc {- urdecl :: String- , urname :: String- , jsname :: String+ urdecl :: String -- ^ URS declaration for this function+ , urname :: String -- ^ UrWeb name of this function+ , jsname :: String -- ^ JavaScript name of this function } deriving(Show) data JSType = JSType {@@ -467,7 +559,7 @@ line $ "val geturl = url(blobpage {})" forM_ jsdecls $ \decl -> do- jsFunc (printf "%s.%s = %s" (modname jsmod) (urname decl)) (jsname decl)+ addHdr $ UrpJSFunc (modname jsmod) (urname decl) (jsname decl) ffi (jsmod ".urs") safeGet $ printf "%s/blobpage" (modname wrapmod)
src/Development/Cake3/Ext/UrWeb/UrEmbed.hs view
@@ -107,7 +107,8 @@ let file = file' loc let bin = bin' (file ".") - s <- runMake $ do+ let mk = (("." </> takeFileName tgturp) .= "mk")+ writeMake (file mk) $ do let urp = file (takeFileName tgturp) u <- uwlib urp $ do forM_ (ins`zip`cntnts) $ \(i,c) -> do@@ -116,9 +117,6 @@ phony "all" depend u - let mk = (("." </> takeFileName tgturp) .= "mk")- writeFile mk s- when (drm == False) $ do system $ printf "make -f %s" mk return ()
src/Development/Cake3/Monad.hs view
@@ -331,6 +331,9 @@ refInput v@(CakeString s) = do return_text s +instance (MonadAction a m) => RefInput a m (CommandGen' m) where+ refInput (CommandGen' a) = liftAction a+ -- | Add it's argument to the list of dependencies (prerequsites) of a current -- recipe under construction depend :: (RefInput a m x)
src/Development/Cake3/Writer.hs view
@@ -215,11 +215,10 @@ line "" r <- runA_ "<internal>" $ do produce (queryTargets (recipes ms))+ unsafeShell [cmd|-mkdir .cake3|] commands (rcmd $ prebuilds ms)- commands [[CmdStr "$(MAKE) MAIN=1 $(MAKECMDGOALS)"]]+ unsafeShell [cmd|$(make) -f $(outputFile ms) MAIN=1 $(makecmdgoals)|] commands (rcmd $ postbuilds ms)- variables (rvars $ prebuilds ms)- variables (rvars $ postbuilds ms) markPhony writeRules $ applyPlacement (placement ms) $ fixMultiTarget [r] line ""@@ -228,7 +227,7 @@ line "# This Makefile was generated by the Cake3" line "# https://github.com/grwlf/cake3" line ""- line "GUARD = .GUARD_$(1)_$(shell echo $($(1)) | md5sum | cut -d ' ' -f 1)"+ line "GUARD = .cake3/GUARD_$(1)_$(shell echo $($(1)) | md5sum | cut -d ' ' -f 1)" line "" writeRegions hdr [mr,sr]@@ -302,6 +301,6 @@ -- FIXME: add those on the higher level forM_ vs $ \v -> do line (printf "$(call GUARD,%s):" (vname v))- line (printf "\trm -f .GUARD_%s_*" (vname v))+ line (printf "\trm -f .cake3/GUARD_%s_*" (vname v)) line "\ttouch $@"
src/System/FilePath/Wrapper.hs view
@@ -42,6 +42,7 @@ takeExtension :: a -> String takeExtensions :: a -> String dropExtensions :: a -> a+ dropExtension :: a -> a -- | Redefine standard @</>@ operator to work with Files (</>) :: (FileLike a) => a -> String -> a@@ -62,6 +63,7 @@ replaceExtension (FileT a) ext = FileT (replaceExtension a ext) takeDirectory (FileT a) = FileT (takeDirectory a) dropExtensions (FileT a) = FileT (dropExtensions a)+ dropExtension (FileT a) = FileT (dropExtension a) instance FileLike FilePath where -- fromFilePath = id@@ -74,4 +76,5 @@ takeExtension = F.takeExtension takeExtensions = F.takeExtensions dropExtensions = F.dropExtensions+ dropExtension = F.dropExtension