{-# LANGUAGE CPP, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, FlexibleInstances, TypeFamilies, OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module HSP.ServerPartT () where
import Control.Monad (liftM)
import Data.Monoid ((<>))
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import HSP.XML
import HSP.XMLGenerator
import Happstack.Server (ServerPartT)
instance (Monad m) => XMLGen (ServerPartT m) where
type XMLType (ServerPartT m) = XML
type StringType (ServerPartT m) = TL.Text
newtype ChildType (ServerPartT m) = SChild { forall (m :: * -> *). ChildType (ServerPartT m) -> XML
unSChild :: XML }
newtype AttributeType (ServerPartT m) = SAttr { forall (m :: * -> *). AttributeType (ServerPartT m) -> Attribute
unSAttr :: Attribute }
genElement :: Name (StringType (ServerPartT m))
-> [XMLGenT (ServerPartT m) [AttributeType (ServerPartT m)]]
-> [XMLGenT (ServerPartT m) [ChildType (ServerPartT m)]]
-> XMLGenT (ServerPartT m) (XMLType (ServerPartT m))
genElement Name (StringType (ServerPartT m))
n [XMLGenT (ServerPartT m) [AttributeType (ServerPartT m)]]
attrs [XMLGenT (ServerPartT m) [ChildType (ServerPartT m)]]
children =
do [Attribute]
attribs <- forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). AttributeType (ServerPartT m) -> Attribute
unSAttr forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *) a. EmbedAsAttr m a => a -> GenAttributeList m
asAttr [XMLGenT (ServerPartT m) [AttributeType (ServerPartT m)]]
attrs
[XML]
childer <- ([XML] -> [XML]
flattenCDATA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). ChildType (ServerPartT m) -> XML
unSChild) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM`forall (m :: * -> *) c. EmbedAsChild m c => c -> GenChildList m
asChild [XMLGenT (ServerPartT m) [ChildType (ServerPartT m)]]
children
forall (m :: * -> *) a. Monad m => a -> m a
return (Name Text -> [Attribute] -> [XML] -> XML
Element
(forall n s. IsName n s => n -> Name s
toName Name (StringType (ServerPartT m))
n)
[Attribute]
attribs
[XML]
childer
)
xmlToChild :: XMLType (ServerPartT m) -> ChildType (ServerPartT m)
xmlToChild = forall (m :: * -> *). XML -> ChildType (ServerPartT m)
SChild
pcdataToChild :: StringType (ServerPartT m) -> ChildType (ServerPartT m)
pcdataToChild = forall (m :: * -> *). XMLGen m => XMLType m -> ChildType m
xmlToChild forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> XML
pcdata
flattenCDATA :: [XML] -> [XML]
flattenCDATA :: [XML] -> [XML]
flattenCDATA [XML]
cxml =
case [XML] -> [XML] -> [XML]
flP [XML]
cxml [] of
[] -> []
[CDATA Bool
_ Text
""] -> []
[XML]
xs -> [XML]
xs
where
flP :: [XML] -> [XML] -> [XML]
flP :: [XML] -> [XML] -> [XML]
flP [] [XML]
bs = forall a. [a] -> [a]
reverse [XML]
bs
flP [XML
x] [XML]
bs = forall a. [a] -> [a]
reverse (XML
xforall a. a -> [a] -> [a]
:[XML]
bs)
flP (XML
x:XML
y:[XML]
xs) [XML]
bs = case (XML
x,XML
y) of
(CDATA Bool
e1 Text
s1, CDATA Bool
e2 Text
s2) | Bool
e1 forall a. Eq a => a -> a -> Bool
== Bool
e2 -> [XML] -> [XML] -> [XML]
flP (Bool -> Text -> XML
CDATA Bool
e1 (Text
s1forall a. Semigroup a => a -> a -> a
<>Text
s2) forall a. a -> [a] -> [a]
: [XML]
xs) [XML]
bs
(XML, XML)
_ -> [XML] -> [XML] -> [XML]
flP (XML
yforall a. a -> [a] -> [a]
:[XML]
xs) (XML
xforall a. a -> [a] -> [a]
:[XML]
bs)
instance (Functor m, Monad m) => EmbedAsAttr (ServerPartT m) Attribute where
asAttr :: Attribute -> GenAttributeList (ServerPartT m)
asAttr = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Attribute -> AttributeType (ServerPartT m)
SAttr
instance (Functor m, Monad m, IsName n TL.Text) => EmbedAsAttr (ServerPartT m) (Attr n Char) where
asAttr :: Attr n Char -> GenAttributeList (ServerPartT m)
asAttr (n
n := Char
c) = forall (m :: * -> *) a. EmbedAsAttr m a => a -> GenAttributeList m
asAttr (n
n forall n a. n -> a -> Attr n a
:= [Char
c])
instance (Functor m, Monad m, IsName n TL.Text) => EmbedAsAttr (ServerPartT m) (Attr n String) where
asAttr :: Attr n [Char] -> GenAttributeList (ServerPartT m)
asAttr (n
n := [Char]
str) = forall (m :: * -> *) a. EmbedAsAttr m a => a -> GenAttributeList m
asAttr forall a b. (a -> b) -> a -> b
$ (Name Text, AttrValue) -> Attribute
MkAttr (forall n s. IsName n s => n -> Name s
toName n
n, Text -> AttrValue
pAttrVal forall a b. (a -> b) -> a -> b
$ [Char] -> Text
TL.pack [Char]
str)
instance (Functor m, Monad m, IsName n TL.Text) => EmbedAsAttr (ServerPartT m) (Attr n Bool) where
asAttr :: Attr n Bool -> GenAttributeList (ServerPartT m)
asAttr (n
n := Bool
True) = forall (m :: * -> *) a. EmbedAsAttr m a => a -> GenAttributeList m
asAttr forall a b. (a -> b) -> a -> b
$ (Name Text, AttrValue) -> Attribute
MkAttr (forall n s. IsName n s => n -> Name s
toName n
n, Text -> AttrValue
pAttrVal Text
"true")
asAttr (n
n := Bool
False) = forall (m :: * -> *) a. EmbedAsAttr m a => a -> GenAttributeList m
asAttr forall a b. (a -> b) -> a -> b
$ (Name Text, AttrValue) -> Attribute
MkAttr (forall n s. IsName n s => n -> Name s
toName n
n, Text -> AttrValue
pAttrVal Text
"false")
instance (Functor m, Monad m, IsName n TL.Text) => EmbedAsAttr (ServerPartT m) (Attr n Int) where
asAttr :: Attr n Int -> GenAttributeList (ServerPartT m)
asAttr (n
n := Int
i) = forall (m :: * -> *) a. EmbedAsAttr m a => a -> GenAttributeList m
asAttr forall a b. (a -> b) -> a -> b
$ (Name Text, AttrValue) -> Attribute
MkAttr (forall n s. IsName n s => n -> Name s
toName n
n, Text -> AttrValue
pAttrVal ([Char] -> Text
TL.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int
i))
instance (Functor m, Monad m, IsName n TL.Text) => (EmbedAsAttr (ServerPartT m) (Attr n TL.Text)) where
asAttr :: Attr n Text -> GenAttributeList (ServerPartT m)
asAttr (n
n := Text
a) = forall (m :: * -> *) a. EmbedAsAttr m a => a -> GenAttributeList m
asAttr forall a b. (a -> b) -> a -> b
$ (Name Text, AttrValue) -> Attribute
MkAttr (forall n s. IsName n s => n -> Name s
toName n
n, Text -> AttrValue
pAttrVal forall a b. (a -> b) -> a -> b
$ Text
a)
instance (Functor m, Monad m, IsName n TL.Text) => (EmbedAsAttr (ServerPartT m) (Attr n T.Text)) where
asAttr :: Attr n Text -> GenAttributeList (ServerPartT m)
asAttr (n
n := Text
a) = forall (m :: * -> *) a. EmbedAsAttr m a => a -> GenAttributeList m
asAttr forall a b. (a -> b) -> a -> b
$ (Name Text, AttrValue) -> Attribute
MkAttr (forall n s. IsName n s => n -> Name s
toName n
n, Text -> AttrValue
pAttrVal forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
a)
instance (Functor m, Monad m) => EmbedAsChild (ServerPartT m) Char where
asChild :: Char -> GenChildList (ServerPartT m)
asChild = forall (m :: * -> *) a. m a -> XMLGenT m a
XMLGenT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). XML -> ChildType (ServerPartT m)
SChild forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> XML
pcdata forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
TL.singleton
instance (Functor m, Monad m) => EmbedAsChild (ServerPartT m) String where
asChild :: [Char] -> GenChildList (ServerPartT m)
asChild = forall (m :: * -> *) a. m a -> XMLGenT m a
XMLGenT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). XML -> ChildType (ServerPartT m)
SChild forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> XML
pcdata forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
TL.pack
instance (Functor m, Monad m) => EmbedAsChild (ServerPartT m) Int where
asChild :: Int -> GenChildList (ServerPartT m)
asChild = forall (m :: * -> *) a. m a -> XMLGenT m a
XMLGenT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). XML -> ChildType (ServerPartT m)
SChild forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> XML
pcdata forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
TL.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show
instance (Functor m, Monad m) => EmbedAsChild (ServerPartT m) Integer where
asChild :: Integer -> GenChildList (ServerPartT m)
asChild = forall (m :: * -> *) a. m a -> XMLGenT m a
XMLGenT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). XML -> ChildType (ServerPartT m)
SChild forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> XML
pcdata forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
TL.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show
instance (Functor m, Monad m) => EmbedAsChild (ServerPartT m) XML where
asChild :: XML -> GenChildList (ServerPartT m)
asChild = forall (m :: * -> *) a. m a -> XMLGenT m a
XMLGenT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). XML -> ChildType (ServerPartT m)
SChild
instance Monad m => EmbedAsChild (ServerPartT m) () where
asChild :: () -> GenChildList (ServerPartT m)
asChild () = forall (m :: * -> *) a. Monad m => a -> m a
return []
instance (Functor m, Monad m) => (EmbedAsChild (ServerPartT m) TL.Text) where
asChild :: Text -> GenChildList (ServerPartT m)
asChild = forall (m :: * -> *) c. EmbedAsChild m c => c -> GenChildList m
asChild forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
TL.unpack
instance (Functor m, Monad m) => (EmbedAsChild (ServerPartT m) T.Text) where
asChild :: Text -> GenChildList (ServerPartT m)
asChild = forall (m :: * -> *) c. EmbedAsChild m c => c -> GenChildList m
asChild forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
instance (Functor m, Monad m) => AppendChild (ServerPartT m) XML where
appAll :: XML -> GenChildList (ServerPartT m) -> GenXML (ServerPartT m)
appAll XML
xml GenChildList (ServerPartT m)
children = do
[ChildType (ServerPartT m)]
chs <- GenChildList (ServerPartT m)
children
case XML
xml of
CDATA Bool
_ Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return XML
xml
Element Name Text
n [Attribute]
as [XML]
cs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Name Text -> [Attribute] -> [XML] -> XML
Element Name Text
n [Attribute]
as ([XML]
cs forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). ChildType (ServerPartT m) -> XML
unSChild [ChildType (ServerPartT m)]
chs))
instance (Functor m, Monad m) => SetAttr (ServerPartT m) XML where
setAll :: XML -> GenAttributeList (ServerPartT m) -> GenXML (ServerPartT m)
setAll XML
xml GenAttributeList (ServerPartT m)
hats = do
[AttributeType (ServerPartT m)]
attrs <- GenAttributeList (ServerPartT m)
hats
case XML
xml of
CDATA Bool
_ Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return XML
xml
Element Name Text
n [Attribute]
as [XML]
cs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Name Text -> [Attribute] -> [XML] -> XML
Element Name Text
n (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [Attribute]
as (forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). AttributeType (ServerPartT m) -> Attribute
unSAttr [AttributeType (ServerPartT m)]
attrs)) [XML]
cs
instance (Functor m, Monad m) => XMLGenerator (ServerPartT m)