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