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  (JsExpression (..))
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 -> 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 -> Input -> Either ParseError JsExpression
forall a. Parser a -> Input -> Either ParseError a
runParser Parser JsExpression
literalParser (Input -> Either ParseError JsExpression)
-> (Map String String -> Input)
-> Map String String
-> Either ParseError JsExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> Input
pack (String -> Input)
-> (Map String String -> String) -> Map String String -> Input
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