module Development.Cake3.Writer (toMake) where
import Control.Monad (when)
import Control.Applicative
import Control.Monad.State (State(..), execState, runState, modify, get, put)
import Data.List as L
import Data.Char
import Data.String
import Data.Foldable (forM_)
import Data.Traversable (forM)
import Data.Set (Set)
import qualified Data.Set as S
import Data.Map (Map)
import qualified Data.Map as M
import Text.Printf
import System.FilePath.Wrapper
import Development.Cake3.Types
import Development.Cake3.Monad
gen :: MakeWriter Int
gen = do
x <- head <$> cnt <$> get
modify (\ws -> ws { cnt = tail (cnt ws) })
return x
data WS = WS { cnt :: [Int] , ls :: String }
deriving(Show)
type MakeWriter a = State WS a
class ToMakeText x where
toMakeText :: x -> String
instance ToMakeText [Char] where
toMakeText = id
instance ToMakeText [[Char]] where
toMakeText = concat . map toMakeText
instance ToMakeText File where
toMakeText (FileT f) = escape f where
escape [] = []
escape (' ':xs) = "\\ " ++ escape xs
escape (x:xs) = (x:(escape xs))
trimE = dropWhileEnd isSpace
trimB = dropWhile isSpace
cs a b = a ++ (' ':b)
instance ToMakeText Command where
toMakeText [x] = either toMakeText toMakeText x
toMakeText ((Left str):(Right f):cmd) = toMakeText ((Left ((trimE str)`cs` (toMakeText f))):cmd)
toMakeText ((Right f):(Left str):cmd) = toMakeText ((Left ((toMakeText f)`cs`(trimB str))):cmd)
toMakeText ((Right a):(Right b):cmd) = toMakeText ((Left ((toMakeText a)`cs`(toMakeText b))):cmd)
toMakeText ((Left s1):(Left s2):cmd) = toMakeText ((Left (s1++s2)):cmd)
line :: String -> MakeWriter ()
line s = modify $ \ws -> ws { ls = concat [ls ws, s, "\n"] }
mmap f = map (f . snd) . M.toList
smap f = map f . S.toList
toMake :: (Map String Variable, Map Target Recipe2, [Target]) -> String
toMake (vs_, rs_, p) =
let (vs,rs) = (map snd $ M.toList vs_, applyPlacement rs_ p)
in ls $ flip execState (WS [1..] "") $ do
line "# This Makefile was generated by the ThirdCake"
line "# https://github.com/grwlf/cake3"
line ""
when (not (null vs)) $ do
line "GUARD = .GUARD_$(1)_$(shell echo $($(1)) | md5sum | cut -d ' ' -f 1)"
forM_ vs $ \v -> case v of
(Variable n (Just v)) -> line (printf "%s = %s" n v)
(Variable n Nothing) -> return ()
forM_ rs $ \r -> do
let varguard v = printf "$(call GUARD,%s)" (vname v)
let deps = intercalate " " $ (smap toMakeText (rsrc r)) ++ (mmap varguard (rvars r))
let tgts = intercalate " " $ (smap toMakeText (rtgt r))
when (rphony r) $ do
line (printf ".PHONY: %s" tgts)
case (S.size (rtgt r)) of
0 -> do
return ()
1 -> do
let s = (S.findMin (rtgt r))
line $ printf "%s: %s" (toMakeText s) deps
forM_ (rcmd r) $ \c -> do
line (printf "\t%s" (toMakeText c))
_ -> do
i <- gen
let s = (printf "stamp%d" i :: String)
line (printf "%s: %s" tgts s)
line (printf ".INTERMEDIATE: %s" s)
line (printf "%s: %s" s deps)
forM_ (rcmd r) $ \c -> do
line (printf "\t%s" (toMakeText c))
forM_ vs $ \v -> do
line (printf "$(call GUARD,%s):" (vname v))
line (printf "\trm -f .GUARD_%s_*" (vname v))
line "\ttouch $@"