    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE CPP #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}

    {- |
    Module      :  Text.Heterocephalus

    Copyright   :  Kadzuya Okamoto 2016
    License     :  MIT

    Stability   :  experimental
    Portability :  unknown

    This module exports functions for working with frontend templates from Haskell.
    -}

    module Text.Heterocephalus
      (
      -- * Core functions
        compileTextFile
      , compileTextFileWith
      , compileTextFileWithDefault
      , compileHtmlFile
      , compileHtmlFileWith
      , compileHtmlFileWithDefault

      -- * QuasiQuoters
      , compileText
      , compileHtml

      -- * ScopeM
      , ScopeM
      , setDefault
      , overwrite

      -- * low-level
      , HeterocephalusSetting(..)
      , textSetting
      , htmlSetting
      , ParseOptions(..)
      , defaultParseOptions
      , createParseOptions
      , DefaultScope
      , compile
      , compileWith
      , compileWithDefault
      , compileFile
      , compileFileWith
      , compileFileWithDefault
      , compileFromString
      , compileFromStringWithDefault
      ) where

    #if MIN_VERSION_base(4,9,0)
    #else
    import Control.Applicative ((<$>), (<*>), Applicative(..))
    import Data.Monoid (Monoid, mempty, mappend)
    #endif
    import Control.Monad (forM)
    import Data.Char (isDigit)
    import Data.DList (DList)
    import qualified Data.DList as DList
    import qualified Data.Foldable as F
    import Data.List (intercalate)
    import qualified Data.Semigroup as Sem
    import Data.String (IsString(..))
    import Data.Text (Text, pack)
    import qualified Data.Text.Lazy as TL
    import Language.Haskell.TH.Lib (ExpQ, varE)
    import Language.Haskell.TH.Quote
           (QuasiQuoter(QuasiQuoter), quoteExp, quoteDec, quotePat, quoteType)
    #if MIN_VERSION_template_haskell(2,9,0)
    import Language.Haskell.TH.Syntax
           (Body(..), Con(..), Dec(..), Exp(..), Info(..), Lit(..), Match(..),
            Name(..), Pat(..), Q, Stmt(..), lookupValueName, mkName, nameBase,
            newName, qAddDependentFile, qRunIO, reify)
    #else
    import Language.Haskell.TH.Syntax
    #endif
    import TemplateHaskell.Compat.V0208
    import Text.Blaze (preEscapedToMarkup)
    import Text.Blaze.Html (toHtml)
    import Text.Blaze.Internal (preEscapedText)
    import Text.Hamlet (Html, HtmlUrl, HtmlUrlI18n, condH)
    import Text.Hamlet.Parse
           (Binding(..), DataConstr(..), Module(Module), specialOrIdent)
    import Text.Shakespeare.Base
           (Deref, Ident(..), Scope, derefToExp, readUtf8File)

    import Text.Heterocephalus.Parse
           (Doc(..), Content(..), ParseOptions(..), createParseOptions,
            defaultParseOptions, docFromString)

    {- $setup
      >>> :set -XTemplateHaskell -XQuasiQuotes
      >>> import Text.Blaze.Renderer.String
    -}

    {-| A function to compile template file.
      This function __DOES NOT__ escape template variables.
      To render the compiled file, use @'Text.Blaze.Renderer'.*.renderMarkup@.

      >>> putStr $ renderMarkup (let as = ["<a>", "b"] in $(compileTextFile "templates/sample.txt"))
      sample
      key: <a>,
      key: b,
     -}
    compileTextFile :: FilePath -> Q Exp
    compileTextFile :: String -> Q Exp
    compileTextFile = HeterocephalusSetting -> String -> Q Exp
    compileFile HeterocephalusSetting
    textSetting

    {-| Same as 'compileText' but allows the user to specify extra values for template parameters.
      Values declared by 'overwrite' overwrites same name variables.
      Values declared by 'setDefault' are overwritten by same name variables.

    >>> :set -XOverloadedStrings
    >>> :{
    putStr $ renderMarkup (
      let as = ["<a>", "b"]
      in $(compileTextFileWith "templates/sample.txt" $ do
        setDefault "as" [| ["foo", "bar"] |]
      )
    )
    :}
    sample
    key: <a>,
    key: b,

    >>> :{
    putStr $ renderMarkup (
      let as = ["<a>", "b"]
      in $(compileTextFileWith "templates/sample.txt" $ do
        overwrite "as" [| ["foo", "bar"] |]
      )
    )
    :}
    sample
    key: foo,
    key: bar,

    >>> :{
    putStr $ renderMarkup (
      let as = ["<a>", "b"]
      in $(compileTextFileWith "templates/sample.txt" $ do
        overwrite "as" [| ["bazbaz", "barbar"] |]
        setDefault "as" [| ["foo", "bar"] |]
        overwrite "as" [| ["baz", "foobar"] |]
      )
    )
    :}
    sample
    key: baz,
    key: foobar,
     -}
    compileTextFileWith :: FilePath -> ScopeM () -> Q Exp
    compileTextFileWith :: String -> ScopeM () -> Q Exp
    compileTextFileWith String
    fp ScopeM ()
    scopeM = ScopeM () -> HeterocephalusSetting -> String -> Q Exp
    compileFileWith ScopeM ()
    scopeM HeterocephalusSetting
    textSetting String
    fp

    {-| Same as 'compileText' but allows the user to specify default values for template parameters.

    >>> :set -XOverloadedStrings
    >>> :{
    putStr $ renderMarkup (
      let as = ["<a>", "b"]
      in $(compileTextFileWithDefault "templates/sample.txt"
        [("as", [| ["foo", "bar"] |])]
      )
    )
    :}
    sample
    key: <a>,
    key: b,

    >>> :{
    putStr $ renderMarkup (
      $(compileTextFileWithDefault "templates/sample.txt"
        [("as", [| ["foo", "bar"] |])]
      )
    )
    :}
    sample
    key: foo,
    key: bar,
     -}
    compileTextFileWithDefault :: FilePath -> DefaultScope -> Q Exp
    compileTextFileWithDefault :: String -> DefaultScope -> Q Exp
    compileTextFileWithDefault String
    fp DefaultScope
    scope = DefaultScope -> HeterocephalusSetting -> String -> Q Exp
    compileFileWithDefault DefaultScope
    scope HeterocephalusSetting
    textSetting String
    fp

    {-| Same as 'compileTextFile' but escapes template variables in HTML.

      >>> putStr $ renderMarkup (let as = ["<a>", "b"] in $(compileHtmlFile "templates/sample.txt"))
      sample
      key: &lt;a&gt;,
      key: b,
     -}
    compileHtmlFile :: FilePath -> Q Exp
    compileHtmlFile :: String -> Q Exp
    compileHtmlFile String
    fp = String -> DefaultScope -> Q Exp
    compileHtmlFileWithDefault String
    fp []

    {-| Same as 'compileHtmlFile' but allows the user to specify extra values for template parameters.
      Values declared by 'overwrite' overwrites same name variables.
      Values declared by 'setDefault' are overwritten by same name variables.

    >>> :set -XOverloadedStrings
    >>> :{
    putStr $ renderMarkup (
      let as = ["<a>", "b"]
      in $(compileHtmlFileWith "templates/sample.txt" $ do
        setDefault "as" [| ["foo", "bar"] |]
      )
    )
    :}
    sample
    key: &lt;a&gt;,
    key: b,

    >>> :{
    putStr $ renderMarkup (
      let as = ["<a>", "b"]
      in $(compileHtmlFileWith "templates/sample.txt" $ do
        overwrite "as" [| ["foo", "bar"] |]
      )
    )
    :}
    sample
    key: foo,
    key: bar,

    >>> :{
    putStr $ renderMarkup (
      let as = ["<a>", "b"]
      in $(compileHtmlFileWith "templates/sample.txt" $ do
        overwrite "as" [| ["bazbaz", "barbar"] |]
        setDefault "as" [| ["foo", "bar"] |]
        overwrite "as" [| ["baz", "foobar"] |]
      )
    )
    :}
    sample
    key: baz,
    key: foobar,
     -}
    compileHtmlFileWith :: FilePath -> ScopeM () -> Q Exp
    compileHtmlFileWith :: String -> ScopeM () -> Q Exp
    compileHtmlFileWith String
    fp ScopeM ()
    scopeM = ScopeM () -> HeterocephalusSetting -> String -> Q Exp
    compileFileWith ScopeM ()
    scopeM HeterocephalusSetting
    htmlSetting String
    fp

    {-| Same as 'compileHtmlFile' but allows the user to specify default values for template parameters.

    >>> :set -XOverloadedStrings
    :{
    putStr $ renderMarkup (
      let as = ["<a>", "b"]
      in $(compileHtmlFileWithDefault "templates/sample.txt"
        [("as", [| ["foo", "bar"] |])]
      )
    )
    :}
    sample
    key: &lt;a&gt;,
    key: b,

    >>> :{
    putStr $ renderMarkup (
      $(compileHtmlFileWithDefault "templates/sample.txt"
        [("as", [| ["foo", "bar"] |])]
      )
    )
    :}
    sample
    key: foo,
    key: bar,
     -}
    compileHtmlFileWithDefault :: FilePath -> DefaultScope -> Q Exp
    compileHtmlFileWithDefault :: String -> DefaultScope -> Q Exp
    compileHtmlFileWithDefault String
    fp DefaultScope
    scope = DefaultScope -> HeterocephalusSetting -> String -> Q Exp
    compileFileWithDefault DefaultScope
    scope HeterocephalusSetting
    htmlSetting String
    fp

    {-| Heterocephalus quasi-quoter.
      This function __DOES NOT__ escape template variables.
      To render the compiled file, use @'Text.Blaze.Renderer'.*.renderMarkup@.

      >>> renderMarkup (let as = ["<a>", "b"] in [compileText|sample %{ forall a <- as }key: #{a}, %{ endforall }|])
      "sample key: <a>, key: b, "

      >>> renderMarkup (let num=2 in [compileText|#{num} is %{ if even num }an even number.%{ elseif (num > 100) }big.%{ else }an odd number.%{ endif }|])
      "2 is an even number."
     -}
    compileText :: QuasiQuoter
    compileText :: QuasiQuoter
    compileText = HeterocephalusSetting -> QuasiQuoter
    compile HeterocephalusSetting
    textSetting

    {-| Heterocephalus quasi-quoter for HTML.
      Same as 'compileText' but this function does escape template variables in HTML.

      >>> renderMarkup (let as = ["<a>", "b"] in [compileHtml|sample %{ forall a <- as }key: #{a}, %{ endforall }|])
      "sample key: &lt;a&gt;, key: b, "
     -}
    compileHtml :: QuasiQuoter
    compileHtml :: QuasiQuoter
    compileHtml = HeterocephalusSetting -> QuasiQuoter
    compile HeterocephalusSetting
    htmlSetting

    compile :: HeterocephalusSetting -> QuasiQuoter
    compile :: HeterocephalusSetting -> QuasiQuoter
    compile = DefaultScope -> HeterocephalusSetting -> QuasiQuoter
    compileWithDefault []

    {-| QuasiQuoter.
     -}
    compileWith :: ScopeM () -> HeterocephalusSetting -> QuasiQuoter
    compileWith :: ScopeM () -> HeterocephalusSetting -> QuasiQuoter
    compileWith ScopeM ()
    scopeM HeterocephalusSetting
    set =
      QuasiQuoter
      { quoteExp :: String -> Q Exp
    quoteExp = ScopeM () -> HeterocephalusSetting -> String -> Q Exp
    compileFromStringWith ScopeM ()
    scopeM HeterocephalusSetting
    set
      , quotePat :: String -> Q Pat
    quotePat = String -> String -> Q Pat
    forall a. HasCallStack => String -> a
    error String
    "not used"
      , quoteType :: String -> Q Type
    quoteType = String -> String -> Q Type
    forall a. HasCallStack => String -> a
    error String
    "not used"
      , quoteDec :: String -> Q [Dec]
    quoteDec = String -> String -> Q [Dec]
    forall a. HasCallStack => String -> a
    error String
    "not used"
      }

    {-| QuasiQuoter.
     -}
    compileWithDefault :: DefaultScope -> HeterocephalusSetting -> QuasiQuoter
    compileWithDefault :: DefaultScope -> HeterocephalusSetting -> QuasiQuoter
    compileWithDefault DefaultScope
    scope HeterocephalusSetting
    set =
      QuasiQuoter
      { quoteExp :: String -> Q Exp
    quoteExp = DefaultScope -> HeterocephalusSetting -> String -> Q Exp
    compileFromStringWithDefault DefaultScope
    scope HeterocephalusSetting
    set
      , quotePat :: String -> Q Pat
    quotePat = String -> String -> Q Pat
    forall a. HasCallStack => String -> a
    error String
    "not used"
      , quoteType :: String -> Q Type
    quoteType = String -> String -> Q Type
    forall a. HasCallStack => String -> a
    error String
    "not used"
      , quoteDec :: String -> Q [Dec]
    quoteDec = String -> String -> Q [Dec]
    forall a. HasCallStack => String -> a
    error String
    "not used"
      }

    {-| Compile a template file.
    -}
    compileFile :: HeterocephalusSetting -> FilePath -> Q Exp
    compileFile :: HeterocephalusSetting -> String -> Q Exp
    compileFile = DefaultScope -> HeterocephalusSetting -> String -> Q Exp
    compileFileWithDefault []

    {-| Same as 'compileFile' but we can specify default scope.
    -}
    compileFileWith :: ScopeM () -> HeterocephalusSetting -> FilePath -> Q Exp
    compileFileWith :: ScopeM () -> HeterocephalusSetting -> String -> Q Exp
    compileFileWith ScopeM ()
    scopeM HeterocephalusSetting
    set String
    fp = do
      String -> Q ()
    forall (m :: * -> *). Quasi m => String -> m ()
    qAddDependentFile String
    fp
      String
    contents <- (Text -> String) -> Q Text -> Q String
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> String
    TL.unpack (Q Text -> Q String) -> Q Text -> Q String
    forall a b. (a -> b) -> a -> b
    $ IO Text -> Q Text
    forall a. IO a -> Q a
    forall (m :: * -> *) a. Quasi m => IO a -> m a
    qRunIO (IO Text -> Q Text) -> IO Text -> Q Text
    forall a b. (a -> b) -> a -> b
    $ String -> IO Text
    readUtf8File String
    fp
      ScopeM () -> HeterocephalusSetting -> String -> Q Exp
    compileFromStringWith ScopeM ()
    scopeM HeterocephalusSetting
    set String
    contents

    {-| Same as 'compileFile' but we can specify default scope.
    -}
    compileFileWithDefault :: DefaultScope -> HeterocephalusSetting -> FilePath -> Q Exp
    compileFileWithDefault :: DefaultScope -> HeterocephalusSetting -> String -> Q Exp
    compileFileWithDefault DefaultScope
    scope' HeterocephalusSetting
    set String
    fp = do
      String -> Q ()
    forall (m :: * -> *). Quasi m => String -> m ()
    qAddDependentFile String
    fp
      String
    contents <- (Text -> String) -> Q Text -> Q String
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> String
    TL.unpack (Q Text -> Q String) -> Q Text -> Q String
    forall a b. (a -> b) -> a -> b
    $ IO Text -> Q Text
    forall a. IO a -> Q a
    forall (m :: * -> *) a. Quasi m => IO a -> m a
    qRunIO (IO Text -> Q Text) -> IO Text -> Q Text
    forall a b. (a -> b) -> a -> b
    $ String -> IO Text
    readUtf8File String
    fp
      DefaultScope -> HeterocephalusSetting -> String -> Q Exp
    compileFromStringWithDefault DefaultScope
    scope' HeterocephalusSetting
    set String
    contents

    {-| Same as 'compileFile', but just compile the 'String' given.

      >>> let as = ["<a>", "b"]
      >>> let template = "sample %{ forall a <- as }key: #{a}, %{ endforall }"
      >>> renderMarkup $(compileFromString textSetting template)
      "sample key: <a>, key: b, "

      >>> let as = ["<a>", "b"]
      >>> let options = createParseOptions '|' '?'
      >>> let setting = textSetting { parseOptions = options }
      >>> let template = "sample |{ forall a <- as }key: ?{a}, |{ endforall }"
      >>> renderMarkup $(compileFromString setting template)
      "sample key: <a>, key: b, "
    -}
    compileFromString :: HeterocephalusSetting -> String -> Q Exp
    compileFromString :: HeterocephalusSetting -> String -> Q Exp
    compileFromString = DefaultScope -> HeterocephalusSetting -> String -> Q Exp
    compileFromStringWithDefault []

    compileFromStringWith :: ScopeM () -> HeterocephalusSetting -> String -> Q Exp
    compileFromStringWith :: ScopeM () -> HeterocephalusSetting -> String -> Q Exp
    compileFromStringWith ScopeM ()
    scopeM HeterocephalusSetting
    set String
    s = do
      [(Ident, Exp)]
    defScope' <-
        DefaultScope
    -> ((Ident, Q Exp) -> Q (Ident, Exp)) -> Q [(Ident, Exp)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM DefaultScope
    defScope (((Ident, Q Exp) -> Q (Ident, Exp)) -> Q [(Ident, Exp)])
    -> ((Ident, Q Exp) -> Q (Ident, Exp)) -> Q [(Ident, Exp)]
    forall a b. (a -> b) -> a -> b
    $ \(Ident
    ident, Q Exp
    qexp) -> (Ident
    ident, ) (Exp -> (Ident, Exp)) -> Q Exp -> Q (Ident, Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ident -> Q Exp -> Q Exp
    overwriteScope Ident
    ident Q Exp
    qexp
      [(Ident, Exp)]
    owScope' <-
        DefaultScope
    -> ((Ident, Q Exp) -> Q (Ident, Exp)) -> Q [(Ident, Exp)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM DefaultScope
    owScope (((Ident, Q Exp) -> Q (Ident, Exp)) -> Q [(Ident, Exp)])
    -> ((Ident, Q Exp) -> Q (Ident, Exp)) -> Q [(Ident, Exp)]
    forall a b. (a -> b) -> a -> b
    $ \(Ident
    ident, Q Exp
    qexp) -> (Ident
    ident, ) (Exp -> (Ident, Exp)) -> Q Exp -> Q (Ident, Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp
    qexp
      HeterocephalusSetting -> [(Ident, Exp)] -> [Doc] -> Q Exp
    docsToExp HeterocephalusSetting
    set ([(Ident, Exp)]
    owScope' [(Ident, Exp)] -> [(Ident, Exp)] -> [(Ident, Exp)]
    forall a. [a] -> [a] -> [a]
    ++ [(Ident, Exp)]
    defScope') ([Doc] -> Q Exp) -> [Doc] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ ParseOptions -> String -> [Doc]
    docFromString (HeterocephalusSetting -> ParseOptions
    parseOptions HeterocephalusSetting
    set) String
    s
     where
      (DefaultDList
    defDList, DefaultDList
    owDList) = ScopeM () -> (DefaultDList, DefaultDList)
    forall a. ScopeM a -> (DefaultDList, DefaultDList)
    runScopeM ScopeM ()
    scopeM
      defScope :: DefaultScope
    defScope = DefaultDList -> DefaultScope
    forall a. DList a -> [a]
    DList.toList DefaultDList
    defDList
      owScope :: DefaultScope
    owScope = DefaultDList -> DefaultScope
    forall a. DList a -> [a]
    DList.toList DefaultDList
    owDList

    compileFromStringWithDefault :: DefaultScope -> HeterocephalusSetting -> String -> Q Exp
    compileFromStringWithDefault :: DefaultScope -> HeterocephalusSetting -> String -> Q Exp
    compileFromStringWithDefault DefaultScope
    scope' HeterocephalusSetting
    set String
    s = do
      [(Ident, Exp)]
    scope <-
        DefaultScope
    -> ((Ident, Q Exp) -> Q (Ident, Exp)) -> Q [(Ident, Exp)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM DefaultScope
    scope' (((Ident, Q Exp) -> Q (Ident, Exp)) -> Q [(Ident, Exp)])
    -> ((Ident, Q Exp) -> Q (Ident, Exp)) -> Q [(Ident, Exp)]
    forall a b. (a -> b) -> a -> b
    $ \(Ident
    ident, Q Exp
    qexp) -> (Ident
    ident, ) (Exp -> (Ident, Exp)) -> Q Exp -> Q (Ident, Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ident -> Q Exp -> Q Exp
    overwriteScope Ident
    ident Q Exp
    qexp
      HeterocephalusSetting -> [(Ident, Exp)] -> [Doc] -> Q Exp
    docsToExp HeterocephalusSetting
    set [(Ident, Exp)]
    scope ([Doc] -> Q Exp) -> [Doc] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ ParseOptions -> String -> [Doc]
    docFromString (HeterocephalusSetting -> ParseOptions
    parseOptions HeterocephalusSetting
    set) String
    s

    overwriteScope :: Ident -> Q Exp -> Q Exp
    overwriteScope :: Ident -> Q Exp -> Q Exp
    overwriteScope (Ident String
    str) Q Exp
    qexp = do
      Maybe Name
    mName <- String -> Q (Maybe Name)
    lookupValueName String
    str
      case Maybe Name
    mName of
        Just Name
    x -> Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    x
        Maybe Name
    Nothing -> Q Exp
    qexp

    {-| Settings that are used when processing heterocephalus templates.
     -}
    data HeterocephalusSetting = HeterocephalusSetting
      { HeterocephalusSetting -> Q Exp
    escapeExp :: Q Exp
      -- ^ Template variables are passed to 'escapeExp' in the output.  This allows
      -- things like escaping HTML entities.  (See 'htmlSetting'.)
      , HeterocephalusSetting -> ParseOptions
    parseOptions :: ParseOptions
      }

    {-| A setting that escapes template variables for Html

    This sets 'escapeExp' to 'toHtml'.
     -}
    htmlSetting :: HeterocephalusSetting
    htmlSetting :: HeterocephalusSetting
    htmlSetting = HeterocephalusSetting
      { escapeExp :: Q Exp
    escapeExp = [|toHtml|]
      , parseOptions :: ParseOptions
    parseOptions = ParseOptions
    defaultParseOptions
      }

    {-| A setting that DOES NOT escape template variables.

    This sets 'escapeExp' to 'preEscapedToMarkup'.
     -}
    textSetting :: HeterocephalusSetting
    textSetting :: HeterocephalusSetting
    textSetting = HeterocephalusSetting
      { escapeExp :: Q Exp
    escapeExp = [|preEscapedToMarkup|]
      , parseOptions :: ParseOptions
    parseOptions = ParseOptions
    defaultParseOptions
      }

    type DefaultScope = [(Ident, Q Exp)]

    type DefaultDList = DList (Ident, Q Exp)
    type OverwriteDList = DList (Ident, Q Exp)

    {- | A type to handle extra scopes.
       This is opaque type, so use 'setDefault' and 'overwrite'
       to construct new 'ScopeM'.
     -}
    data ScopeM a
      = SetDefault Ident ExpQ (ScopeM a)
      | Overwrite Ident ExpQ (ScopeM a)
      | PureScopeM a

    {- | Get default values and values to overwrite from 'ScopeM'.
     -}
    runScopeM :: ScopeM a -> (DefaultDList, OverwriteDList)
    runScopeM :: forall a. ScopeM a -> (DefaultDList, DefaultDList)
    runScopeM (SetDefault Ident
    ident Q Exp
    qexp ScopeM a
    next) =
      let (DefaultDList
    defaults, DefaultDList
    overwrites) = ScopeM a -> (DefaultDList, DefaultDList)
    forall a. ScopeM a -> (DefaultDList, DefaultDList)
    runScopeM ScopeM a
    next
      in (DefaultDList -> (Ident, Q Exp) -> DefaultDList
    forall a. DList a -> a -> DList a
    DList.snoc DefaultDList
    defaults (Ident
    ident, Q Exp
    qexp), DefaultDList
    overwrites)
    runScopeM (Overwrite Ident
    ident Q Exp
    qexp ScopeM a
    next) =
      let (DefaultDList
    defaults, DefaultDList
    overwrites) = ScopeM a -> (DefaultDList, DefaultDList)
    forall a. ScopeM a -> (DefaultDList, DefaultDList)
    runScopeM ScopeM a
    next
      in (DefaultDList
    defaults, DefaultDList -> (Ident, Q Exp) -> DefaultDList
    forall a. DList a -> a -> DList a
    DList.snoc DefaultDList
    overwrites (Ident
    ident, Q Exp
    qexp))
    runScopeM (PureScopeM a
    _) =
      (DefaultDList
    forall a. Monoid a => a
    mempty, DefaultDList
    forall a. Monoid a => a
    mempty)

    instance Sem.Semigroup (ScopeM ()) where
      ScopeM ()
    a <> :: ScopeM () -> ScopeM () -> ScopeM ()
    <> ScopeM ()
    b  = ScopeM ()
    a ScopeM () -> ScopeM () -> ScopeM ()
    forall a b. ScopeM a -> ScopeM b -> ScopeM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ScopeM ()
    b

    instance Monoid (ScopeM ()) where
      mempty :: ScopeM ()
    mempty = () -> ScopeM ()
    forall a. a -> ScopeM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    #if !(MIN_VERSION_base(4,11,0))
      mappend = (Sem.<>)
    #endif

    instance Functor ScopeM where
      fmap :: forall a b. (a -> b) -> ScopeM a -> ScopeM b
    fmap a -> b
    f (SetDefault Ident
    ident Q Exp
    qexp ScopeM a
    next) =
        Ident -> Q Exp -> ScopeM b -> ScopeM b
    forall a. Ident -> Q Exp -> ScopeM a -> ScopeM a
    SetDefault Ident
    ident Q Exp
    qexp (ScopeM b -> ScopeM b) -> ScopeM b -> ScopeM b
    forall a b. (a -> b) -> a -> b
    $ (a -> b) -> ScopeM a -> ScopeM b
    forall a b. (a -> b) -> ScopeM a -> ScopeM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f ScopeM a
    next
      fmap a -> b
    f (Overwrite Ident
    ident Q Exp
    qexp ScopeM a
    next) =
        Ident -> Q Exp -> ScopeM b -> ScopeM b
    forall a. Ident -> Q Exp -> ScopeM a -> ScopeM a
    Overwrite Ident
    ident Q Exp
    qexp (ScopeM b -> ScopeM b) -> ScopeM b -> ScopeM b
    forall a b. (a -> b) -> a -> b
    $ (a -> b) -> ScopeM a -> ScopeM b
    forall a b. (a -> b) -> ScopeM a -> ScopeM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f ScopeM a
    next
      fmap a -> b
    f (PureScopeM a
    x) =
        b -> ScopeM b
    forall a. a -> ScopeM a
    PureScopeM (b -> ScopeM b) -> b -> ScopeM b
    forall a b. (a -> b) -> a -> b
    $ a -> b
    f a
    x

    instance Applicative ScopeM where
      pure :: forall a. a -> ScopeM a
    pure = a -> ScopeM a
    forall a. a -> ScopeM a
    PureScopeM
      SetDefault Ident
    ident Q Exp
    qexp ScopeM (a -> b)
    next <*> :: forall a b. ScopeM (a -> b) -> ScopeM a -> ScopeM b
    <*> ScopeM a
    f =
        Ident -> Q Exp -> ScopeM b -> ScopeM b
    forall a. Ident -> Q Exp -> ScopeM a -> ScopeM a
    SetDefault Ident
    ident Q Exp
    qexp (ScopeM b -> ScopeM b) -> ScopeM b -> ScopeM b
    forall a b. (a -> b) -> a -> b
    $ ScopeM (a -> b)
    next ScopeM (a -> b) -> ScopeM a -> ScopeM b
    forall a b. ScopeM (a -> b) -> ScopeM a -> ScopeM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ScopeM a
    f
      Overwrite Ident
    ident Q Exp
    qexp ScopeM (a -> b)
    next <*> ScopeM a
    f =
        Ident -> Q Exp -> ScopeM b -> ScopeM b
    forall a. Ident -> Q Exp -> ScopeM a -> ScopeM a
    Overwrite Ident
    ident Q Exp
    qexp (ScopeM b -> ScopeM b) -> ScopeM b -> ScopeM b
    forall a b. (a -> b) -> a -> b
    $ ScopeM (a -> b)
    next ScopeM (a -> b) -> ScopeM a -> ScopeM b
    forall a b. ScopeM (a -> b) -> ScopeM a -> ScopeM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ScopeM a
    f
      PureScopeM a -> b
    g <*> ScopeM a
    f = ScopeM a
    f ScopeM a -> (a -> ScopeM b) -> ScopeM b
    forall a b. ScopeM a -> (a -> ScopeM b) -> ScopeM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (b -> ScopeM b
    forall a. a -> ScopeM a
    PureScopeM (b -> ScopeM b) -> (a -> b) -> a -> ScopeM b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    g)

    instance Monad ScopeM where
    #if MIN_VERSION_base(4,9,0)
    #else
      return = PureScopeM
    #endif
      SetDefault Ident
    ident Q Exp
    qexp ScopeM a
    next >>= :: forall a b. ScopeM a -> (a -> ScopeM b) -> ScopeM b
    >>= a -> ScopeM b
    f = Ident -> Q Exp -> ScopeM b -> ScopeM b
    forall a. Ident -> Q Exp -> ScopeM a -> ScopeM a
    SetDefault Ident
    ident Q Exp
    qexp (ScopeM b -> ScopeM b) -> ScopeM b -> ScopeM b
    forall a b. (a -> b) -> a -> b
    $ ScopeM a
    next ScopeM a -> (a -> ScopeM b) -> ScopeM b
    forall a b. ScopeM a -> (a -> ScopeM b) -> ScopeM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= a -> ScopeM b
    f
      Overwrite Ident
    ident Q Exp
    qexp ScopeM a
    next >>= a -> ScopeM b
    f = Ident -> Q Exp -> ScopeM b -> ScopeM b
    forall a. Ident -> Q Exp -> ScopeM a -> ScopeM a
    Overwrite Ident
    ident Q Exp
    qexp (ScopeM b -> ScopeM b) -> ScopeM b -> ScopeM b
    forall a b. (a -> b) -> a -> b
    $ ScopeM a
    next ScopeM a -> (a -> ScopeM b) -> ScopeM b
    forall a b. ScopeM a -> (a -> ScopeM b) -> ScopeM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= a -> ScopeM b
    f
      PureScopeM a
    a >>= a -> ScopeM b
    f = a -> ScopeM b
    f a
    a

    {-| Constructor for 'ScopeM'.
      Values declared by this function are overwritten
      by same name variables exits in scope of render function.
     -}
    setDefault :: Ident -> Q Exp -> ScopeM ()
    setDefault :: Ident -> Q Exp -> ScopeM ()
    setDefault Ident
    ident Q Exp
    qexp = Ident -> Q Exp -> ScopeM () -> ScopeM ()
    forall a. Ident -> Q Exp -> ScopeM a -> ScopeM a
    SetDefault Ident
    ident Q Exp
    qexp (ScopeM () -> ScopeM ()) -> ScopeM () -> ScopeM ()
    forall a b. (a -> b) -> a -> b
    $ () -> ScopeM ()
    forall a. a -> ScopeM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    {-| Constructor for 'ScopeM'.
      Values declared by this function overwrites
      same name variables exits in scope of render function.
     -}
    overwrite :: Ident -> Q Exp -> ScopeM ()
    overwrite :: Ident -> Q Exp -> ScopeM ()
    overwrite Ident
    ident Q Exp
    qexp = Ident -> Q Exp -> ScopeM () -> ScopeM ()
    forall a. Ident -> Q Exp -> ScopeM a -> ScopeM a
    Overwrite Ident
    ident Q Exp
    qexp (ScopeM () -> ScopeM ()) -> ScopeM () -> ScopeM ()
    forall a b. (a -> b) -> a -> b
    $ () -> ScopeM ()
    forall a. a -> ScopeM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    instance IsString Ident where
      fromString :: String -> Ident
    fromString = String -> Ident
    Ident

    -- ==============================================
    --  Helper functions
    -- ==============================================

    docsToExp :: HeterocephalusSetting -> Scope -> [Doc] -> Q Exp
    docsToExp :: HeterocephalusSetting -> [(Ident, Exp)] -> [Doc] -> Q Exp
    docsToExp HeterocephalusSetting
    set [(Ident, Exp)]
    scope [Doc]
    docs = do
      [Exp]
    exps <- (Doc -> Q Exp) -> [Doc] -> Q [Exp]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (HeterocephalusSetting -> [(Ident, Exp)] -> Doc -> Q Exp
    docToExp HeterocephalusSetting
    set [(Ident, Exp)]
    scope) [Doc]
    docs
      case [Exp]
    exps of
        [] -> [|return ()|]
        [Exp
    x] -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    x
        [Exp]
    _ -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [Stmt] -> Exp
    doE ([Stmt] -> Exp) -> [Stmt] -> Exp
    forall a b. (a -> b) -> a -> b
    $ (Exp -> Stmt) -> [Exp] -> [Stmt]
    forall a b. (a -> b) -> [a] -> [b]
    map Exp -> Stmt
    NoBindS [Exp]
    exps

    docToExp :: HeterocephalusSetting -> Scope -> Doc -> Q Exp
    docToExp :: HeterocephalusSetting -> [(Ident, Exp)] -> Doc -> Q Exp
    docToExp HeterocephalusSetting
    set [(Ident, Exp)]
    scope (DocForall Deref
    list Binding
    idents [Doc]
    inside) = do
      let list' :: Exp
    list' = [(Ident, Exp)] -> Deref -> Exp
    derefToExp [(Ident, Exp)]
    scope Deref
    list
      (Pat
    pat, [(Ident, Exp)]
    extraScope) <- Binding -> Q (Pat, [(Ident, Exp)])
    bindingPattern Binding
    idents
      let scope' :: [(Ident, Exp)]
    scope' = [(Ident, Exp)]
    extraScope [(Ident, Exp)] -> [(Ident, Exp)] -> [(Ident, Exp)]
    forall a. [a] -> [a] -> [a]
    ++ [(Ident, Exp)]
    scope
      Exp
    mh <- [|F.mapM_|]
      Exp
    inside' <- HeterocephalusSetting -> [(Ident, Exp)] -> [Doc] -> Q Exp
    docsToExp HeterocephalusSetting
    set [(Ident, Exp)]
    scope' [Doc]
    inside
      let lam :: Exp
    lam = [Pat] -> Exp -> Exp
    LamE [Pat
    pat] Exp
    inside'
      Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp
    mh Exp -> Exp -> Exp
    `AppE` Exp
    lam Exp -> Exp -> Exp
    `AppE` Exp
    list'
    docToExp HeterocephalusSetting
    set [(Ident, Exp)]
    scope (DocCond [(Deref, [Doc])]
    conds Maybe [Doc]
    final) = do
      [Exp]
    conds' <- ((Deref, [Doc]) -> Q Exp) -> [(Deref, [Doc])] -> Q [Exp]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Deref, [Doc]) -> Q Exp
    go [(Deref, [Doc])]
    conds
      Exp
    final' <-
        case Maybe [Doc]
    final of
          Maybe [Doc]
    Nothing -> [|Nothing|]
          Just [Doc]
    f -> do
            Exp
    f' <- HeterocephalusSetting -> [(Ident, Exp)] -> [Doc] -> Q Exp
    docsToExp HeterocephalusSetting
    set [(Ident, Exp)]
    scope [Doc]
    f
            Exp
    j <- [|Just|]
            Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp
    j Exp -> Exp -> Exp
    `AppE` Exp
    f'
      Exp
    ch <- [|condH|]
      Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp
    ch Exp -> Exp -> Exp
    `AppE` [Exp] -> Exp
    ListE [Exp]
    conds' Exp -> Exp -> Exp
    `AppE` Exp
    final'
      where
        go :: (Deref, [Doc]) -> Q Exp
        go :: (Deref, [Doc]) -> Q Exp
    go (Deref
    d, [Doc]
    docs) = do
          let d' :: Exp
    d' = [(Ident, Exp)] -> Deref -> Exp
    derefToExp ((Ident
    specialOrIdent, Name -> Exp
    VarE 'or) (Ident, Exp) -> [(Ident, Exp)] -> [(Ident, Exp)]
    forall a. a -> [a] -> [a]
    : [(Ident, Exp)]
    scope) Deref
    d
          Exp
    docs' <- HeterocephalusSetting -> [(Ident, Exp)] -> [Doc] -> Q Exp
    docsToExp HeterocephalusSetting
    set [(Ident, Exp)]
    scope [Doc]
    docs
          Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [Exp] -> Exp
    nonUnaryTupE [Exp
    d', Exp
    docs']
          where
            nonUnaryTupE :: [Exp] -> Exp
            nonUnaryTupE :: [Exp] -> Exp
    nonUnaryTupE [Exp]
    es  = [Exp] -> Exp
    tupE [Exp]
    es
    docToExp HeterocephalusSetting
    set [(Ident, Exp)]
    scope (DocCase Deref
    deref [(Binding, [Doc])]
    cases) = do
        let exp_ :: Exp
    exp_ = [(Ident, Exp)] -> Deref -> Exp
    derefToExp [(Ident, Exp)]
    scope Deref
    deref
        [Match]
    matches <- ((Binding, [Doc]) -> Q Match) -> [(Binding, [Doc])] -> Q [Match]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Binding, [Doc]) -> Q Match
    toMatch [(Binding, [Doc])]
    cases
        Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> [Match] -> Exp
    CaseE Exp
    exp_ [Match]
    matches
      where
        toMatch :: (Binding, [Doc]) -> Q Match
        toMatch :: (Binding, [Doc]) -> Q Match
    toMatch (Binding
    idents, [Doc]
    inside) = do
            (Pat
    pat, [(Ident, Exp)]
    extraScope) <- Binding -> Q (Pat, [(Ident, Exp)])
    bindingPattern Binding
    idents
            let scope' :: [(Ident, Exp)]
    scope' = [(Ident, Exp)]
    extraScope [(Ident, Exp)] -> [(Ident, Exp)] -> [(Ident, Exp)]
    forall a. [a] -> [a] -> [a]
    ++ [(Ident, Exp)]
    scope
            Exp
    insideExp <- HeterocephalusSetting -> [(Ident, Exp)] -> [Doc] -> Q Exp
    docsToExp HeterocephalusSetting
    set [(Ident, Exp)]
    scope' [Doc]
    inside
            Match -> Q Match
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Match -> Q Match) -> Match -> Q Match
    forall a b. (a -> b) -> a -> b
    $ Pat -> Body -> [Dec] -> Match
    Match Pat
    pat (Exp -> Body
    NormalB Exp
    insideExp) []
    docToExp HeterocephalusSetting
    set [(Ident, Exp)]
    v (DocContent Content
    c) = HeterocephalusSetting -> [(Ident, Exp)] -> Content -> Q Exp
    contentToExp HeterocephalusSetting
    set [(Ident, Exp)]
    v Content
    c

    contentToExp :: HeterocephalusSetting -> Scope -> Content -> Q Exp
    contentToExp :: HeterocephalusSetting -> [(Ident, Exp)] -> Content -> Q Exp
    contentToExp HeterocephalusSetting
    _ [(Ident, Exp)]
    _ (ContentRaw String
    s) = do
      Exp
    os <- [|preEscapedText . pack|]
      let s' :: Exp
    s' = Lit -> Exp
    LitE (Lit -> Exp) -> Lit -> Exp
    forall a b. (a -> b) -> a -> b
    $ String -> Lit
    StringL String
    s
      Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp
    os Exp -> Exp -> Exp
    `AppE` Exp
    s'
    contentToExp HeterocephalusSetting
    set [(Ident, Exp)]
    scope (ContentVar Deref
    d) = do
      Exp
    str <- HeterocephalusSetting -> Q Exp
    escapeExp HeterocephalusSetting
    set
      Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp
    str Exp -> Exp -> Exp
    `AppE` [(Ident, Exp)] -> Deref -> Exp
    derefToExp [(Ident, Exp)]
    scope Deref
    d

    -- ==============================================
    -- Codes from Text.Hamlet that is not exposed
    -- ==============================================

    unIdent :: Ident -> String
    unIdent :: Ident -> String
    unIdent (Ident String
    s) = String
    s

    bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)])
    bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)])
    bindingPattern (BindAs i :: Ident
    i@(Ident String
    s) Binding
    b) = do
      Name
    name <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    s
      (Pat
    pattern, [(Ident, Exp)]
    scope) <- Binding -> Q (Pat, [(Ident, Exp)])
    bindingPattern Binding
    b
      (Pat, [(Ident, Exp)]) -> Q (Pat, [(Ident, Exp)])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> Pat -> Pat
    AsP Name
    name Pat
    pattern, (Ident
    i, Name -> Exp
    VarE Name
    name) (Ident, Exp) -> [(Ident, Exp)] -> [(Ident, Exp)]
    forall a. a -> [a] -> [a]
    : [(Ident, Exp)]
    scope)
    bindingPattern (BindVar i :: Ident
    i@(Ident String
    s))
      | String
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "_" = (Pat, [(Ident, Exp)]) -> Q (Pat, [(Ident, Exp)])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pat
    WildP, [])
      | (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isDigit String
    s = do (Pat, [(Ident, Exp)]) -> Q (Pat, [(Ident, Exp)])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Lit -> Pat
    LitP (Lit -> Pat) -> Lit -> Pat
    forall a b. (a -> b) -> a -> b
    $ Integer -> Lit
    IntegerL (Integer -> Lit) -> Integer -> Lit
    forall a b. (a -> b) -> a -> b
    $ String -> Integer
    forall a. Read a => String -> a
    read String
    s, [])
      | Bool
    otherwise = do
        Name
    name <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    s
        (Pat, [(Ident, Exp)]) -> Q (Pat, [(Ident, Exp)])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> Pat
    VarP Name
    name, [(Ident
    i, Name -> Exp
    VarE Name
    name)])
    bindingPattern (BindTuple [Binding]
    is) = do
      ([Pat]
    patterns, [[(Ident, Exp)]]
    scopes) <- ([(Pat, [(Ident, Exp)])] -> ([Pat], [[(Ident, Exp)]]))
    -> Q [(Pat, [(Ident, Exp)])] -> Q ([Pat], [[(Ident, Exp)]])
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [(Pat, [(Ident, Exp)])] -> ([Pat], [[(Ident, Exp)]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (Q [(Pat, [(Ident, Exp)])] -> Q ([Pat], [[(Ident, Exp)]]))
    -> Q [(Pat, [(Ident, Exp)])] -> Q ([Pat], [[(Ident, Exp)]])
    forall a b. (a -> b) -> a -> b
    $ (Binding -> Q (Pat, [(Ident, Exp)]))
    -> [Binding] -> Q [(Pat, [(Ident, Exp)])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Binding -> Q (Pat, [(Ident, Exp)])
    bindingPattern [Binding]
    is
      (Pat, [(Ident, Exp)]) -> Q (Pat, [(Ident, Exp)])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Pat] -> Pat
    TupP [Pat]
    patterns, [[(Ident, Exp)]] -> [(Ident, Exp)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(Ident, Exp)]]
    scopes)
    bindingPattern (BindList [Binding]
    is) = do
      ([Pat]
    patterns, [[(Ident, Exp)]]
    scopes) <- ([(Pat, [(Ident, Exp)])] -> ([Pat], [[(Ident, Exp)]]))
    -> Q [(Pat, [(Ident, Exp)])] -> Q ([Pat], [[(Ident, Exp)]])
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [(Pat, [(Ident, Exp)])] -> ([Pat], [[(Ident, Exp)]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (Q [(Pat, [(Ident, Exp)])] -> Q ([Pat], [[(Ident, Exp)]]))
    -> Q [(Pat, [(Ident, Exp)])] -> Q ([Pat], [[(Ident, Exp)]])
    forall a b. (a -> b) -> a -> b
    $ (Binding -> Q (Pat, [(Ident, Exp)]))
    -> [Binding] -> Q [(Pat, [(Ident, Exp)])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Binding -> Q (Pat, [(Ident, Exp)])
    bindingPattern [Binding]
    is
      (Pat, [(Ident, Exp)]) -> Q (Pat, [(Ident, Exp)])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Pat] -> Pat
    ListP [Pat]
    patterns, [[(Ident, Exp)]] -> [(Ident, Exp)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(Ident, Exp)]]
    scopes)
    bindingPattern (BindConstr DataConstr
    con [Binding]
    is) = do
      ([Pat]
    patterns, [[(Ident, Exp)]]
    scopes) <- ([(Pat, [(Ident, Exp)])] -> ([Pat], [[(Ident, Exp)]]))
    -> Q [(Pat, [(Ident, Exp)])] -> Q ([Pat], [[(Ident, Exp)]])
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [(Pat, [(Ident, Exp)])] -> ([Pat], [[(Ident, Exp)]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (Q [(Pat, [(Ident, Exp)])] -> Q ([Pat], [[(Ident, Exp)]]))
    -> Q [(Pat, [(Ident, Exp)])] -> Q ([Pat], [[(Ident, Exp)]])
    forall a b. (a -> b) -> a -> b
    $ (Binding -> Q (Pat, [(Ident, Exp)]))
    -> [Binding] -> Q [(Pat, [(Ident, Exp)])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Binding -> Q (Pat, [(Ident, Exp)])
    bindingPattern [Binding]
    is
    #if MIN_VERSION_template_haskell_compat_v0208(0,1,8)
      {-
      Todo: Note, the use of conP below (note lowercase 'c') is from the package 'template-haskell-compat-v0208'.
      This allows Heterocephalus to compile with GHC 9.2, as the ConP constructor takes an additional argument in GHC 9.2
      Note however this _probably_ means there was some new extension or new syntax extension that GHC now allows post GHC 9.2
      that we are not able to handle. As I (clintonmead@gmail.com) am just writing a PR to the library and don't fully understand it
      (I'm making this PR just to make our current project build under GHC 9.2) there's probably some more work to be done here.

      The github issue relating to this is at https://github.com/arowM/heterocephalus/issues/32
      -}
      (Pat, [(Ident, Exp)]) -> Q (Pat, [(Ident, Exp)])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> [Pat] -> Pat
    conP (DataConstr -> Name
    mkConName DataConstr
    con) [Pat]
    patterns, [[(Ident, Exp)]] -> [(Ident, Exp)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(Ident, Exp)]]
    scopes)
    #else
      return (ConP (mkConName con) patterns, concat scopes)
    #endif
    bindingPattern (BindRecord DataConstr
    con [(Ident, Binding)]
    fields Bool
    wild) = do
      let f :: (Ident, Binding) -> Q ((Name, Pat), [(Ident, Exp)])
    f (Ident String
    field, Binding
    b) = do
            (Pat
    p, [(Ident, Exp)]
    s) <- Binding -> Q (Pat, [(Ident, Exp)])
    bindingPattern Binding
    b
            ((Name, Pat), [(Ident, Exp)]) -> Q ((Name, Pat), [(Ident, Exp)])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((String -> Name
    mkName String
    field, Pat
    p), [(Ident, Exp)]
    s)
      ([(Name, Pat)]
    patterns, [[(Ident, Exp)]]
    scopes) <- ([((Name, Pat), [(Ident, Exp)])]
     -> ([(Name, Pat)], [[(Ident, Exp)]]))
    -> Q [((Name, Pat), [(Ident, Exp)])]
    -> Q ([(Name, Pat)], [[(Ident, Exp)]])
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [((Name, Pat), [(Ident, Exp)])]
    -> ([(Name, Pat)], [[(Ident, Exp)]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (Q [((Name, Pat), [(Ident, Exp)])]
     -> Q ([(Name, Pat)], [[(Ident, Exp)]]))
    -> Q [((Name, Pat), [(Ident, Exp)])]
    -> Q ([(Name, Pat)], [[(Ident, Exp)]])
    forall a b. (a -> b) -> a -> b
    $ ((Ident, Binding) -> Q ((Name, Pat), [(Ident, Exp)]))
    -> [(Ident, Binding)] -> Q [((Name, Pat), [(Ident, Exp)])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Ident, Binding) -> Q ((Name, Pat), [(Ident, Exp)])
    f [(Ident, Binding)]
    fields
      ([(Name, Pat)]
    patterns1, [(Ident, Exp)]
    scopes1) <-
        if Bool
    wild
          then DataConstr -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)])
    bindWildFields DataConstr
    con ([Ident] -> Q ([(Name, Pat)], [(Ident, Exp)]))
    -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)])
    forall a b. (a -> b) -> a -> b
    $ ((Ident, Binding) -> Ident) -> [(Ident, Binding)] -> [Ident]
    forall a b. (a -> b) -> [a] -> [b]
    map (Ident, Binding) -> Ident
    forall a b. (a, b) -> a
    fst [(Ident, Binding)]
    fields
          else ([(Name, Pat)], [(Ident, Exp)])
    -> Q ([(Name, Pat)], [(Ident, Exp)])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [])
      (Pat, [(Ident, Exp)]) -> Q (Pat, [(Ident, Exp)])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        (Name -> [(Name, Pat)] -> Pat
    RecP (DataConstr -> Name
    mkConName DataConstr
    con) ([(Name, Pat)]
    patterns [(Name, Pat)] -> [(Name, Pat)] -> [(Name, Pat)]
    forall a. [a] -> [a] -> [a]
    ++ [(Name, Pat)]
    patterns1), [[(Ident, Exp)]] -> [(Ident, Exp)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(Ident, Exp)]]
    scopes [(Ident, Exp)] -> [(Ident, Exp)] -> [(Ident, Exp)]
    forall a. [a] -> [a] -> [a]
    ++ [(Ident, Exp)]
    scopes1)

    mkConName :: DataConstr -> Name
    mkConName :: DataConstr -> Name
    mkConName = String -> Name
    mkName (String -> Name) -> (DataConstr -> String) -> DataConstr -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataConstr -> String
    conToStr

    conToStr :: DataConstr -> String
    conToStr :: DataConstr -> String
    conToStr (DCUnqualified (Ident String
    x)) = String
    x
    conToStr (DCQualified (Module [String]
    xs) (Ident String
    x)) = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "." ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [String]
    xs [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    x]

    -- Wildcards bind all of the unbound fields to variables whose name
    -- matches the field name.
    --
    -- For example: data R = C { f1, f2 :: Int }
    -- C {..}           is equivalent to   C {f1=f1, f2=f2}
    -- C {f1 = a, ..}   is equivalent to   C {f1=a,  f2=f2}
    -- C {f2 = a, ..}   is equivalent to   C {f1=f1, f2=a}
    bindWildFields :: DataConstr -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)])
    bindWildFields :: DataConstr -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)])
    bindWildFields DataConstr
    conName [Ident]
    fields = do
      [Name]
    fieldNames <- DataConstr -> Q [Name]
    recordToFieldNames DataConstr
    conName
      let available :: Name -> Bool
    available Name
    n = Name -> String
    nameBase Name
    n String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` (Ident -> String) -> [Ident] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Ident -> String
    unIdent [Ident]
    fields
      let remainingFields :: [Name]
    remainingFields = (Name -> Bool) -> [Name] -> [Name]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Name -> Bool
    available [Name]
    fieldNames
      let mkPat :: Name -> m ((Name, Pat), (Ident, Exp))
    mkPat Name
    n = do
            Name
    e <- String -> m Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Name -> String
    nameBase Name
    n)
            ((Name, Pat), (Ident, Exp)) -> m ((Name, Pat), (Ident, Exp))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Name
    n, Name -> Pat
    VarP Name
    e), (String -> Ident
    Ident (Name -> String
    nameBase Name
    n), Name -> Exp
    VarE Name
    e))
      ([((Name, Pat), (Ident, Exp))] -> ([(Name, Pat)], [(Ident, Exp)]))
    -> Q [((Name, Pat), (Ident, Exp))]
    -> Q ([(Name, Pat)], [(Ident, Exp)])
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [((Name, Pat), (Ident, Exp))] -> ([(Name, Pat)], [(Ident, Exp)])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (Q [((Name, Pat), (Ident, Exp))]
     -> Q ([(Name, Pat)], [(Ident, Exp)]))
    -> Q [((Name, Pat), (Ident, Exp))]
    -> Q ([(Name, Pat)], [(Ident, Exp)])
    forall a b. (a -> b) -> a -> b
    $ (Name -> Q ((Name, Pat), (Ident, Exp)))
    -> [Name] -> Q [((Name, Pat), (Ident, Exp))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Name -> Q ((Name, Pat), (Ident, Exp))
    forall {m :: * -> *}.
    Quote m =>
    Name -> m ((Name, Pat), (Ident, Exp))
    mkPat [Name]
    remainingFields

    -- Important note! reify will fail if the record type is defined in the
    -- same module as the reify is used. This means quasi-quoted Hamlet
    -- literals will not be able to use wildcards to match record types
    -- defined in the same module.
    recordToFieldNames :: DataConstr -> Q [Name]
    recordToFieldNames :: DataConstr -> Q [Name]
    recordToFieldNames DataConstr
    conStr
      -- use 'lookupValueName' instead of just using 'mkName' so we reify the
      -- data constructor and not the type constructor if their names match.
     = do
      Just Name
    conName <- String -> Q (Maybe Name)
    lookupValueName (String -> Q (Maybe Name)) -> String -> Q (Maybe Name)
    forall a b. (a -> b) -> a -> b
    $ DataConstr -> String
    conToStr DataConstr
    conStr
    #if MIN_VERSION_template_haskell(2,11,0)
      DataConI Name
    _ Type
    _ Name
    typeName         <- Name -> Q Info
    reify Name
    conName
      TyConI (DataD Cxt
    _ Name
    _ [TyVarBndr ()]
    _ Maybe Type
    _ [Con]
    cons [DerivClause]
    _) <- Name -> Q Info
    reify Name
    typeName
    #else
      DataConI _ _ typeName _     <- reify conName
      TyConI (DataD _ _ _ cons _) <- reify typeName
    #endif
      [[VarBangType]
    fields] <- [[VarBangType]] -> Q [[VarBangType]]
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [[VarBangType]
    fields | RecC Name
    name [VarBangType]
    fields <- [Con]
    cons, Name
    name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    conName]
      [Name] -> Q [Name]
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name
    fieldName | (Name
    fieldName, Bang
    _, Type
    _) <- [VarBangType]
    fields]

    type QueryParameters = [(Text, Text)]

    data VarExp msg url
      = EPlain Html
      | EUrl url
      | EUrlParam (url, QueryParameters)
      | EMixin (HtmlUrl url)
      | EMixinI18n (HtmlUrlI18n msg url)
      | EMsg msg

    instance Show (VarExp msg url) where
      show :: VarExp msg url -> String
    show (EPlain Html
    _) = String
    "EPlain"
      show (EUrl url
    _) = String
    "EUrl"
      show (EUrlParam (url, QueryParameters)
    _) = String
    "EUrlParam"
      show (EMixin HtmlUrl url
    _) = String
    "EMixin"
      show (EMixinI18n HtmlUrlI18n msg url
    _) = String
    "EMixinI18n"
      show (EMsg msg
    _) = String
    "EMsg"