module Operations.ToJson (ToJson(..)) where

import SyntaxTrees.Json (JsExpression(..))
import SyntaxTrees.Xml  (XmlExpression(..))
import SyntaxTrees.Yaml (YamlExpression(..))
import SyntaxTrees.Toml  (TomlExpression(..))
import Parsers.Json (json)
import Parsers.String (spacing)
import Parser (runParser)
import ParserCombinators (IsMatch(..), (<|>), (|*), maybeWithin)

import qualified Data.Map as Map
import Data.Map (Map, elems)
import Data.Either (fromRight)


class ToJson a where
  toJson :: a -> JsExpression


instance {-# OVERLAPPABLE #-} ToJson JsExpression where
  toJson :: JsExpression -> JsExpression
toJson = JsExpression -> JsExpression
forall a. a -> a
id

instance ToJson XmlExpression where

  toJson :: XmlExpression -> JsExpression
toJson XmlExpression { $sel:tagName:XmlExpression :: XmlExpression -> String
tagName = String
tag, $sel:expressions:XmlExpression :: XmlExpression -> [XmlExpression]
expressions = [XmlExpression]
exprs, Map String String
$sel:fields:XmlExpression :: XmlExpression -> Map String String
fields :: Map String String
.. }
    | String
tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"literal"  = JsExpression -> Either ParseError JsExpression -> JsExpression
forall b a. b -> Either a b -> b
fromRight JsExpression
JsNull (Either ParseError JsExpression -> JsExpression)
-> (Map String String -> Either ParseError JsExpression)
-> Map String String
-> JsExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser JsExpression -> String -> Either ParseError JsExpression
forall a. Parser a -> String -> Either ParseError a
runParser Parser JsExpression
literalParser (String -> Either ParseError JsExpression)
-> (Map String String -> String)
-> Map String String
-> Either ParseError JsExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              [String] -> String
forall a. [a] -> a
head ([String] -> String)
-> (Map String String -> [String]) -> Map String String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String String -> [String]
forall k a. Map k a -> [a]
elems (Map String String -> JsExpression)
-> Map String String -> JsExpression
forall a b. (a -> b) -> a -> b
$ Map String String
fields
    | String
tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"array"    = [JsExpression] -> JsExpression
JsArray ([JsExpression] -> JsExpression) -> [JsExpression] -> JsExpression
forall a b. (a -> b) -> a -> b
$ XmlExpression -> JsExpression
childExprToJson (XmlExpression -> JsExpression)
-> [XmlExpression] -> [JsExpression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XmlExpression]
exprs
    | String
tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"object"   = Map String JsExpression -> JsExpression
JsObject (Map String JsExpression -> JsExpression)
-> ([(String, JsExpression)] -> Map String JsExpression)
-> [(String, JsExpression)]
-> JsExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, JsExpression)] -> Map String JsExpression
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, JsExpression)] -> JsExpression)
-> [(String, JsExpression)] -> JsExpression
forall a b. (a -> b) -> a -> b
$ (\XmlExpression
x -> (XmlExpression -> String
tagName XmlExpression
x, XmlExpression -> JsExpression
childExprToJson XmlExpression
x)) (XmlExpression -> (String, JsExpression))
-> [XmlExpression] -> [(String, JsExpression)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                        [XmlExpression]
exprs
    | Bool
otherwise          = JsExpression
JsNull   where

        literalParser :: Parser JsExpression
literalParser = Parser JsExpression
json Parser JsExpression -> Parser JsExpression -> Parser JsExpression
forall a. Parser a -> Parser a -> Parser a
<|> (String -> JsExpression
JsString (String -> JsExpression) -> Parser String -> Parser JsExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
spacing (Char -> Parser Char
forall a. IsMatch a => a -> Parser a
isNot Char
'<' Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*))

        childExprToJson :: XmlExpression -> JsExpression
childExprToJson = XmlExpression -> JsExpression
forall a. ToJson a => a -> JsExpression
toJson (XmlExpression -> JsExpression)
-> (XmlExpression -> XmlExpression)
-> XmlExpression
-> JsExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlExpression] -> XmlExpression
forall a. [a] -> a
head ([XmlExpression] -> XmlExpression)
-> (XmlExpression -> [XmlExpression])
-> XmlExpression
-> XmlExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XmlExpression -> [XmlExpression]
expressions)


instance ToJson YamlExpression where

  toJson :: YamlExpression -> JsExpression
toJson = \case
    YamlExpression
YamlNull              -> JsExpression
JsNull
    YamlInteger Integer
n         -> Double -> JsExpression
JsNumber (Double -> JsExpression) -> Double -> JsExpression
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
    YamlFloat Double
n           -> Double -> JsExpression
JsNumber Double
n
    YamlBool Bool
bool         -> Bool -> JsExpression
JsBool Bool
bool
    YamlString String
str        -> String -> JsExpression
JsString String
str
    YamlDate Day
date         -> String -> JsExpression
JsString (String -> JsExpression) -> String -> JsExpression
forall a b. (a -> b) -> a -> b
$ Day -> String
forall a. Show a => a -> String
show Day
date
    YamlTime TimeOfDay
time         -> String -> JsExpression
JsString (String -> JsExpression) -> String -> JsExpression
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> String
forall a. Show a => a -> String
show TimeOfDay
time
    YamlDateTime ZonedTime
