Skip to content

Commit

Permalink
fix partials
Browse files Browse the repository at this point in the history
  • Loading branch information
@singpolyma
singpolyma committed Aug 23, 2012
1 parent 603f81b commit 62792be
Showing 1 changed file with 39 additions and 29 deletions.
68 changes: 39 additions & 29 deletions mustache2hs.hs
View file
Expand Up @@ -4,14 +4,15 @@ import System.Environment (getArgs, getProgName)
import System.Exit (exitFailure) import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr) import System.IO (hPutStrLn, stderr)
import System.Console.GetOpt (getOpt, usageInfo, ArgOrder(..), OptDescr(..), ArgDescr(..)) import System.Console.GetOpt (getOpt, usageInfo, ArgOrder(..), OptDescr(..), ArgDescr(..))
import System.FilePath (takeBaseName, dropExtension) import System.FilePath (takeBaseName, dropExtension, takeDirectory, (</>))
import Data.Monoid import Data.Monoid
import Data.Maybe import Data.Maybe
import Data.Char import Data.Char
import Data.List import Data.List
import Control.Monad import Control.Monad
import Control.Arrow import Control.Arrow
import Control.Monad.Trans.State (get, modify, evalState, State) import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State (get, modify, evalState, State, StateT, evalStateT)


import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
Expand Down Expand Up @@ -146,10 +147,10 @@ originalMustache = mconcat . map origOne
] ]
origOne _ = mempty origOne _ = mempty


