{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Text.Hamlet.XML
    ( xml
    , xmlFile
    , ToAttributes (..)
    ) where

#if MIN_VERSION_template_haskell(2,9,0)
import Language.Haskell.TH.Syntax hiding (Module)
#else
import Language.Haskell.TH.Syntax
#endif
import Language.Haskell.TH.Quote
import Data.Char (isDigit)
import qualified Data.Text.Lazy as TL
import Control.Monad ((<=<))
import Text.Hamlet.XMLParse
import Text.Shakespeare.Base (readUtf8File, derefToExp, Scope, Deref, Ident (Ident))
import Data.Text (Text, pack, unpack)
import qualified Data.Text as T
import qualified Text.XML as X
import Data.String (fromString)
import qualified Data.Foldable as F
import Data.Maybe (fromMaybe)
import qualified Data.Map as Map
import Control.Arrow (first, (***))
import Data.List (intercalate)

conP :: Name -> [Pat] -> Pat
#if MIN_VERSION_template_haskell(2,18,0)
conP :: Name -> [Pat] -> Pat
conP Name
name = Name -> [Type] -> [Pat] -> Pat
ConP Name
name []
#else
conP = ConP
#endif

-- | Convert some value to a list of attribute pairs.
class ToAttributes a where
    toAttributes :: a -> Map.Map X.Name Text
instance ToAttributes (X.Name, Text) where
    toAttributes :: (Name, Text) -> Map Name Text
toAttributes (Name
k, Text
v) = forall k a. k -> a -> Map k a
Map.singleton Name
k Text
v
instance ToAttributes (Text, Text) where
    toAttributes :: (Text, Text) -> Map Name Text
toAttributes (Text
k, Text
v) = forall k a. k -> a -> Map k a
Map.singleton (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
k) Text
v
instance ToAttributes (String, String) where
    toAttributes :: (String, String) -> Map Name Text
toAttributes (String
k, String
v) = forall k a. k -> a -> Map k a
Map.singleton (forall a. IsString a => String -> a
fromString String
k) (String -> Text
pack String
v)
instance ToAttributes [(X.Name, Text)] where
    toAttributes :: [(Name, Text)] -> Map Name Text
toAttributes = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
instance ToAttributes [(Text, Text)] where
    toAttributes :: [(Text, Text)] -> Map Name Text
toAttributes = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack))
instance ToAttributes [(String, String)] where
    toAttributes :: [(String, String)] -> Map Name Text
toAttributes = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsString a => String -> a
fromString forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> Text
pack)
instance ToAttributes (Map.Map X.Name Text) where
    toAttributes :: Map Name Text -> Map Name Text
toAttributes = forall a. a -> a
id
instance ToAttributes (Map.Map Text Text) where
    toAttributes :: Map Text Text -> Map Name Text
toAttributes = forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack)
instance ToAttributes (Map.Map String String) where
    toAttributes :: Map String String -> Map Name Text
toAttributes = forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
Map.map String -> Text
pack

docsToExp :: Scope -> [Doc] -> Q Exp
docsToExp :: Scope -> [Doc] -> Q Exp
docsToExp Scope
scope [Doc]
docs = [| concat $(fmap ListE $ mapM (docToExp scope) docs) |]

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

bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)])
bindingPattern :: Binding -> Q (Pat, Scope)
bindingPattern (BindAs i :: Ident
i@(Ident String
s) Binding
b) = do
    Name
name <- forall (m :: * -> *). Quote m => String -> m Name
newName String
s
    (Pat
pattern, Scope
scope) <- Binding -> Q (Pat, Scope)
bindingPattern Binding
b
    forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Pat -> Pat
AsP Name
name Pat
pattern, (Ident
i, Name -> Exp
VarE Name
name)forall a. a -> [a] -> [a]
:Scope
scope)
bindingPattern (BindVar i :: Ident
i@(Ident String
s))
    | String
s forall a. Eq a => a -> a -> Bool
== String
"_" = forall (m :: * -> *) a. Monad m => a -> m a
return (Pat
WildP, [])
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
s = do
        forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Pat
