{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
module Common.ToXml where
import Common.AS_Annotation
import Common.Data
import Common.DocUtils
import Common.GlobalAnnotations
import Common.Id
import Common.Result
import Text.XML.Light
import Data.Data
import Data.Either
mkAttr :: String -> String -> Attr
mkAttr :: String -> String -> Attr
mkAttr = QName -> String -> Attr
Attr (QName -> String -> Attr)
-> (String -> QName) -> String -> String -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QName
unqual
mkText :: String -> Content
mkText :: String -> Content
mkText s :: String
s = CData -> Content
Text (CData -> Content) -> CData -> Content
forall a b. (a -> b) -> a -> b
$ CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText String
s Maybe Line
forall a. Maybe a
Nothing
prettyElem :: Pretty a => String -> GlobalAnnos -> a -> Element
prettyElem :: String -> GlobalAnnos -> a -> Element
prettyElem name :: String
name ga :: GlobalAnnos
ga a :: a
a = String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
name (String -> Element) -> String -> Element
forall a b. (a -> b) -> a -> b
$ GlobalAnnos -> a -> ShowS
forall a. Pretty a => GlobalAnnos -> a -> ShowS
showGlobalDoc GlobalAnnos
ga a
a ""
rangeAttrsF :: ([Pos] -> String) -> Range -> [Attr]
rangeAttrsF :: ([Pos] -> String) -> Range -> [Attr]
rangeAttrsF f :: [Pos] -> String
f rg :: Range
rg = case Range -> [Pos]
rangeToList Range
rg of
[] -> []
ps :: [Pos]
ps -> [String -> String -> Attr
mkAttr "range" (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ [Pos] -> String
f [Pos]
ps]
rangeAttrs :: Range -> [Attr]
rangeAttrs :: Range -> [Attr]
rangeAttrs = ([Pos] -> String) -> Range -> [Attr]
rangeAttrsF (([Pos] -> String) -> Range -> [Attr])
-> ([Pos] -> String) -> Range -> [Attr]
forall a b. (a -> b) -> a -> b
$ Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> ([Pos] -> Doc) -> [Pos] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pos] -> Doc
prettyRange
mkNameAttr :: String -> Attr
mkNameAttr :: String -> Attr
mkNameAttr = String -> String -> Attr
mkAttr "name"
mkPriorityAttr :: String -> Attr
mkPriorityAttr :: String -> Attr
mkPriorityAttr = String -> String -> Attr
mkAttr "priority"
annotationF :: (Range -> [Attr]) -> GlobalAnnos -> Annotation -> Element
annotationF :: (Range -> [Attr]) -> GlobalAnnos -> Annotation -> Element
annotationF f :: Range -> [Attr]
f ga :: GlobalAnnos
ga a :: Annotation
a = [Attr] -> Element -> Element
add_attrs (Range -> [Attr]
f (Range -> [Attr]) -> Range -> [Attr]
forall a b. (a -> b) -> a -> b
$ Annotation -> Range
forall a. GetRange a => a -> Range
getRangeSpan Annotation
a)
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> GlobalAnnos -> Annotation -> Element
forall a. Pretty a => String -> GlobalAnnos -> a -> Element
prettyElem "Annotation" GlobalAnnos
ga Annotation
a
annotations :: GlobalAnnos -> [Annotation] -> [Element]
annotations :: GlobalAnnos -> [Annotation] -> [Element]
annotations = (Annotation -> Element) -> [Annotation] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map ((Annotation -> Element) -> [Annotation] -> [Element])
-> (GlobalAnnos -> Annotation -> Element)
-> GlobalAnnos
-> [Annotation]
-> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range -> [Attr]) -> GlobalAnnos -> Annotation -> Element
annotationF Range -> [Attr]
rangeAttrs
subnodes :: String -> [Element] -> [Element]
subnodes :: String -> [Element] -> [Element]
subnodes name :: String
name elems :: [Element]
elems = if [Element] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
elems then [] else [String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
name [Element]
elems]
eitherToElem :: String -> [Either Attr Element] -> Element
eitherToElem :: String -> [Either Attr Element] -> Element
eitherToElem s :: String
s l :: [Either Attr Element]
l = let (as :: [Attr]
as, es :: [Element]
es) = [Either Attr Element] -> ([Attr], [Element])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either Attr Element]
l in
[Attr] -> Element -> Element
add_attrs [Attr]
as (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
s [Element]
es
myDataToXml :: MyData -> Element
myDataToXml :: MyData -> Element
myDataToXml d :: MyData
d =
let
listTag, listItemTag, dataItemTag :: String
listTag :: String
listTag = "List"
listItemTag :: String
listItemTag = "li"
dataItemTag :: String
dataItemTag = "d"
myDataToXmlWorker :: String -> MyData -> Element
myDataToXmlWorker :: String -> MyData -> Element
myDataToXmlWorker tag :: String
tag md :: MyData
md = case MyData
md of
Builtin _ v :: String
v -> String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
tag String
v
ListOrTuple _ values :: [MyData]
values ->
String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
tag ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (MyData -> Element) -> [MyData] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String -> MyData -> Element
myDataToXmlWorker String
listItemTag) [MyData]
values
Cons _ Nothing values :: [MyData]
values ->
String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
tag ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (MyData -> Element) -> [MyData] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String -> MyData -> Element
myDataToXmlWorker String
dataItemTag) [MyData]
values
Cons _ (Just fields :: [String]
fields) values :: [MyData]
values ->
String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
tag ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (String -> MyData -> Element) -> [String] -> [MyData] -> [Element]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> MyData -> Element
myDataToXmlWorker [String]
fields [MyData]
values
in
case MyData
d of
Cons constructor :: String
constructor _ _ -> String -> MyData -> Element
myDataToXmlWorker String
constructor MyData
d
ListOrTuple _ _ -> String -> MyData -> Element
myDataToXmlWorker String
listTag MyData
d
Builtin _ v :: String
v -> String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
dataItemTag String
v
class ToXml a where
asXml :: a -> Element
instance {-# OVERLAPPABLE #-} Data a => ToXml a where
asXml :: a -> Element
asXml = MyData -> Element
myDataToXml (MyData -> Element) -> (a -> MyData) -> a -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MyData -> MyData
normalizeMyDataForSerialization (MyData -> MyData) -> (a -> MyData) -> a -> MyData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MyData
forall a. Data a => a -> MyData
dataToMyData