codeGenTree :: (Show a, Enum a) => Text -> String -> Records -> MuTree -> State a (Builder, [Text]) codeGenTree :: (Show a, Enum a) => FilePath -> Text -> String -> Records -> MuTree -> State a (Builder, [(FilePath, String)])
codeGenTree fname rname recs tree = do codeGenTree path fname rname recs tree = do
let rec = recordMustExist $ lookup rname recs let rec = recordMustExist $ lookup rname recs
(code, helpers', partials) <- unzip3 <$> mapM (codeGen (rname,rec) recs) tree (code, helpers', partials) <- unzip3 <$> mapM (codeGen path (rname,rec) recs) tree
let helpers = concat helpers' let helpers = concat helpers'
return (mconcat [ return (mconcat [
Builder.fromText fname, Builder.fromText fname,
Expand Down Expand Up @@ -178,25 +179,25 @@ codeGenTree fname rname recs tree = do
wsep = Builder.fromString "; " wsep = Builder.fromString "; "
comma = Builder.fromString ", " comma = Builder.fromString ", "


codeGen :: (Show a, Enum a) => (String,Record) -> Records -> Mustache -> State a (Builder, [Builder], [Text]) codeGen :: (Show a, Enum a) => FilePath -> (String,Record) -> Records -> Mustache -> State a (Builder, [Builder], [(FilePath, String)])
codeGen _ _ (MuText txt) = return (mconcat [ codeGen _ _ _ (MuText txt) = return (mconcat [
Builder.fromString "Builder.fromString ", Builder.fromString "Builder.fromString ",
Builder.fromShow (T.unpack txt) Builder.fromShow (T.unpack txt)
], [], []) ], [], [])
codeGen _ _ (MuVar name False) = return (mconcat [ codeGen _ _ _ (MuVar name False) = return (mconcat [
Builder.fromString "fromMaybe mempty (fmap ", Builder.fromString "fromMaybe mempty (fmap ",
Builder.fromString "(Builder.fromString . show . pretty) (", Builder.fromString "(Builder.fromString . show . pretty) (",
Builder.fromText name, Builder.fromText name,
Builder.fromString "))" Builder.fromString "))"
], [], []) ], [], [])
codeGen _ _ (MuVar name True) = return (mconcat [ codeGen _ _ _ (MuVar name True) = return (mconcat [
Builder.fromString "fromMaybe mempty (fmap (", Builder.fromString "fromMaybe mempty (fmap (",
Builder.fromString "Builder.fromString . escapeFunction . show . pretty", Builder.fromString "Builder.fromString . escapeFunction . show . pretty",
Builder.fromString ") (", Builder.fromString ") (",
Builder.fromText name, Builder.fromText name,
Builder.fromString "))" Builder.fromString "))"
], [], []) ], [], [])
codeGen (rname,rec) recs (MuSection name stree) codeGen path (rname,rec) recs (MuSection name stree)
| lookup name (snd rec) == Just MuLambda = | lookup name (snd rec) == Just MuLambda =
return (mconcat [ return (mconcat [
Builder.fromText name, Builder.fromText name,
Expand All @@ -211,41 +212,44 @@ codeGen (rname,rec) recs (MuSection name stree)
let nm = name `mappend` T.pack (show id) let nm = name `mappend` T.pack (show id)
case lookup name (snd rec) of case lookup name (snd rec) of
Just (MuList rname) -> do Just (MuList rname) -> do
(helper, partials) <- codeGenTree nm rname recs stree (helper, partials) <- codeGenTree path nm rname recs stree
return (mconcat [ return (mconcat [
Builder.fromString "mconcat $ map (", Builder.fromString "mconcat $ map (",
Builder.fromText nm, Builder.fromText nm,
Builder.fromString " escapeFunction) ", Builder.fromString " escapeFunction) ",
Builder.fromText name Builder.fromText name
], [helper], partials) ], [helper], partials)
_ -> do _ -> do
(helper, partials) <- codeGenTree nm rname recs stree (helper, partials) <- codeGenTree path nm rname recs stree
return (mconcat [ return (mconcat [
Builder.fromString "case ", Builder.fromString "case ",
Builder.fromText name, Builder.fromText name,
Builder.fromString " of { Just _ -> (", Builder.fromString " of { Just _ -> (",
Builder.fromText nm, Builder.fromText nm,
Builder.fromString " escapeFunction ctx); _ -> mempty }" Builder.fromString " escapeFunction ctx); _ -> mempty }"
], [helper], partials) ], [helper], partials)
codeGen (rname,rec) recs (MuSectionInv name stree) = do codeGen path (rname,rec) recs (MuSectionInv name stree) = do
id <- get id <- get
modify succ modify succ
let nm = name `mappend` T.pack (show id) let nm = name `mappend` T.pack (show id)
(helper, partials) <- codeGenTree nm rname recs stree (helper, partials) <- codeGenTree path nm rname recs stree
return (mconcat [ return (mconcat [
Builder.fromString "if foldr (\\_ _ -> False) True ", Builder.fromString "if foldr (\\_ _ -> False) True ",
Builder.fromText name, Builder.fromText name,
Builder.fromString " then ", Builder.fromString " then ",
Builder.fromText nm, Builder.fromText nm,
Builder.fromString " escapeFunction ctx else mempty" Builder.fromString " escapeFunction ctx else mempty"
], [helper], partials) ], [helper], partials)
codeGen (rname,rec) recs (MuPartial name) = codeGen path (rname,rec) recs (MuPartial name) =
let fname = takeBaseName $ T.unpack name in let
file = takeDirectory path </> T.unpack name
fname = camelCasePath (dropExtension file)
in
return (mconcat [ return (mconcat [
Builder.fromString fname, Builder.fromText fname,
Builder.fromString " escapeFunction ctx" Builder.fromString " escapeFunction ctx"
], [], [name]) ], [], [(file, rname)])
codeGen _ _ _ = return (mempty, [], []) codeGen _ _ _ _ = return (mempty, [], [])


camelCasePath :: FilePath -> Text camelCasePath :: FilePath -> Text
camelCasePath = T.pack . go camelCasePath = T.pack . go
Expand All @@ -255,20 +259,26 @@ camelCasePath = T.pack . go
go (c:cs) = c : go cs go (c:cs) = c : go cs
go [] = [] go [] = []


codeGenFile :: Records -> (FilePath, String) -> IO (Builder, [FilePath]) codeGenFile :: Records -> (FilePath, String) -> StateT [(FilePath, String)] IO (Builder, [(FilePath, String)])
codeGenFile recs (input, rname) = do codeGenFile recs (input, rname) = do
Right tree <- parseOnly parser <$> T.readFile input alreadyGen <- lookup input <$> get
let fname = camelCasePath (dropExtension input) case alreadyGen of
let (builder, partials) = evalState (codeGenTree fname rname recs tree) 0 Just r
return (builder, map T.unpack partials) | r == rname -> return (mempty, [])
| otherwise -> fail ("Type mismatch, template " ++ input ++ " expects both " ++ r ++ " and " ++ "rname")
Nothing -> do
modify ((input,rname):)
Right tree <- lift $ parseOnly parser <$> T.readFile input
let fname = camelCasePath (dropExtension input)
let (builder, partials) = evalState (codeGenTree input fname rname recs tree) 0
return (builder, partials)


codeGenFiles :: Records -> [(FilePath, String)] -> IO Builder codeGenFiles :: Records -> [(FilePath, String)] -> StateT [(FilePath, String)] IO Builder
codeGenFiles _ [] = return mempty codeGenFiles _ [] = return mempty
codeGenFiles recs inputs = do codeGenFiles recs inputs = do
(builders, partials) <- unzip <$> mapM (codeGenFile recs) inputs (builders, partials) <- unzip <$> mapM (codeGenFile recs) inputs
--builder <- codeGenFiles recs (concat partials) builder <- codeGenFiles recs (concat partials)
let builder = mempty -- TODO partials return $ (mintercalate nl builders) `mappend` nl `mappend` builder
return $ (mintercalate nl builders) `mappend` builder
where where
nl = Builder.fromString "\n" nl = Builder.fromString "\n"


Expand All @@ -283,7 +293,7 @@ main = do
where where
main' recordModules inputs = do main' recordModules inputs = do
(ms, recs) <- unzip <$> mapM (fmap extractRecords . readFile) recordModules (ms, recs) <- unzip <$> mapM (fmap extractRecords . readFile) recordModules
builder <- codeGenFiles (concat recs) inputs builder <- evalStateT (codeGenFiles (concat recs) inputs) []
putStrLn "import Prelude hiding (foldr)" putStrLn "import Prelude hiding (foldr)"
putStrLn "import Data.Foldable (foldr)" putStrLn "import Data.Foldable (foldr)"
putStrLn "import Data.Maybe" putStrLn "import Data.Maybe"
Expand Down

0 comments on commit 62792be

Please sign in to comment.