{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}

-- |

module JL.Serializer where

import           Data.Aeson
import           Data.Aeson.KeyMap
import           Data.Scientific
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import           JL.Printer
import           JL.Types

coreToNumber :: Core -> Scientific
coreToNumber :: Core -> Scientific
coreToNumber =
  \case
    ConstantCore (NumberConstant Scientific
xs) -> Scientific
xs
    Core
x -> [Char] -> Scientific
forall a. HasCallStack => [Char] -> a
error ([Char]
"expected number but found: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (Core -> Text
prettyCore Core
x))

coreToString :: Core -> Text
coreToString :: Core -> Text
coreToString =
  \case
    ConstantCore (StringConstant Text
xs) -> Text
xs
    Core
x -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char]
"expected string but found: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (Core -> Text
prettyCore Core
x))

coreToArray :: Core -> V.Vector Core
coreToArray :: Core -> Vector Core
coreToArray =
  \case
    ArrayCore Vector Core
xs -> Vector Core
xs
    Core
x -> [Char] -> Vector Core
forall a. HasCallStack => [Char] -> a
error ([Char]
"expected array but found single value: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (Core -> Text
prettyCore Core
x))

coreToValue :: Core -> Value
coreToValue :: Core -> Value
coreToValue =
  \case
    ConstantCore Constant
v -> Constant -> Value
constantToValue Constant
v
    RecordCore HashMap Text Core
hm -> Object -> Value
Object (HashMap Text Value -> Object
forall v. HashMap Text v -> KeyMap v
fromHashMapText ((Core -> Value) -> HashMap Text Core -> HashMap Text Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Core -> Value
coreToValue HashMap Text Core
hm))
    ArrayCore Vector Core
a -> Array -> Value
Array ((Core -> Value) -> Vector Core -> Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Core -> Value
coreToValue Vector Core
a)
    Core
e -> [Char] -> Value
forall a. HasCallStack => [Char] -> a
error ([Char]
"code generated invalid JSON: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (Core -> Text
prettyCore Core
e))

constantToValue :: Constant -> Value
constantToValue :: Constant -> Value
constantToValue =
  \case
    Constant
NullConstant -> Value
Null
    BoolConstant Bool
b -> Bool -> Value
Bool Bool
b
    StringConstant Text
s -> Text -> Value
String Text
s
    NumberConstant Scientific
n -> Scientific -> Value
Number Scientific
n

valueToCore :: Value -> Core
valueToCore :: Value -> Core
valueToCore =
  \case
    Object Object
os -> HashMap Text Core -> Core
RecordCore ((Value -> Core) -> HashMap Text Value -> HashMap Text Core
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Core
valueToCore (Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
toHashMapText Object
os))
    Array Array
xs -> Vector Core -> Core
ArrayCore ((Value -> Core) -> Array -> Vector Core
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Core
valueToCore Array
xs)
    Number Scientific
n -> Constant -> Core
ConstantCore (Scientific -> Constant
NumberConstant Scientific
n)
    Bool Bool
n -> Constant -> Core
ConstantCore (Bool -> Constant
BoolConstant Bool
n)
    Value
Null -> Constant -> Core
ConstantCore Constant
NullConstant
    String Text
t -> Constant -> Core
ConstantCore (Text -> Constant
StringConstant Text
t)

valueToExpression :: Value -> Expression
valueToExpression :: Value -> Expression
valueToExpression =
  \case
    Object Object
os -> HashMap Text Expression -> Expression
RecordExpression ((Value -> Expression)
-> HashMap Text Value -> HashMap Text Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Expression
valueToExpression (Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
toHashMapText Object
os))
    Array Array
xs -> Vector Expression -> Expression
ArrayExpression ((Value -> Expression) -> Array -> Vector Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Expression
valueToExpression Array
xs)
    Number Scientific
n -> Constant -> Expression
ConstantExpression (Scientific -> Constant
NumberConstant Scientific
n)
    Bool Bool
n -> Constant -> Expression
ConstantExpression (Bool -> Constant
BoolConstant Bool
n)
    Value
Null -> Constant -> Expression
ConstantExpression Constant
NullConstant
    String Text
t -> Constant -> Expression
ConstantExpression (Text -> Constant
StringConstant Text
t)