module Buffet.Document.TemplateContext
  ( get
  ) where

import qualified Buffet.Document.TemplateBuffet as TemplateBuffet
import qualified Buffet.Ir.Ir as Ir
import qualified Data.Aeson as Aeson
import qualified Data.Bifunctor as Bifunctor
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as T
import Prelude (($), (.), fmap)

get :: Ir.Buffet -> Aeson.Value
get :: Buffet -> Value
get = Value -> Value
escapeKeysForMustache (Value -> Value) -> (Buffet -> Value) -> Buffet -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffet -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Buffet -> Value) -> (Buffet -> Buffet) -> Buffet -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffet -> Buffet
TemplateBuffet.get

escapeKeysForMustache :: Aeson.Value -> Aeson.Value
escapeKeysForMustache :: Value -> Value
escapeKeysForMustache = (Text -> Text) -> Value -> Value
mapKeys ((Text -> Text) -> Value -> Value)
-> (Text -> Text) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace (String -> Text
T.pack String
".") (String -> Text
T.pack String
"_")

mapKeys :: (T.Text -> T.Text) -> Aeson.Value -> Aeson.Value
mapKeys :: (Text -> Text) -> Value -> Value
mapKeys Text -> Text
function (Aeson.Array Array
array) =
  Array -> Value
Aeson.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Value) -> Array -> Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> Value -> Value
mapKeys Text -> Text
function) Array
array
mapKeys Text -> Text
function (Aeson.Object Object
object) =
  Object -> Value
Aeson.Object (Object -> Value)
-> ([(Text, Value)] -> Object) -> [(Text, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, Value)] -> Object)
-> ([(Text, Value)] -> [(Text, Value)])
-> [(Text, Value)]
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Value) -> (Text, Value))
-> [(Text, Value)] -> [(Text, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text)
-> (Value -> Value) -> (Text, Value) -> (Text, Value)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
Bifunctor.bimap Text -> Text
function ((Value -> Value) -> (Text, Value) -> (Text, Value))
-> (Value -> Value) -> (Text, Value) -> (Text, Value)
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> Value -> Value
mapKeys Text -> Text
function) ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$
  Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList Object
object
mapKeys Text -> Text
_ Value
value = Value
value