template-hsml (empty) → 0.1.0.0
raw patch · 8 files changed
+763/−0 lines, 8 filesdep +basedep +blaze-markupdep +haskell-src-extssetup-changed
Dependencies added: base, blaze-markup, haskell-src-exts, haskell-src-meta, parsec, template-haskell
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Template/HSML.hs +15/−0
- src/Template/HSML/Internal/Parser.hs +100/−0
- src/Template/HSML/Internal/Parser/Raw.hs +213/−0
- src/Template/HSML/Internal/TH.hs +209/−0
- src/Template/HSML/Internal/Types.hs +152/−0
- template-hsml.cabal +42/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Petr Pilař++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Petr Pilař nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Template/HSML.hs view
@@ -0,0 +1,15 @@+module Template.HSML+( module Export+) where++------------------------------------------------------------------------------+import Template.HSML.Internal.TH as Export+import Template.HSML.Internal.Types as Export ( HSMLTemplate(..)+ , Options(..)+ , defaultHSML+ , defaultSHSML+ )+------------------------------------------------------------------------------+++
+ src/Template/HSML/Internal/Parser.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE RecordWildCards #-}++module Template.HSML.Internal.Parser+( hsmlParser+, shsmlParser++, hsmlTemplate+, shsmlTemplate+) where++------------------------------------------------------------------------------+import qualified Language.Haskell.Exts.Parser as HE+-- import qualified Language.Haskell.Exts.Extension as HE+-- import qualified Language.Haskell.Exts.Syntax as HE+------------------------------------------------------------------------------+import Control.Applicative+------------------------------------------------------------------------------+import Data.Monoid ((<>))+------------------------------------------------------------------------------+import qualified Text.Parsec.String as P+import qualified Text.Parsec.Prim as P+------------------------------------------------------------------------------+import qualified Template.HSML.Internal.Types as I+import qualified Template.HSML.Internal.Parser.Raw as I+------------------------------------------------------------------------------++hsmlTemplate :: String -> Either String I.Template+hsmlTemplate str = + case P.parse hsmlParser ".HSML" str of+ Right tpl -> Right tpl+ Left err -> Left $ show err++hsmlParser :: P.Parser I.Template+hsmlParser = I.hsmlParser >>= transform++shsmlTemplate :: String -> Either String I.Template+shsmlTemplate str =+ case P.parse shsmlParser ".HSML" str of+ Right tpl -> Right tpl+ Left err -> Left $ show err ++shsmlParser :: P.Parser I.Template+shsmlParser = I.shsmlParser >>= transform++------------------------------------------------------------------------------++transform :: I.RTemplate -> P.Parser I.Template+transform I.Template{..} = do+ args <- mapM transformArg templateArgs+ decs <- mapM transformDec templateDecs+ sections <- mapM transformSection templateSections+ return I.Template+ { I.templateArgs = args+ , I.templateDecs = decs+ , I.templateSections = sections+ }++transformArg :: I.RArg -> P.Parser I.Arg+transformArg (I.RArg name mtype) =+ case mtype of+ Just stype ->+ case HE.parseType stype of+ HE.ParseOk t -> return . I.Arg name $ Just t+ HE.ParseFailed _ r -> fail $ "Could not parse type \"" <> stype <> "\", reason: " <> r+ Nothing -> return $ I.Arg name Nothing++transformDec :: I.RDec -> P.Parser I.Dec+transformDec (I.RDec sdec) = + case HE.parseDecl sdec of+ HE.ParseOk d -> return $ I.Dec d+ HE.ParseFailed _ r -> fail $ "Could not parse declaration \"" <> sdec <> "\", reason: " <> r++transformExp :: I.RExp -> P.Parser I.Exp+transformExp (I.RExp sexp) =+ case HE.parseExp sexp of+ HE.ParseOk e -> return $ I.Exp e + HE.ParseFailed _ r -> fail $ "Could not parse expression \"" <> sexp <> "\", reason: " <> r++transformSection :: I.RSection -> P.Parser I.Section+transformSection (I.ElementNode name rattributes rsections) = do+ attributes <- mapM transformAttribute rattributes+ sections <- mapM transformSection rsections+ return $ I.ElementNode name attributes sections+transformSection (I.ElementLeaf name rattributes) = do+ attributes <- mapM transformAttribute rattributes+ return $ I.ElementLeaf name attributes+transformSection (I.Text text) = return $ I.Text text+transformSection (I.TextRaw text) = return $ I.TextRaw text+transformSection (I.Expression rexp) = I.Expression <$> transformExp rexp++transformAttribute :: I.RAttribute -> P.Parser I.Attribute+transformAttribute (I.Attribute rname rvalue) =+ I.Attribute <$> transformName rname <*> transformValue rvalue + where+ transformName (I.AttributeNameExp rexp) = I.AttributeNameExp <$> transformExp rexp+ transformName (I.AttributeNameText text) = return $ I.AttributeNameText text++ transformValue (I.AttributeValueExp rexp) = I.AttributeValueExp <$> transformExp rexp+ transformValue (I.AttributeValueText text) = return $ I.AttributeValueText text+
+ src/Template/HSML/Internal/Parser/Raw.hs view
@@ -0,0 +1,213 @@+module Template.HSML.Internal.Parser.Raw+( hsmlParser+, shsmlParser+) where++------------------------------------------------------------------------------+import Control.Applicative+import Control.Monad+------------------------------------------------------------------------------+import Data.Char+------------------------------------------------------------------------------+import qualified Text.Parsec.String as P+import qualified Text.Parsec.Combinator as P+import qualified Text.Parsec.Char as P+import qualified Text.Parsec.Prim as P+------------------------------------------------------------------------------+import qualified Template.HSML.Internal.Types as I+------------------------------------------------------------------------------++-- | .HSML parser.+hsmlParser:: P.Parser I.RTemplate+hsmlParser = do+ spaces + args <- P.try $ sepEndBy argument spaces+ chus <- P.try $ sepEndBy1 chunk spaces+ P.eof+ return . templateFromSyntax $ Syntax args chus++-- | Simple .HSML parser (argument are not allowed).+shsmlParser :: P.Parser I.RTemplate+shsmlParser = do+ spaces+ chus <- P.try $ sepEndBy1 chunk spaces + P.eof+ return . templateFromSyntax $ Syntax [] chus++--------------------------------------------------------------------------------++templateFromSyntax :: Syntax -> I.RTemplate+templateFromSyntax (Syntax args chunks) =+ I.Template args decs secs+ where+ (decs, secs) = foldr go ([], []) chunks+ go (Dec d) (ds, ss) = (d : ds, ss)+ go (Sec s) (ds, ss) = (ds, s : ss) ++--------------------------------------------------------------------------------++chunk :: P.Parser Chunk+chunk = Dec <$> declaration <|>+ Sec <$> section++--------------------------------------------------------------------------------+-- | Declaration++-- | Raw declaration conforms to the following:+-- "{a|" <spaces> <funIdent> [ <spaces> "::" <spaces> <typeIdent> ] <spaces> "|}"+argument :: P.Parser I.RArg+argument = do+ P.string "{a|" >> spaces+ aname <- funIdent+ atype <- maybeParser $ P.spaces >> P.string "::" >> spaces >> typeIdent + spaces >> P.string "|}" >> spaces+ return $ I.RArg aname atype++--------------------------------------------------------------------------------+-- | Declaration++-- | Raw declaration conforms to the following:+-- "{d|" <string without "|}" substring> "|}"+declaration :: P.Parser I.RDec+declaration = I.RDec <$> wrappedText 'd' P.anyChar ++--------------------------------------------------------------------------------+-- | Section++section :: P.Parser I.RSection+section = P.try ( elementNode <|>+ elementLeaf <|>+ expression <|>+ textRaw <|>+ text + )++--------------------------------------------------------------------------------+-- | Elements++elementNode :: P.Parser I.RSection+elementNode = P.try $ do+ (name, attributes) <- tagOpening <* P.string ">"+ body <- many section + tagClosing name + return $ I.ElementNode name attributes body++elementLeaf :: P.Parser I.RSection+elementLeaf = P.try $ do+ (name, attributes) <- tagOpening <* P.string "/>"+ return $ I.ElementLeaf name attributes++attribute :: P.Parser I.RAttribute+attribute = do+ n <- attributeName+ spaces >> P.char '=' >> spaces+ v <- attributeValue+ return $ I.Attribute n v++attributeName :: P.Parser I.RAttributeName+attributeName = P.try $+ P.try (I.AttributeNameText <$> attributeIdent) <|>+ (I.AttributeNameExp . I.RExp <$> expressionText) ++attributeValue :: P.Parser I.RAttributeValue+attributeValue = P.try $+ P.try (P.char '\"' *> (I.AttributeValueText <$> attributeIdent) <* P.char '\"') <|>+ (I.AttributeValueExp . I.RExp <$> expressionText)++attributeIdent :: P.Parser String+attributeIdent = P.many1 $ P.satisfy ((||) <$> isAlphaNum <*> (`elem` " -_"))++--------------------------------------------------------------------------------+-- | Text ++text :: P.Parser I.RSection+text = P.try $ I.Text <$> P.many1 (textChar '\\' (`elem` "<{"))++textRaw :: P.Parser I.RSection+textRaw = I.TextRaw <$> wrappedText 'r' (textChar '\\' (`elem` "<{")) ++textChar :: Char -> (Char -> Bool) -> P.Parser Char+textChar esc needEsc = escapedChar <|> P.satisfy (\c -> not (needEsc c || c == esc))+ where + escapedChar = P.try $ P.char esc >> P.anyChar ++--------------------------------------------------------------------------------+-- | Expression++-- | Raw expression conforms to the following:+-- "{e|" <string without "|}" substring> "|}"+expression :: P.Parser I.RSection+expression = I.Expression . I.RExp <$> expressionText++--------------------------------------------------------------------------------++tagOpening :: P.Parser (String, [I.RAttribute]) +tagOpening = P.try $ do+ P.char '<' >> spaces+ name <- tagIdentifier+ spaces+ attributes <- sepEndBy attribute spaces+ return (name, attributes)++tagClosing :: String -> P.Parser ()+tagClosing tagName = P.try . void $ do+ P.string "</"+ spaces+ P.string tagName+ spaces+ P.char '>'++tagIdentifier :: P.Parser String+tagIdentifier = P.try $ P.many1 P.alphaNum++--------------------------------------------------------------------------------++expressionText :: P.Parser String+expressionText = wrappedText 'e' P.anyChar++wrappedText :: Char -> P.Parser Char -> P.Parser String+wrappedText m p = P.try $+ P.string ['{', m, '|'] *> many1Until p (P.string "|}") <* P.string "|}"++funIdent :: P.Parser String+funIdent = (:) <$> P.lower <*> P.many P.alphaNum++typeIdent :: P.Parser String+typeIdent = (:) <$> P.upper <*> P.many (P.satisfy (/= ' '))++--------------------------------------------------------------------------------++data Syntax = Syntax [I.RArg] [Chunk]++data Chunk = Dec I.RDec+ | Sec I.RSection++--------------------------------------------------------------------------------+-- CONVENIENCE FUNCTIONS++maybeParser :: P.Parser a -> P.Parser (Maybe a)+maybeParser p = (Just <$> P.try p) <|> return Nothing++spaces :: P.Parser ()+spaces = void $ P.many P.space++-- spaces1 :: P.Parser ()+-- spaces1 = void $ P.many1 P.space++sepEndBy1 :: P.Parser a -> P.Parser b -> P.Parser [a]+sepEndBy1 p sep = P.try $ do+ x <- p+ P.try ((x:) <$> (sep >> sepEndBy p sep)) <|> return [x]++sepEndBy :: P.Parser a -> P.Parser b -> P.Parser [a]+sepEndBy p sep = P.try (sepEndBy1 p sep) <|> return []++manyUntil :: P.Parser a -> P.Parser b -> P.Parser [a]+manyUntil p stop = P.try $ P.manyTill p (P.lookAhead $ void (P.try stop) <|> void P.eof)++many1Until :: P.Parser a -> P.Parser b -> P.Parser [a]+many1Until p stop = P.try $ do+ x <- p+ xs <- manyUntil p stop+ return $ x : xs+
+ src/Template/HSML/Internal/TH.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}++module Template.HSML.Internal.TH+( hsmlWith+, hsml+, m++, hsmlStringWith+, hsmlFileWith++, shsmlStringWith+, shsmlString+, shsmlFileWith+, shsmlFile+) where++--------------------------------------------------------------------------------+import qualified Language.Haskell.TH as TH+import qualified Language.Haskell.TH.Quote as TH+import qualified Language.Haskell.TH.Syntax as TH+-- import qualified Language.Haskell.Exts.Syntax as HE+import qualified Language.Haskell.Meta.Syntax.Translate as HE+--------------------------------------------------------------------------------+import qualified Text.Blaze as B+import qualified Text.Blaze.Internal as B+--------------------------------------------------------------------------------+-- import Control.Applicative+import Control.Monad+--------------------------------------------------------------------------------+-- import Data.Char+import Data.String+import Data.Monoid+-- import qualified Data.Generics as G+--------------------------------------------------------------------------------+import qualified Template.HSML.Internal.Types as I+import qualified Template.HSML.Internal.Parser as I+--------------------------------------------------------------------------------++hsmlWith :: I.Options -> TH.QuasiQuoter+hsmlWith opts = TH.QuasiQuoter+ { TH.quoteExp = shsmlStringWith opts + , TH.quoteDec = hsmlStringWith opts+ , TH.quotePat = const $ fail "You can not use the .HSML QuasiQuoter as a pattern."+ , TH.quoteType = const $ fail "You can not use the .HSML QuasiQuoter as a type."+ }+{-# INLINE hsmlWith #-}++hsml :: TH.QuasiQuoter+hsml = TH.QuasiQuoter + { TH.quoteExp = shsmlString + , TH.quoteDec = const $ fail "You can not use the .HSML QuasiQuoter as a declaration."+ , TH.quotePat = const $ fail "You can not use the .HSML QuasiQuoter as a pattern."+ , TH.quoteType = const $ fail "You can not use the .HSML QuasiQuoter as a type."+ }+{-# INLINE hsml #-}++m :: TH.QuasiQuoter+m = hsml+{-# INLINE m #-}++--------------------------------------------------------------------------------+-- | .HSML++hsmlFileWith :: I.Options -> FilePath -> TH.Q [TH.Dec]+hsmlFileWith opts path = TH.runIO (readFile path) >>= hsmlStringWith opts+{-# INLINE hsmlFileWith #-}++hsmlFile :: String -> FilePath -> TH.Q [TH.Dec]+hsmlFile = hsmlFileWith . I.defaultHSML+{-# INLINE hsmlFile #-}++hsmlStringWith :: I.Options -> String -> TH.Q [TH.Dec]+hsmlStringWith opts str = + case I.hsmlTemplate str of+ Right tpl -> makeDec opts tpl+ Left err -> fail err+{-# INLINE hsmlStringWith #-}++hsmlString :: String -> String -> TH.Q [TH.Dec]+hsmlString = hsmlStringWith . I.defaultHSML+{-# INLINE hsmlString #-}++--------------------------------------------------------------------------------+-- | Simple .HSML (without arguments)++shsmlFileWith :: I.Options -> FilePath -> TH.ExpQ+shsmlFileWith opts path = TH.runIO (readFile path) >>= shsmlStringWith opts+{-# INLINE shsmlFileWith #-}++shsmlFile :: FilePath -> TH.ExpQ+shsmlFile = shsmlFileWith I.defaultSHSML+{-# INLINE shsmlFile #-}++shsmlStringWith :: I.Options -> String -> TH.ExpQ+shsmlStringWith opts str = + case I.shsmlTemplate str of+ Right I.Template{..} -> makeExp opts templateDecs templateSections + Left err -> fail err+{-# INLINE shsmlStringWith #-}++shsmlString :: String -> TH.ExpQ+shsmlString = shsmlStringWith I.defaultSHSML+{-# INLINE shsmlString #-}++--------------------------------------------------------------------------------++-- | This function take options @ template and generates the record type and+-- instance of .HSMLTemplate for that record type.+makeDec :: I.Options -> I.Template -> TH.Q [TH.Dec]+makeDec opts@(I.Options _ tname fname) (I.Template args decs sections) = do+ (vars, fields) <- makeVarsAndFields+ tdata <- makeData vars fields+ tinst <- makeInstance vars+ return [tdata, tinst] + where+ dataName :: TH.Name+ dataName = HE.toName tname++ -- | This function generates the type variable names and fields.+ makeVarsAndFields :: TH.Q ([TH.Name], [TH.VarStrictType])+ makeVarsAndFields = foldM go ([], []) args+ where+ go (vs, fs) (I.Arg an (Just at)) =+ return (vs, (HE.toName $ fname an, TH.NotStrict, HE.toType at) : fs)+ go (vs, fs) (I.Arg an Nothing) = do+ v <- TH.newName "a"+ return (v : vs, (HE.toName $ fname an, TH.NotStrict, TH.VarT v) : fs)++ -- | This function generates the instance in .HSMLTemplate.+ makeInstance :: [TH.Name] -> TH.DecQ + makeInstance vars =+ -- instance .HSMLTemplate (<dataName> <vars>) where+ -- renderTemplate <tpl>@(<dataName>{ <binds> }) = + -- <expression generated by makeExp>+ TH.instanceD+ (return [])+ (TH.conT ''I.HSMLTemplate `TH.appT` contyp)+ [TH.funD 'I.renderTemplate [clause]]+ where+ -- This is the data type applied to all the type variables.+ contyp = foldl (\acc n -> acc `TH.appT` TH.varT n) (TH.conT dataName) vars+ + -- This is the clause for renderTemplate. + clause = do + arg <- TH.newName "tpl"+ TH.clause [TH.asP arg $ TH.recP dataName binds]+ (TH.normalB $ makeExp opts decs sections) []+ -- This is the { <fieldName1> = <argName1>, ... } pattern.+ binds = map (\(I.Arg n _) -> return (HE.toName $ fname n, TH.VarP $ HE.toName n)) args+ + -- | This function generates the record type.+ makeData :: [TH.Name] -> [TH.VarStrictType] -> TH.DecQ+ makeData vars fields = return $+ -- data <dataName> <vars> = <dataName> { <fields> }+ TH.DataD [] dataName (map TH.PlainTV vars) [TH.RecC dataName fields] []++makeExp :: I.Options -> [I.Dec] -> [I.Section] -> TH.ExpQ+makeExp opts decs sections =+ TH.letE (declarationsToDecs decs)+ (sectionsToExp opts sections)++--------------------------------------------------------------------------------++declarationsToDecs :: [I.Dec] -> [TH.DecQ]+declarationsToDecs = map declarationToDec+ where declarationToDec (I.Dec dec) = return $ HE.toDec dec+++sectionsToExp :: I.Options -> [I.Section] -> TH.ExpQ+sectionsToExp opts sections = + [e| mconcat $(TH.listE $ map (sectionToExp opts) sections) :: B.Markup |]++sectionToExp :: I.Options -> I.Section -> TH.ExpQ+sectionToExp opts@I.Options{..} section =+ case section of+ (I.ElementNode name atts sections) ->+ [e| applyAttributes $(TH.listE $ map attributeToExp atts) $+ B.Parent (fromString name)+ (fromString $ "<" <> name)+ (fromString $ "</" <> name <> ">")+ $(sectionsToExp opts sections) |]+ (I.ElementLeaf name atts) -> + [e| applyAttributes $(TH.listE $ map attributeToExp atts) $+ B.Leaf (fromString name)+ (fromString $ "<" <> name)+ (fromString ">") |]+ (I.Text str) -> [e| B.string str |]+ (I.TextRaw str) -> [e| B.preEscapedString str |]+ (I.Expression (I.Exp e)) ->+ if optSectionsToMarkup+ then [e| B.toMarkup $(return $ HE.toExp e) |]+ else return $ HE.toExp e++applyAttributes :: [B.Attribute] -> B.MarkupM a -> B.MarkupM a+applyAttributes attributes markup = foldl (B.!) markup attributes++attributeToExp :: I.Attribute -> TH.ExpQ+attributeToExp (I.Attribute aname avalue) =+ [e| B.attribute (fromString $(attributeNameToExp aname))+ (fromString (" " <> $(attributeNameToExp aname) <> "=\""))+ (fromString $(attributeValueToExp avalue)) |]+ where+ attributeNameToExp (I.AttributeNameExp (I.Exp e)) = return $ HE.toExp e+ attributeNameToExp (I.AttributeNameText str) = [e| str |]++ attributeValueToExp (I.AttributeValueExp (I.Exp e)) = return $ HE.toExp e+ attributeValueToExp (I.AttributeValueText str) = [e| str |] +
+ src/Template/HSML/Internal/Types.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Template.HSML.Internal.Types+( HSMLTemplate(..)+, Options(..)+, defaultHSML+, defaultSHSML++, PTemplate(..)+, PSection(..)+, PAttribute(..)+, PAttributeName(..)+, PAttributeValue(..)++, Template+, Section+, Attribute+, AttributeName+, AttributeValue++, RTemplate+, RSection+, RAttribute+, RAttributeName+, RAttributeValue++, Arg(..)+, Dec(..)+, Exp(..)++, RArg(..)+, RDec(..)+, RExp(..)+) where++--------------------------------------------------------------------------------+import qualified Language.Haskell.Exts.Syntax as HE+--------------------------------------------------------------------------------+import Data.Char (toUpper, toLower)+import Data.Monoid ((<>))+--------------------------------------------------------------------------------+import qualified Text.Blaze as B (Markup)+--------------------------------------------------------------------------------++class HSMLTemplate a where+ renderTemplate :: a -> B.Markup++defaultHSML :: String -> Options+defaultHSML name = Options+ { optSectionsToMarkup = True+ , optTemplateName = firstUpper name+ , optTemplateFieldName = \a -> firstLower name <> firstUpper a+ }+ where+ firstUpper "" = ""+ firstUpper (c:cs) = toUpper c : cs++ firstLower "" = ""+ firstLower (c:cs) = toLower c : cs++defaultSHSML :: Options+defaultSHSML = Options+ { optSectionsToMarkup = True + , optTemplateName = undefined+ , optTemplateFieldName = undefined + }++-- | This type let's you customize some behaviour of the templating system.+data Options = Options+ {+ -- ^ If (and only if) set to True, applies `Blaze.Text.toMarkup` to+ -- section expression+ optSectionsToMarkup :: Bool++ -- ^ The name of the generated record.+ -- NOTE: Has no effect on s.HSML templates.+ , optTemplateName :: String++ -- ^ The name of the fields of the genrated record.+ -- NOTE: Has no effect on sHTML templates.+ , optTemplateFieldName :: String -> String+ }++--------------------------------------------------------------------------------+-- | Handy synonyms++type Template = PTemplate Arg Dec Exp+type Section = PSection Exp+type Attribute = PAttribute Exp+type AttributeName = PAttributeName Exp+type AttributeValue = PAttributeValue Exp++type RTemplate = PTemplate RArg RDec RExp+type RSection = PSection RExp+type RAttribute = PAttribute RExp+type RAttributeName = PAttributeName RExp+type RAttributeValue = PAttributeValue RExp++--------------------------------------------------------------------------------+-- | The Template. This includes arguments, declarations and sections++data PTemplate arg dec exp = Template+ { templateArgs :: [arg]+ , templateDecs :: [dec]+ , templateSections :: [PSection exp]+ }++instance Show e => Show (PTemplate a d e) where+ show tpl = unlines . map show $ templateSections tpl++data PSection exp = ElementNode String [PAttribute exp] [PSection exp]+ | ElementLeaf String [PAttribute exp]+ | Text String+ | TextRaw String+ | Expression exp++instance Show e => Show (PSection e) where+ show (ElementNode name _ sections) = concat [ "<" <> name <> ">\n"+ , unlines (map show sections)+ , "</" <> name <> ">\n"+ ]+ show (ElementLeaf name _) = "<" <> name <> "/>"+ show (Text str) = hsmlEscape str+ show (TextRaw str) = str+ show (Expression e) = show e++hsmlEscape :: String -> String+hsmlEscape "" = ""+hsmlEscape (c:rest) =+ if shouldEscape c+ then '\\' : c : hsmlEscape rest+ else c : hsmlEscape rest+ where+ shouldEscape = (`elem` "<{") ++data PAttribute exp = Attribute (PAttributeName exp) (PAttributeValue exp)++data PAttributeName exp = AttributeNameText String + | AttributeNameExp exp++data PAttributeValue exp = AttributeValueText String + | AttributeValueExp exp++data Arg = Arg String (Maybe HE.Type)+newtype Dec = Dec HE.Decl+newtype Exp = Exp HE.Exp++data RArg = RArg String (Maybe String) deriving Show+newtype RDec = RDec String deriving Show+newtype RExp = RExp String deriving Show+
+ template-hsml.cabal view
@@ -0,0 +1,42 @@+name: template-hsml+version: 0.1.0.0+synopsis: Haskell's Simple Markup Language+description: HSML syntax is very similar to that of XML, but there are less rules.+ The main advantage over plain HTML is that it allows you to embed Haskell declarations+ and expression directly into your template.++ The main dvantage over something like Blaze is thatit saves+ you the overhead of using Blaze's combinators. It's also relatively easy to port your existing+ plain HTML templates into HSML (most of the times, cut & paste will suffice).++ For examples, see the examples directory.+license: BSD3+license-file: LICENSE+author: Petr Pilař+maintainer: maintainer+the.palmik@gmail.com+copyright: Petr Pilař 2012 +category: Web, Template, Templating+build-type: Simple+cabal-version: >=1.8+stability: Experimental++library+ hs-source-dirs: src+ + exposed-modules:+ Template.HSML + + other-modules: + Template.HSML.Internal.TH+ , Template.HSML.Internal.Types+ , Template.HSML.Internal.Parser+ , Template.HSML.Internal.Parser.Raw++ build-depends:+ base == 4.5.*++ , blaze-markup == 0.5.*+ , haskell-src-exts == 1.13.*+ , haskell-src-meta == 0.5.*+ , parsec == 3.1.*+ , template-haskell == 2.7.*