{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RecordWildCards #-} module Template.HSML.Internal.TH #ifdef TESTING where #else ( -- * Quasi Quoters for Simplified HSML hsml , m , hsmlStringWith , hsmlString , hsmlFileWith , hsmlFile , shsmlStringWith , shsmlString , shsmlFileWith , shsmlFile ) where #endif -------------------------------------------------------------------------------- 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.Meta.Syntax.Translate as HE -------------------------------------------------------------------------------- import qualified Text.Blaze as B import qualified Text.Blaze.Internal as B -------------------------------------------------------------------------------- import Control.Applicative import Control.Arrow import Control.Monad -------------------------------------------------------------------------------- import Data.String import Data.Monoid -------------------------------------------------------------------------------- import qualified Template.HSML.Internal.Types as I import qualified Template.HSML.Internal.Parser as I -------------------------------------------------------------------------------- -- | QuasiQuoter for Simplified HSML expressions with default options. See -- `Template.HSML.Internal.Types.defaulOptionsS` for details. -- -- Example: -- -- > example :: Blaze.Text.Markup -- > example = [hsml| -- >
-- > Some interesting paragraph. -- >
-- > |] 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 #-} -- | The same as `Templahe.HSML.Internal.TH.hsml`. -- -- Example: -- -- > example :: Blaze.Text.Markup -- > example = [m| -- >-- > Some interesting paragraph. -- >
-- > |] m :: TH.QuasiQuoter m = hsml {-# INLINE m #-} -------------------------------------------------------------------------------- -- HSML -- These functions parse the given file or string as a HSML document. -- If possible, splicing these generates a record field type and its instance of -- `Template.HSML.Internal.Types.IsTemplate`. -- | Parses HSML document from file with the given options. Results in -- record type and its `Template.HSML.Internal.Types.IsTemplate` instance. -- -- Example: -- -- > $(hsmlFileWith (defaultOptions "MyTemplate") "my_template.hsml") hsmlFileWith :: I.Options -- ^ HSML options. -> FilePath -- ^ Name of input file. -> TH.Q [TH.Dec] -- ^ Resulting type declaration and type-class instance. hsmlFileWith opts path = TH.runIO (readFile path) >>= hsmlStringWith opts {-# INLINE hsmlFileWith #-} -- | Parses HSML document from file with default options. Results in -- record type and its `Template.HSML.Internal.Types.IsTemplate` instance. -- -- Example: -- -- > $(hsmlFile "MyTemplate" "my_template.hsml") hsmlFile :: String -- ^ Name of the record type (passed to `Template.HSML.Internal.Types.defaultOptions`). -> FilePath -- ^ Name of input file. -> TH.Q [TH.Dec] -- ^ Resulting type declaration and type-class instance. hsmlFile = hsmlFileWith . I.defaultOptions {-# INLINE hsmlFile #-} -- | Parses HSML document string with the given options. Results in -- record type and its `Template.HSML.Internal.Types.IsTemplate` instance. -- -- Example: -- -- > $(hsmlStringWith (defaultOptions "MyTemplate") "Paragraph
") hsmlStringWith :: I.Options -- ^ HSML options. -> String -- ^ Input string. -> TH.Q [TH.Dec] -- ^ Resulting type declaration and type-class instance. hsmlStringWith opts str = case I.hsmlTemplate str of Right tpl -> makeDec opts tpl Left err -> fail err {-# INLINE hsmlStringWith #-} -- | Parses HSML document from string with default options. Results in -- record type and its `Template.HSML.Internal.Types.IsTemplate` instance. -- -- Example: -- -- > $(hsmlString "MyTemplate" "Paragraph
") hsmlString :: String -- ^ Name of the record type (passed to `Template.HSML.Internal.Types.defaultOptions`). -> String -- ^ Input string. -> TH.Q [TH.Dec] -- ^ Resulting type declaration and type-class instance. hsmlString = hsmlStringWith . I.defaultOptions {-# INLINE hsmlString #-} -------------------------------------------------------------------------------- -- Simplified HSML (without arguments) -- These functions parse the given file or string as a Simplified HSML document. -- If possible, splicing these results in an expression of the type -- `Text.Blaze.Markup`. -- | Parses Simplified HSML document from file with the given options. Results in -- expression of type `Text.Blaze.Markup`. -- -- Example: -- -- > example :: Text.Blaze.Markup -- > example = $(shsmlFileWith defaultOptionsS "my_template.hsml") shsmlFileWith :: I.Options -- ^ HSML Options. -> FilePath -- ^ Name of input file. -> TH.ExpQ -- ^ Resulting expression. shsmlFileWith opts path = TH.runIO (readFile path) >>= shsmlStringWith opts {-# INLINE shsmlFileWith #-} -- | Parses Simplified HSML document from file with default options. Results in -- expression of type `Text.Blaze.Markup`. -- -- Example: -- -- > example :: Text.Blaze.Markup -- > example = $(shsmlFile "my_template.hsml") shsmlFile :: FilePath -- ^ Name of input file. -> TH.ExpQ -- ^ Resulting expression. shsmlFile = shsmlFileWith I.defaultOptionsS {-# INLINE shsmlFile #-} -- | Parses Simplified HSML document from string with the given options. Results in -- expression of type `Text.Blaze.Markup`. -- -- Example: -- -- > example :: Text.Blaze.Markup -- > example = $(shsmlStringWith defaultOptionsS "Paragraph
") shsmlStringWith :: I.Options -- ^ HSML options -> String -- ^ Input string. -> TH.ExpQ -- ^ Resulting expression. shsmlStringWith opts str = case I.shsmlTemplate str of Right I.Template{..} -> makeExp opts templateDecs templateSections Left err -> fail err {-# INLINE shsmlStringWith #-} -- | Parses Simplified HSML document from string with default options. Results in -- expression of type `Text.Blaze.Markup`. -- -- Example: -- -- > example :: Text.Blaze.Markup -- > example = $(shsmlString "Paragraph
") shsmlString :: String -- ^ Input string. -> TH.ExpQ -- ^ Resulting expression. shsmlString = shsmlStringWith I.defaultOptionsS {-# INLINE shsmlString #-} -------------------------------------------------------------------------------- -- | Generates a record type and its instance of `IsTemplate`. 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 = (reverse *** reverse) <$> 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 of IsTemplate. makeInstance :: [TH.Name] -> TH.DecQ makeInstance vars = -- instance .IsTemplate (