{-# LANGUAGE RankNTypes #-}

module Ondim.Extra.BindJSON
  ( valueExp,
    arrayExp,
    objectExp,
  )
where

import Data.Aeson
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.Scientific
import Ondim
import Ondim.Extra.Expansions (listExp, assocsExp)

valueExp :: Value -> NamespaceItem s
valueExp :: forall s. Value -> NamespaceItem s
valueExp = \case
  Object Object
o -> NamespaceMap s -> NamespaceItem s
forall m. NamespaceMap m -> NamespaceItem m
namespace (NamespaceMap s -> NamespaceItem s)
-> NamespaceMap s -> NamespaceItem s
forall a b. (a -> b) -> a -> b
$ Object -> NamespaceMap s
forall s. Object -> NamespaceMap s
objectExp Object
o
  Array Array
a -> NamespaceMap s -> NamespaceItem s
forall m. NamespaceMap m -> NamespaceItem m
namespace (NamespaceMap s -> NamespaceItem s)
-> NamespaceMap s -> NamespaceItem s
forall a b. (a -> b) -> a -> b
$ Array -> NamespaceMap s
forall s. Array -> NamespaceMap s
arrayExp Array
a
  String Text
s -> Text -> NamespaceItem s
forall m. HasCallStack => Text -> NamespaceItem m
textData Text
s
  Number Scientific
n -> Text -> NamespaceItem s
forall m. HasCallStack => Text -> NamespaceItem m
textData (Scientific -> Text
prettyNum Scientific
n)
  Bool Bool
True -> Text -> NamespaceItem s
forall m. HasCallStack => Text -> NamespaceItem m
textData Text
"true"
  Bool Bool
False -> Text -> NamespaceItem s
forall m. HasCallStack => Text -> NamespaceItem m
textData Text
"false"
  Value
Null -> Text -> NamespaceItem s
forall m. HasCallStack => Text -> NamespaceItem m
textData Text
"null"

arrayExp :: Array -> NamespaceMap s
arrayExp :: forall s. Array -> NamespaceMap s
arrayExp Array
arr = (Value -> NamespaceItem s) -> [Value] -> NamespaceMap s
forall a s. (a -> NamespaceItem s) -> [a] -> NamespaceMap s
listExp Value -> NamespaceItem s
forall s. Value -> NamespaceItem s
valueExp (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
arr)

objectExp ::
  Object ->
  NamespaceMap s
objectExp :: forall s. Object -> NamespaceMap s
objectExp Object
obj = (Value -> NamespaceItem s) -> [(Text, Value)] -> NamespaceMap s
forall v s. (v -> NamespaceItem s) -> [(Text, v)] -> NamespaceMap s
assocsExp Value -> NamespaceItem s
forall s. Value -> NamespaceItem s
valueExp (((Key, Value) -> (Text, Value))
-> [(Key, Value)] -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ((Key -> Text) -> (Key, Value) -> (Text, Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
K.toText) ([(Key, Value)] -> [(Text, Value)])
-> [(Key, Value)] -> [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
obj)

prettyNum :: Scientific -> Text
prettyNum :: Scientific -> Text
prettyNum Scientific
x = case Scientific -> Either Float Int
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
x of
  Left (Float
r :: Float) -> Float -> Text
forall b a. (Show a, IsString b) => a -> b
show Float
r
  Right (Int
i :: Int) -> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
i