dateTime -> String -> JsExpression
JsString (String -> JsExpression) -> String -> JsExpression
forall a b. (a -> b) -> a -> b
$ ZonedTime -> String
forall a. Show a => a -> String
show ZonedTime
dateTime
    YamlList CollectionType
_ [YamlExpression]
list       -> [JsExpression] -> JsExpression
JsArray ([JsExpression] -> JsExpression) -> [JsExpression] -> JsExpression
forall a b. (a -> b) -> a -> b
$ YamlExpression -> JsExpression
forall a. ToJson a => a -> JsExpression
toJson (YamlExpression -> JsExpression)
-> [YamlExpression] -> [JsExpression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [YamlExpression]
list
    YamlMap  CollectionType
_ Map String YamlExpression
mapping    -> Map String JsExpression -> JsExpression
JsObject (Map String JsExpression -> JsExpression)
-> Map String JsExpression -> JsExpression
forall a b. (a -> b) -> a -> b
$ YamlExpression -> JsExpression
forall a. ToJson a => a -> JsExpression
toJson (YamlExpression -> JsExpression)
-> Map String YamlExpression -> Map String JsExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String YamlExpression
mapping


instance ToJson TomlExpression where

  toJson :: TomlExpression -> JsExpression
toJson = \case
    TomlExpression
TomlNull              -> JsExpression
JsNull
    TomlInteger Integer
n         -> Double -> JsExpression
JsNumber (Double -> JsExpression) -> Double -> JsExpression
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
    TomlFloat Double
n           -> Double -> JsExpression
JsNumber Double
n
    TomlBool Bool
bool         -> Bool -> JsExpression
JsBool Bool
bool
    TomlString String
str        -> String -> JsExpression
JsString String
str
    TomlDate Day
date         -> String -> JsExpression
JsString (String -> JsExpression) -> String -> JsExpression
forall a b. (a -> b) -> a -> b
$ Day -> String
forall a. Show a => a -> String
show Day
date
    TomlTime TimeOfDay
time         -> String -> JsExpression
JsString (String -> JsExpression) -> String -> JsExpression
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> String
forall a. Show a => a -> String
show TimeOfDay
time
    TomlDateTime ZonedTime
dateTime -> String -> JsExpression
JsString (String -> JsExpression) -> String -> JsExpression
forall a b. (a -> b) -> a -> b
$ ZonedTime -> String
forall a. Show a => a -> String
show ZonedTime
dateTime
    TomlArray [TomlExpression]
list        -> [JsExpression] -> JsExpression
JsArray ([JsExpression] -> JsExpression) -> [JsExpression] -> JsExpression
forall a b. (a -> b) -> a -> b
$ TomlExpression -> JsExpression
forall a. ToJson a => a -> JsExpression
toJson (TomlExpression -> JsExpression)
-> [TomlExpression] -> [JsExpression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TomlExpression]
list
    TomlTable TableType
_ Map String TomlExpression
mapping   -> Map String JsExpression -> JsExpression
JsObject (Map String JsExpression -> JsExpression)
-> Map String JsExpression -> JsExpression
forall a b. (a -> b) -> a -> b
$ TomlExpression -> JsExpression
forall a. ToJson a => a -> JsExpression
toJson (TomlExpression -> JsExpression)
-> Map String TomlExpression -> Map String JsExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String TomlExpression
mapping



instance ToJson String where
  toJson :: String -> JsExpression
toJson = String -> JsExpression
JsString

instance ToJson Char where
  toJson :: Char -> JsExpression
toJson = String -> JsExpression
JsString (String -> JsExpression)
-> (Char -> String) -> Char -> JsExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance ToJson Int where
  toJson :: Int -> JsExpression
toJson = Double -> JsExpression
JsNumber (Double -> JsExpression) -> (Int -> Double) -> Int -> JsExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToJson Integer where
  toJson :: Integer -> JsExpression
toJson = Double -> JsExpression
JsNumber (Double -> JsExpression)
-> (Integer -> Double) -> Integer -> JsExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToJson Double where
  toJson :: Double -> JsExpression
toJson = Double -> JsExpression
JsNumber

instance ToJson Bool where
  toJson :: Bool -> JsExpression
toJson = Bool -> JsExpression
JsBool

instance ToJson a => ToJson [a] where
  toJson :: [a] -> JsExpression
toJson = [JsExpression] -> JsExpression
JsArray ([JsExpression] -> JsExpression)
-> ([a] -> [JsExpression]) -> [a] -> JsExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> JsExpression) -> [a] -> [JsExpression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> JsExpression
forall a. ToJson a => a -> JsExpression
toJson

instance ToJson a => ToJson (Map String a) where
  toJson :: Map String a -> JsExpression
toJson = Map String JsExpression -> JsExpression
JsObject (Map String JsExpression -> JsExpression)
-> (Map String a -> Map String JsExpression)
-> Map String a
-> JsExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> JsExpression) -> Map String a -> Map String JsExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> JsExpression
forall a. ToJson a => a -> JsExpression
toJson

instance ToJson a => ToJson (Maybe a) where
  toJson :: Maybe a -> JsExpression
toJson = JsExpression -> (a -> JsExpression) -> Maybe a -> JsExpression
forall b a. b -> (a -> b) -> Maybe a -> b
maybe JsExpression
JsNull a -> JsExpression
forall a. ToJson a => a -> JsExpression
toJson