{-# LANGUAGE UndecidableInstances #-}

module Operations.ToXml (ToXml(..)) where

import SyntaxTrees.Xml  (XmlExpression(..), literalExpression)
import SyntaxTrees.Json (JsExpression(..))
import Operations.ToJson (ToJson(..))

import qualified Data.Map as Map
import Data.Char (toLower)


class ToXml a where
  toXml :: a -> XmlExpression


instance {-# OVERLAPPABLE #-} ToJson a => ToXml a where
  toXml :: a -> XmlExpression
toXml = JsExpression -> XmlExpression
forall a. ToXml a => a -> XmlExpression
toXml (JsExpression -> XmlExpression)
-> (a -> JsExpression) -> a -> XmlExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> JsExpression
forall a. ToJson a => a -> JsExpression
toJson

instance ToXml XmlExpression where
  toXml :: XmlExpression -> XmlExpression
toXml = XmlExpression -> XmlExpression
forall a. a -> a
id


instance ToXml JsExpression where

  toXml :: JsExpression -> XmlExpression
toXml = \case
    JsExpression
JsNull       -> String -> XmlExpression
literalExpression String
"null"
    JsNumber Double
n   -> String -> XmlExpression
literalExpression (String -> XmlExpression) -> String -> XmlExpression
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
n
    JsBool Bool
bool  -> String -> XmlExpression
literalExpression (String -> XmlExpression) -> String -> XmlExpression
forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> String
forall a. Show a => a -> String
show Bool
bool
    JsString String
str -> String -> XmlExpression
literalExpression String
str

    JsArray [JsExpression]
arr  -> String -> Map String String -> [XmlExpression] -> XmlExpression
XmlExpression String
"array" Map String String
forall k a. Map k a
Map.empty (JsExpression -> XmlExpression
forall a. ToXml a => a -> XmlExpression
elemExpr (JsExpression -> XmlExpression)
-> [JsExpression] -> [XmlExpression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JsExpression]
arr) where

      elemExpr :: a -> XmlExpression
elemExpr a
element = XmlExpression :: String -> Map String String -> [XmlExpression] -> XmlExpression
XmlExpression { tagName :: String
tagName = String
"elem",
                                       fields :: Map String String
fields = Map String String
forall k a. Map k a
Map.empty,
                                       expressions :: [XmlExpression]
expressions = [a -> XmlExpression
forall a. ToXml a => a -> XmlExpression
toXml a
element] }

    JsObject Map String JsExpression
obj -> String -> Map String String -> [XmlExpression] -> XmlExpression
XmlExpression String
"object" Map String String
forall k a. Map k a
Map.empty ((String, JsExpression) -> XmlExpression
forall a. ToXml a => (String, a) -> XmlExpression
keyValueExpr ((String, JsExpression) -> XmlExpression)
-> [(String, JsExpression)] -> [XmlExpression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String JsExpression -> [(String, JsExpression)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String JsExpression
obj)  where

      keyValueExpr :: (String, a) -> XmlExpression
keyValueExpr (String
key, a
value) = XmlExpression :: String -> Map String String -> [XmlExpression] -> XmlExpression
XmlExpression { tagName :: String
tagName = String
key,
                                                  fields :: Map String String
fields = Map String String
forall k a. Map k a
Map.empty,
                                                  expressions :: [XmlExpression]
expressions = [a -> XmlExpression
forall a. ToXml a => a -> XmlExpression
toXml a
value] }