packages feed

mustache2hs 0.1.1 → 0.2

raw patch · 4 files changed

+20/−101 lines, 4 files

Files

− ParseRecords.hs 
@@ -1,84 +0,0 @@-module ParseRecords (extractRecords, MuType(..), Records, Record, Field) where--import Data.List-import Data.Maybe-import Control.Arrow--import Language.Haskell.Parser-import Language.Haskell.Syntax--import Data.Text (Text)-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 | MuBool | MuNum deriving (Show, Eq)--isDataDecl :: HsDecl -> Bool-isDataDecl (HsDataDecl {}) = True-isDataDecl _ = False--isTypeDecl :: HsDecl -> Bool-isTypeDecl (HsTypeDecl {}) = True-isTypeDecl _ = False--hsNameToString :: HsName -> String-hsNameToString (HsIdent s) = s-hsNameToString (HsSymbol s) = s--extractTypeFromBangType :: HsBangType -> HsType-extractTypeFromBangType (HsBangedTy t) = t-extractTypeFromBangType (HsUnBangedTy t) = t--hsTypeName' :: [(String, HsType)] -> HsType -> Maybe String-hsTypeName' types (HsTyCon (UnQual s)) | isJust $ lookup (hsNameToString s) types =-	hsTypeName' types =<< lookup (hsNameToString s) types-hsTypeName' _ (HsTyCon (UnQual s)) = Just $ hsNameToString s-hsTypeName' _ _ = Nothing--hsTypeName :: [(String, HsType)] -> HsType -> String-hsTypeName types t =-	fromMaybe (error $ "Trying to get type name for: " ++ show t)-		(hsTypeName' types t)--hsTypeToMuType :: [(String, HsType)] -> HsType -> MuType-hsTypeToMuType types (HsTyApp (HsTyCon (Special HsListCon)) t) = MuList (hsTypeName types t)-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-extractFromField types (name, t) =-	(T.pack $ concatMap hsNameToString name, hsTypeToMuType types $ extractTypeFromBangType t)--extractFromRecordConstructor :: [(String, HsType)] -> HsConDecl -> Record-extractFromRecordConstructor types (HsRecDecl _ cname fields) =-	(hsNameToString cname, map (extractFromField types) fields)-extractFromRecordConstructor _ _ = error "Only single data-constructor records may be used as context"--extractFromDataDecl :: [(String, HsType)] -> HsDecl -> (String, Record)-extractFromDataDecl types (HsDataDecl _ _ typeName _ [constructor] _) =-	(hsNameToString typeName, extractFromRecordConstructor types constructor)-extractFromDataDecl _ (HsDataDecl _ _ typeName  _ _ _) =-	(hsNameToString typeName, error "Only single data-constructor records may be used as context")-extractFromDataDecl _ _ = error "Programmer error, only call extractFromDataDecl with DataDecl"--extractFromTypeDecl :: HsDecl -> (String, HsType)-extractFromTypeDecl (HsTypeDecl _ name _ t) = (hsNameToString name, t)-extractFromTypeDecl _ = error "Programmer error, only call extractFromTypeDecl with TypeDecl"--extractRecords :: String -> (String, Records, [(String, Maybe String)])-extractRecords moduleSrc =-	(mod, map (extractFromDataDecl types) datas, simpleTypes)-	where-	simpleTypes = map (second $ hsTypeName' types) types-	types = map extractFromTypeDecl typeDecls-	(typeDecls, datas) = partition (isTypeDecl) $ filter (\d -> isDataDecl d || isTypeDecl d) decls-	ParseOk (HsModule _ (Module mod) _ _ decls) = parseModule moduleSrc
README view
@@ -1,7 +1,7 @@-This utility take in Haskell records (single data constructor only)+This utility takes in Haskell records (single data constructor only) and a list of mustache template and record name pairs, and generates Haskell code for functions that take an escape function and one of-the records, and returns a 'Builder'.+the records, and returns a 'Data.Text.Lazy.Builder.Builder'.  This allows most records to be used as context for rendering a template, and gives GHC the ability to typecheck the template's use of
mustache2hs.cabal view
@@ -1,5 +1,5 @@ name:            mustache2hs-version:         0.1.1+version:         0.2 cabal-version:   >= 1.8 license:         OtherLicense license-file:    COPYING@@ -14,10 +14,10 @@ bug-reports:     http://github.com/singpolyma/mustache2hs/issues build-type:      Simple description:-        This utility take in Haskell records (single data constructor only)+        This utility takes in Haskell records (single data constructor only)         and a list of mustache template and record name pairs, and generates         Haskell code for functions that take an escape function and one of-        the records, and returns a 'Builder'.+        the records, and returns a 'Data.Text.Lazy.Builder.Builder'.         .         This allows most records to be used as context for rendering a         template, and gives GHC the ability to typecheck the template's use of@@ -35,7 +35,6 @@  executable mustache2hs         main-is: mustache2hs.hs-        other-modules: ParseRecords          build-depends:                 base == 4.*,
mustache2hs.hs view
@@ -79,9 +79,9 @@ 	comment = mustache True $ do 		_ <- char '!' 		_ <- many $ do-				c1 <- anyChar+				c1 <- peekChar 				c2 <- peekChar-				if c1 /= '}' || c2 /= Just '}' then return c1 else+				if c1 /= Just '}' || c2 /= Just '}' then anyChar else 					fail "End of comment text" 		return MuComment 	sectionInv =@@ -223,15 +223,15 @@  codeGen :: (Show a, Enum a) => FilePath -> (String,Record) -> Records -> Word -> Mustache -> State a (Builder, [Builder], [(FilePath, String)]) codeGen _ _ _ _ (MuText txt) = return (mconcat [-		Builder.fromString "Builder.fromString ",+		Builder.fromString "build ", 		Builder.fromShow (T.unpack txt) 	], [], []) codeGen _ _ _ _ (MuVar name False) = return (mconcat [-		Builder.fromString "Builder.fromString $ show $ pretty ",+		Builder.fromString "build ", 		Builder.fromText name 	], [], []) codeGen _ _ _ _ (MuVar name True) = return (mconcat [-		Builder.fromString "Builder.fromString $ escapeFunction $ show $ pretty ",+		Builder.fromString "build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build ", 		Builder.fromText name 	], [], []) codeGen path (rname,rec) recs level (MuSection name stree)@@ -320,10 +320,13 @@ 			| otherwise -> fail ("Type mismatch, template " ++ input ++ " expects both " ++ r ++ " and " ++ "rname") 		Nothing -> do 			modify ((input',rname):)-			Right tree <- lift $ parse parser input <$> T.readFile input-			let fname = camelCasePath (dropExtension input)-			let (builder, partials) = evalState (codeGenTree input fname rname recs tree 0) (0::Int)-			return (Just builder, partials)+			parsed <- lift $ parse (parser <* eof) input <$> T.readFile input+			case parsed of+				Right tree -> do+					let fname = camelCasePath (dropExtension input)+					let (builder, partials) = evalState (codeGenTree input fname rname recs tree 0) (0::Int)+					return (Just builder, partials)+				Left msg -> error (show msg) 	where 	input' = normalise input @@ -356,8 +359,9 @@ 		putStrLn "module MustacheTemplates where" 		putStrLn "" 		putStrLn "import Data.Monoid"-		putStrLn "import Text.PrettyPrint.Leijen"-		putStrLn "import qualified Blaze.ByteString.Builder.Char.Utf8 as Builder"+		putStrLn "import Data.Text.Buildable (build)"+		putStrLn "import qualified Data.Text.Lazy as TL"+		putStrLn "import qualified Data.Text.Lazy.Builder as TL" 		mapM_ (\m -> putStrLn $ "import " ++ m ++ "\n") ms 		Builder.toByteStringIO BS.putStr builder 		putStrLn ""