Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Stop requiring MuVariables be Maybe

Start requiring that they be Monoid.  Or Bool.  Or one of a list of
supported Nums.
  • Loading branch information...
commit 23e0847dc16d9bba1a1cb88079fdf3c7d199fa4f 1 parent ea04360
@singpolyma authored
Showing with 26 additions and 22 deletions.
  1. +6 −1 ParseRecords.hs
  2. +20 −21 mustache2hs.hs
View
7 ParseRecords.hs
@@ -13,7 +13,7 @@ import qualified Data.Text as T
type Records = [(String, Record)] -- Typename, data constructor
type Record = (String, [Field]) -- Data constructor name, fields
type Field = (Text, MuType)
-data MuType = MuList String | MuLambda | MuVariable deriving (Show, Eq)
+data MuType = MuList String | MuLambda | MuVariable | MuBool | MuNum deriving (Show, Eq)
isDataDecl :: HsDecl -> Bool
isDataDecl (HsDataDecl {}) = True
@@ -47,6 +47,11 @@ hsTypeToMuType types (HsTyApp (HsTyCon (Special HsListCon)) t) = MuList (hsTypeN
hsTypeToMuType _ (HsTyFun {}) = MuLambda
hsTypeToMuType types (HsTyCon (UnQual s)) | isJust $ lookup (hsNameToString s) types =
hsTypeToMuType types $ fromJust $ lookup (hsNameToString s) types
+hsTypeToMuType types t | hsTypeName' types t == Just "Bool" = MuBool
+hsTypeToMuType types t | hsTypeName' types t `elem` map Just [
+ "Int", "Int8", "Int16", "Int32", "Int64", "Integer", "Word", "Word8",
+ "Word16", "Word32", "Word64", "Double", "Float", "Rational"
+ ] = MuNum
hsTypeToMuType _ _ = MuVariable
extractFromField :: [(String, HsType)] -> ([HsName], HsBangType) -> Field
View
41 mustache2hs.hs
@@ -185,17 +185,12 @@ codeGen _ _ _ (MuText txt) = return (mconcat [
Builder.fromShow (T.unpack txt)
], [], [])
codeGen _ _ _ (MuVar name False) = return (mconcat [
- Builder.fromString "fromMaybe mempty (fmap ",
- Builder.fromString "(Builder.fromString . show . pretty) (",
- Builder.fromText name,
- Builder.fromString "))"
+ Builder.fromString "Builder.fromString $ show $ pretty ",
+ Builder.fromText name
], [], [])
codeGen _ _ _ (MuVar name True) = return (mconcat [
- Builder.fromString "fromMaybe mempty (fmap (",
- Builder.fromString "Builder.fromString . escapeFunction . show . pretty",
- Builder.fromString ") (",
- Builder.fromText name,
- Builder.fromString "))"
+ Builder.fromString "Builder.fromString $ escapeFunction $ show $ pretty ",
+ Builder.fromText name
], [], [])
codeGen path (rname,rec) recs (MuSection name stree)
| lookup name (snd rec) == Just MuLambda =
@@ -219,22 +214,28 @@ codeGen path (rname,rec) recs (MuSection name stree)
Builder.fromString " escapeFunction) ",
Builder.fromText name
], [helper], partials)
- _ -> do
- (helper, partials) <- codeGenTree path nm rname recs stree
- return (mconcat [
- Builder.fromString "case ",
- Builder.fromText name,
- Builder.fromString " of { Just _ -> (",
- Builder.fromText nm,
- Builder.fromString " escapeFunction ctx); _ -> mempty }"
- ], [helper], partials)
+ Just MuBool ->
+ doVar (T.pack "(Any " `mappend` name `mappend` T.pack ")") nm
+ Just MuNum ->
+ doVar (T.pack "(Sum " `mappend` name `mappend` T.pack ")") nm
+ _ -> doVar name nm
+ where
+ doVar name nm = do
+ (helper, partials) <- codeGenTree path nm rname recs stree
+ return (mconcat [
+ Builder.fromString "if mempty /= ",
+ Builder.fromText name,
+ Builder.fromString " then ",
+ Builder.fromText nm,
+ Builder.fromString " escapeFunction ctx else mempty"
+ ], [helper], partials)
codeGen path (rname,rec) recs (MuSectionInv name stree) = do
id <- get
modify succ
let nm = name `mappend` T.pack (show id)
(helper, partials) <- codeGenTree path nm rname recs stree
return (mconcat [
- Builder.fromString "if foldr (\\_ _ -> False) True ",
+ Builder.fromString "if mempty == ",
Builder.fromText name,
Builder.fromString " then ",
Builder.fromText nm,
@@ -296,8 +297,6 @@ main = do
let types' = concat types
let inputs' = map (second (\r -> fromMaybe r (join $ lookup r types'))) inputs
builder <- evalStateT (codeGenFiles (concat recs) inputs') []
- putStrLn "import Prelude hiding (foldr)"
- putStrLn "import Data.Foldable (foldr)"
putStrLn "import Data.Maybe"
putStrLn "import Data.Monoid"
putStrLn "import Text.PrettyPrint.Leijen"
Please sign in to comment.
Something went wrong with that request. Please try again.