LitP forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read String
s, [])
    | Bool
otherwise = do
        Name
name <- forall (m :: * -> *). Quote m => String -> m Name
newName String
s
        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, [Scope]
scopes) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Binding -> Q (Pat, Scope)
bindingPattern [Binding]
is
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Pat] -> Pat
TupP [Pat]
patterns, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Scope]
scopes)
bindingPattern (BindList [Binding]
is) = do
    ([Pat]
patterns, [Scope]
scopes) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Binding -> Q (Pat, Scope)
bindingPattern [Binding]
is
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Pat] -> Pat
ListP [Pat]
patterns, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Scope]
scopes)
bindingPattern (BindConstr DataConstr
con [Binding]
is) = do
    ([Pat]
patterns, [Scope]
scopes) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Binding -> Q (Pat, Scope)
bindingPattern [Binding]
is
    forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Pat] -> Pat
conP (DataConstr -> Name
mkConName DataConstr
con) [Pat]
patterns, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Scope]
scopes)
bindingPattern (BindRecord DataConstr
con [(Ident, Binding)]
fields Bool
wild) = do
    let f :: (Ident, Binding) -> Q ((Name, Pat), Scope)
f (Ident String
field,Binding
b) =
           do (Pat
p,Scope
s) <- Binding -> Q (Pat, Scope)
bindingPattern Binding
b
              forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> Name
mkName String
field,Pat
p),Scope
s)
    ([(Name, Pat)]
patterns, [Scope]
scopes) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ident, Binding) -> Q ((Name, Pat), Scope)
f [(Ident, Binding)]
fields
    ([(Name, Pat)]
patterns1, Scope
scopes1) <- if Bool
wild
       then DataConstr -> [Ident] -> Q ([(Name, Pat)], Scope)
bindWildFields DataConstr
con forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Ident, Binding)]
fields
       else forall (m :: * -> *) a. Monad m => a -> m a
return ([],[])
    forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [(Name, Pat)] -> Pat
RecP (DataConstr -> Name
mkConName DataConstr
con) ([(Name, Pat)]
patternsforall a. [a] -> [a] -> [a]
++[(Name, Pat)]
patterns1), forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Scope]
scopes forall a. [a] -> [a] -> [a]
++ Scope
scopes1)

mkConName :: DataConstr -> Name
mkConName :: DataConstr -> Name
mkConName = String -> Name
mkName 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)) = forall a. [a] -> [[a]] -> [a]
intercalate String
"." forall a b. (a -> b) -> a -> b
$ [String]
xs 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)], Scope)
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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map Ident -> String
unIdent [Ident]
fields
  let remainingFields :: [Name]
remainingFields = 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 <- forall (m :: * -> *). Quote m => String -> m Name
newName (Name -> String
nameBase Name
n)
        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))
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 = do
  -- use 'lookupValueName' instead of just using 'mkName' so we reify the
  -- data constructor and not the type constructor if their names match.
  Just Name
conName                <- String -> Q (Maybe Name)
lookupValueName 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 [Type]
_ 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] <- forall (m :: * -> *) a. Monad m => a -> m a
return [[VarBangType]
fields | RecC Name
name [VarBangType]
fields <- [Con]
cons, Name
name forall a. Eq a => a -> a -> Bool
== Name
conName]
  forall (m :: * -> *) a. Monad m => a -> m a
return [Name
fieldName | (Name
fieldName, Bang
_, Type
_) <- [VarBangType]
fields]

docToExp :: Scope -> Doc -> Q Exp
docToExp :: Scope -> Doc -> Q Exp
docToExp Scope
scope (DocTag String
name [(Maybe Deref, String, [Content])]
attrs [Deref]
attrsD [Doc]
cs) =
    [| [ X.NodeElement (X.Element ($(liftName name)) $(mkAttrs scope attrs attrsD) $(docsToExp scope cs))
       ] |]
