module Bookhound.Format.Operations.ToJson (ToJson(..)) where

import Bookhound.Parser            (runParser)
import Bookhound.ParserCombinators (IsMatch (..), maybeWithin, (<|>), (|*))
import Bookhound.Parsers.String    (spacing)

import Bookhound.Format.Parsers.Json      (json)
import Bookhound.Format.SyntaxTrees.Json  (JsonExpression (..))
import Bookhound.Format.SyntaxTrees.Toml  (TomlExpression (..))
import Bookhound.Format.SyntaxTrees.Xml   (XmlExpression (..))
import Bookhound.Format.SyntaxTrees.Yaml  (YamlExpression (..))

import Data.Either (fromRight)
import Data.Text   (pack)

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


class ToJson a where
  toJson :: a -> JsonExpression


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

instance ToJson XmlExpression where

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

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

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


instance ToJson YamlExpression where

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


instance ToJson TomlExpression where

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



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

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

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

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

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

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

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

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

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