module Text.XML.TyDom.Core.Generics.ToElem
( GToElem
, genericToElem
) where
import Text.XML.TyDom.Core.Generics.Types (OptionsElement (optAttrName,
optConstructorElemName,
optSelectorElemName),
symt)
import Text.XML.TyDom.Core.Types (Attr (Attr), CData (CData),
Child (Child), Content (Content),
ToElem (toElem), ToXText (toXText))
import Text.XML.TyDom.Core.XMLInterface (Compose, cAttr, cCData, cChild,
cContent, cEmpty, cFreeze, cName,
cThaw, cNull)
import Data.List (foldl')
import Data.Proxy (Proxy (Proxy))
import GHC.Generics
import GHC.TypeLits (KnownSymbol)
genericToElem :: (Generic z, GToElem e n a t (Rep z))
=> OptionsElement n a
-> Compose e n a t c
-> (z -> e)
genericToElem o c z = cFreeze c $ gToElem o c (from z) $ cEmpty c
class GToElem e n a t z where
gToElem :: OptionsElement n a -> Compose e n a t c -> z r -> (c -> c)
instance GToElem e n a t z =>
GToElem e n a t (D1 ('MetaData g h i 'False) z) where
gToElem o c (M1 z) = gToElem o c z
instance (KnownSymbol name, ToElem e z) =>
GToElem e n a t (D1 ('MetaData g h i 'True)
(C1 ('MetaCons name q w)
(S1 s (Rec0 z)))) where
gToElem o c (M1 (M1 (M1 (K1 z)))) = setCreatedElemName o c p (toElem z)
where p = Proxy :: Proxy name
instance GToElem e n a t U1 where
gToElem _ _ _ = id
instance (KnownSymbol name, GToElem e n a t z) =>
GToElem e n a t (C1 ('MetaCons name q w) z) where
gToElem o c (M1 z) = setElemName o c p . gToElem o c z
where p = Proxy :: Proxy name
instance (GToElem e n a t z1, GToElem e n a t z2) =>
GToElem e n a t (z1 :*: z2) where
gToElem o c (z1 :*: z2) = gToElem o c z2 . gToElem o c z1
instance (GToElem e n a t z1, GToElem e n a t z2) =>
GToElem e n a t (z1 :+: z2) where
gToElem o c (L1 z1) = gToElem o c z1
gToElem o c (R1 z2) = gToElem o c z2
instance (KnownSymbol name, ToXText t z) =>
GToElem e n a t (S1 ('MetaSel ('Just name) g h i)
(Rec0 (Attr z))) where
gToElem o c (M1 (K1 (Attr z))) = setAttr o c p z
where p = Proxy :: Proxy name
instance (KnownSymbol name, ToXText t z) =>
GToElem e n a t (S1 ('MetaSel ('Just name) g h i)
(Rec0 (Attr (Maybe z)))) where
gToElem _ _ (M1 (K1 (Attr Nothing))) = id
gToElem o c (M1 (K1 (Attr (Just z)))) = setAttr o c p z
where p = Proxy :: Proxy name
instance (KnownSymbol name, ToXText t z) =>
GToElem e n a t (S1 ('MetaSel ('Just name) g h i)
(Rec0 (Child z))) where
gToElem o c (M1 (K1 (Child z))) = addTextChild o c p z
where p = Proxy :: Proxy name
instance (KnownSymbol name, ToXText t z) =>
GToElem e n a t (S1 ('MetaSel ('Just name) g h i)
(Rec0 (Child (Maybe z)))) where
gToElem _ _ (M1 (K1 (Child Nothing))) = id
gToElem o c (M1 (K1 (Child (Just z)))) = addTextChild o c p z
where p = Proxy :: Proxy name
instance (KnownSymbol name, ToXText t z) =>
GToElem e n a t (S1 ('MetaSel ('Just name) g h i)
(Rec0 (Child [z]))) where
gToElem o c (M1 (K1 (Child zs))) = appRList (addTextChild o c p <$> zs)
where p = Proxy :: Proxy name
instance ToXText t z => GToElem e n a t (S1 q (Rec0 (Content z))) where
gToElem _ c (M1 (K1 (Content z))) = addContent c z
instance ToXText t z =>
GToElem e n a t (S1 q (Rec0 (Content (Maybe z)))) where
gToElem _ _ (M1 (K1 (Content Nothing))) = id
gToElem _ c (M1 (K1 (Content (Just z)))) = addContent c z
instance ToXText t z => GToElem e n a t (S1 q (Rec0 (CData z))) where
gToElem _ c (M1 (K1 (CData z))) = addCData c z
instance ToXText t z => GToElem e n a t (S1 q (Rec0 (CData (Maybe z)))) where
gToElem _ _ (M1 (K1 (CData Nothing))) = id
gToElem _ c (M1 (K1 (CData (Just z)))) = addCData c z
instance ToXText t z => GToElem e n a t (S1 q (Rec0 (CData [z]))) where
gToElem _ c (M1 (K1 (CData zs))) = appRList (addCData c <$> zs)
instance ToElem e z => GToElem e n a t (S1 q (Rec0 z)) where
gToElem _ c (M1 (K1 z)) = addElemChild c z
instance ToElem e z => GToElem e n a t (S1 q (Rec0 (Maybe z))) where
gToElem _ _ (M1 (K1 Nothing)) = id
gToElem _ c (M1 (K1 (Just z))) = addElemChild c z
instance ToElem e z => GToElem e n a t (S1 q (Rec0 [z])) where
gToElem _ c (M1 (K1 zs)) = appRList (addElemChild c <$> zs)
setElemName :: (KnownSymbol name)
=> OptionsElement n a
-> Compose e n a t c
-> Proxy name
-> (c -> c)
setElemName o c p = cName c (optConstructorElemName o (symt p))
setCreatedElemName :: (KnownSymbol name)
=> OptionsElement n a
-> Compose e n a t c
-> Proxy name
-> e
-> (c -> c)
setCreatedElemName o c p = const . setElemName o c p . cThaw c
setAttr :: (KnownSymbol name, ToXText t v)
=> OptionsElement n a
-> Compose e n a t c
-> Proxy name
-> v
-> (c -> c)
setAttr o c p v = cAttr c (optAttrName o (symt p)) (toXText v)
addTextChild :: (KnownSymbol name, ToXText t v)
=> OptionsElement n a
-> Compose e n a t c
-> Proxy name
-> v
-> (c -> c)
addTextChild o c p v = cChild c
( cFreeze c
$ cContent c (toXText v)
$ cName c (optSelectorElemName o (symt p))
$ cEmpty c )
addContent :: ToXText t v => Compose e n a t c -> v -> (c -> c)
addContent c v =
let text = toXText v
in if cNull c text
then id
else cContent c (toXText v)
addCData :: ToXText t v => Compose e n a t c -> v -> (c -> c)
addCData c v = cCData c (toXText v)
appRList :: [c -> c] -> (c -> c)
appRList fs = foldl' (.) id (reverse fs)
addElemChild :: ToElem e z => Compose e n a t c -> z -> (c -> c)
addElemChild c z = cChild c (toElem z)