docToExp Scope
_ (DocContent (ContentRaw String
s)) = [| [ X.NodeContent (pack $(lift s)) ] |]
docToExp Scope
scope (DocContent (ContentVar Deref
d)) = [| [ X.NodeContent $(return $ derefToExp scope d) ] |]
docToExp Scope
scope (DocContent (ContentEmbed Deref
d)) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Scope -> Deref -> Exp
derefToExp Scope
scope Deref
d
docToExp Scope
scope (DocForall Deref
list Binding
idents [Doc]
inside) = do
    let list' :: Exp
list' = Scope -> Deref -> Exp
derefToExp Scope
scope Deref
list
    (Pat
pat, Scope
extraScope) <- Binding -> Q (Pat, Scope)
bindingPattern Binding
idents
    let scope' :: Scope
scope' = Scope
extraScope forall a. [a] -> [a] -> [a]
++ Scope
scope
    Exp
mh <- [|F.concatMap|]
    Exp
inside' <- Scope -> [Doc] -> Q Exp
docsToExp Scope
scope' [Doc]
inside
    let lam :: Exp
lam = [Pat] -> Exp -> Exp
LamE [Pat
pat] Exp
inside'
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exp
mh Exp -> Exp -> Exp
`AppE` Exp
lam Exp -> Exp -> Exp
`AppE` Exp
list'
docToExp Scope
scope (DocWith [] [Doc]
inside) = Scope -> [Doc] -> Q Exp
docsToExp Scope
scope [Doc]
inside
docToExp Scope
scope (DocWith ((Deref
deref, Binding
idents):[(Deref, Binding)]
dis) [Doc]
inside) = do
    let deref' :: Exp
deref' = Scope -> Deref -> Exp
derefToExp Scope
scope Deref
deref
    (Pat
pat, Scope
extraScope) <- Binding -> Q (Pat, Scope)
bindingPattern Binding
idents
    let scope' :: Scope
scope' = Scope
extraScope forall a. [a] -> [a] -> [a]
++ Scope
scope
    Exp
inside' <- Scope -> Doc -> Q Exp
docToExp Scope
scope' ([(Deref, Binding)] -> [Doc] -> Doc
DocWith [(Deref, Binding)]
dis [Doc]
inside)
    let lam :: Exp
lam = [Pat] -> Exp -> Exp
LamE [Pat
pat] Exp
inside'
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exp
lam Exp -> Exp -> Exp
`AppE` Exp
deref'
docToExp Scope
scope (DocMaybe Deref
val Binding
idents [Doc]
inside Maybe [Doc]
mno) = do
    let val' :: Exp
val' = Scope -> Deref -> Exp
derefToExp Scope
scope Deref
val
    (Pat
pat, Scope
extraScope) <- Binding -> Q (Pat, Scope)
bindingPattern Binding
idents
    let scope' :: Scope
scope' = Scope
extraScope forall a. [a] -> [a] -> [a]
++ Scope
scope
    Exp
inside' <- Scope -> [Doc] -> Q Exp
docsToExp Scope
scope' [Doc]
inside
    let inside'' :: Exp
inside'' = [Pat] -> Exp -> Exp
LamE [Pat
pat] Exp
inside'
    Exp
ninside' <- case Maybe [Doc]
mno of
                    Maybe [Doc]
Nothing -> [| [] |]
                    Just [Doc]
no -> Scope -> [Doc] -> Q Exp
docsToExp Scope
scope [Doc]
no
    [| maybe $(return ninside') $(return inside'') $(return val') |]
docToExp Scope
scope (DocCond [(Deref, [Doc])]
conds Maybe [Doc]
final) = do
    Exp
unit <- [| () |]
    Exp
otherwise' <- [|otherwise|]
    Body
body <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Guard, Exp)] -> Body
GuardedB forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Exp, [Doc]) -> Q (Guard, Exp)
go forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Scope -> Deref -> Exp
derefToExp Scope
scope)) [(Deref, [Doc])]
conds forall a. [a] -> [a] -> [a]
++ [(Exp
otherwise', forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Doc]
final)]
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exp -> [Match] -> Exp
CaseE Exp
unit [Pat -> Body -> [Dec] -> Match
Match ([Pat] -> Pat
TupP []) Body
body []]
  where
    go :: (Exp, [Doc]) -> Q (Guard, Exp)
go (Exp
deref, [Doc]
inside) = do
        Exp
inside' <- Scope -> [Doc] -> Q Exp
docsToExp Scope
scope [Doc]
inside
        forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Guard
NormalG Exp
deref, Exp
inside')
docToExp Scope
scope (DocCase Deref
deref [(Binding, [Doc])]
cases) = do
    let exp_ :: Exp
exp_ = Scope -> Deref -> Exp
derefToExp Scope
scope Deref
deref
    [Match]
matches <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Binding, [Doc]) -> Q Match
toMatch [(Binding, [Doc])]
cases
    forall (m :: * -> *) a. Monad m => a -> m a
return 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, Scope
extraScope) <- Binding -> Q (Pat, Scope)
bindingPattern Binding
idents
        let scope' :: Scope
scope' = Scope
extraScope forall a. [a] -> [a] -> [a]
++ Scope
scope
        Exp
insideExp <- Scope -> [Doc] -> Q Exp
docsToExp Scope
scope' [Doc]
inside
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Pat -> Body -> [Dec] -> Match
Match Pat
pat (Exp -> Body
NormalB Exp
insideExp) []

mkAttrs :: Scope -> [(Maybe Deref, String, [Content])] -> [Deref] -> Q Exp
mkAttrs :: Scope -> [(Maybe Deref, String, [Content])] -> [Deref] -> Q Exp
mkAttrs Scope
_ [] [] = [| Map.empty |]
mkAttrs Scope
scope [] (Deref
deref:[Deref]
rest) = do
    Exp
rest' <- Scope -> [(Maybe Deref, String, [Content])] -> [Deref] -> Q Exp
mkAttrs Scope
scope [] [Deref]
rest
    [| Map.union (toAttributes $(return $ derefToExp scope deref)) $(return rest') |]
mkAttrs Scope
scope ((Maybe Deref
mderef, String
name, [Content]
value):[(Maybe Deref, String, [Content])]
rest) [Deref]
attrs = do
    Exp
rest' <- Scope -> [(Maybe Deref, String, [Content])] -> [Deref] -> Q Exp
mkAttrs Scope
scope [(Maybe Deref, String, [Content])]
rest [Deref]
attrs
    Exp
this <- [| Map.insert $(liftName name) (T.concat $(fmap ListE $ mapM go value)) |]
    let with :: Q Exp
with = [| $(return this) $(return rest') |]
    case Maybe Deref
mderef of
        Maybe Deref
Nothing -> Q Exp
with
        Just Deref
deref -> [| if $(return $ derefToExp scope deref) then $(with) else $(return rest') |]
  where
    go :: Content -> m Exp
go (ContentRaw String
s) = [| pack $(lift s) |]
    go (ContentVar Deref
d) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Scope -> Deref -> Exp
derefToExp Scope
scope Deref
d
    go ContentEmbed{} = forall a. HasCallStack => String -> a
error String
"Cannot use embed interpolation in attribute value"

liftName :: String -> Q Exp
liftName :: String -> Q Exp
liftName String
s = do
    X.Name Text
local Maybe Text
mns Maybe Text
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
s
    case Maybe Text
mns of
        Maybe Text
Nothing -> [| X.Name (pack $(lift $ unpack local)) Nothing Nothing |]
        Just Text
ns -> [| X.Name (pack $(lift $ unpack local)) (Just $ pack $(lift $ unpack ns)) Nothing |]

xml :: QuasiQuoter
xml :: QuasiQuoter
xml = QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
strToExp }

xmlFile :: FilePath -> Q Exp
xmlFile :: String -> Q Exp
xmlFile = String -> Q Exp
strToExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Text
readUtf8File

strToExp :: String -> Q Exp
strToExp :: String -> Q Exp
strToExp String
s =
    case String -> Result [Doc]
parseDoc String
s of
        Error String
e -> forall a. HasCallStack => String -> a
error String
e
        Ok [Doc]
x -> Scope -> [Doc] -> Q Exp
docsToExp [] [Doc]
x