{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Language.Jsonnet.Std.Lib
  ( std,
    objectHasEx,
  )
where

import Control.Monad.Except
import Control.Monad.State
import Data.Aeson (FromJSON (..))
import qualified Data.Aeson as JSON
import qualified Data.ByteString as B
import Data.Foldable (foldrM)
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as H
import Data.List (sort)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Word
import Language.Jsonnet.Common
import Language.Jsonnet.Core (Fun (Fun), KeyValue (..))
import Language.Jsonnet.Error
import Language.Jsonnet.Eval.Monad
import Language.Jsonnet.Parser.SrcSpan
import Language.Jsonnet.Value
import System.FilePath.Posix (takeFileName)
import Text.Megaparsec.Pos (SourcePos (..))
import Text.PrettyPrint.ANSI.Leijen (text)
import Unbound.Generics.LocallyNameless
import Prelude hiding (length)
import qualified Prelude as P (length)

-- | The native subset of Jsonnet standard library
std :: Value
std :: Value
std = HashMap Text (Hideable Thunk) -> Value
VObj (HashMap Text (Hideable Thunk) -> Value)
-> HashMap Text (Hideable Thunk) -> Value
forall a b. (a -> b) -> a -> b
$ [(Text, Hideable Thunk)] -> HashMap Text (Hideable Thunk)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ([(Text, Hideable Thunk)] -> HashMap Text (Hideable Thunk))
-> [(Text, Hideable Thunk)] -> HashMap Text (Hideable Thunk)
forall a b. (a -> b) -> a -> b
$ ((Text, Eval Value) -> (Text, Hideable Thunk))
-> [(Text, Eval Value)] -> [(Text, Hideable Thunk)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Eval Value) -> (Text, Hideable Thunk)
forall {a}. (a, Eval Value) -> (a, Hideable Thunk)
f [(Text, Eval Value)]
xs
  where
    f :: (a, Eval Value) -> (a, Hideable Thunk)
f = \(a
k, Eval Value
v) -> (a
k, Eval Value -> Thunk
TV (Eval Value -> Thunk) -> Hideable (Eval Value) -> Hideable Thunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval Value -> Visibility -> Hideable (Eval Value)
forall a. a -> Visibility -> Hideable a
Hideable Eval Value
v Visibility
Hidden)
    xs :: [(Text, Eval Value)]
xs =
      (Text
"thisFile", Maybe FilePath -> Value
forall a. HasValue a => a -> Value
inj (Maybe FilePath -> Value) -> Eval (Maybe FilePath) -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval (Maybe FilePath)
thisFile) (Text, Eval Value) -> [(Text, Eval Value)] -> [(Text, Eval Value)]
forall a. a -> [a] -> [a]
:
      ((Text, Value) -> (Text, Eval Value))
-> [(Text, Value)] -> [(Text, Eval Value)]
forall a b. (a -> b) -> [a] -> [b]
map
        (\(Text
k, Value
v) -> (Text
k, Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v))
        [ (Text
"type", (Value -> Text) -> Value
forall a. HasValue a => a -> Value
inj Value -> Text
valueType),
          (Text
"primitiveEquals", (Value -> Value -> Eval Bool) -> Value
forall a. HasValue a => a -> Value
inj Value -> Value -> Eval Bool
primitiveEquals),
          (Text
"equals", (Value -> Value -> Eval Bool) -> Value
forall a. HasValue a => a -> Value
inj Value -> Value -> Eval Bool
equals),
          (Text
"length", (Value -> Eval Int) -> Value
forall a. HasValue a => a -> Value
inj Value -> Eval Int
length),
          (Text
"pow", (Double -> Int -> Double) -> Value
forall a. HasValue a => a -> Value
inj (forall a b. (Fractional a, Integral b) => a -> b -> a
(^^) @Double @Int)),
          (Text
"exp", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (forall a. Floating a => a -> a
exp @Double)),
          (Text
"log", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (forall a. Floating a => a -> a
log @Double)),
          (Text
"exponent", (Double -> Int) -> Value
forall a. HasValue a => a -> Value
inj (forall a. RealFloat a => a -> Int
exponent @Double)),
          (Text
"mantissa", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (forall a. RealFloat a => a -> a
significand @Double)),
          (Text
"floor", (Double -> Integer) -> Value
forall a. HasValue a => a -> Value
inj (forall a b. (RealFrac a, Integral b) => a -> b
floor @Double @Integer)),
          (Text
"ceil", (Double -> Integer) -> Value
forall a. HasValue a => a -> Value
inj (forall a b. (RealFrac a, Integral b) => a -> b
ceiling @Double @Integer)),
          (Text
"sqrt", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (forall a. Floating a => a -> a
sqrt @Double)),
          (Text
"sin", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (forall a. Floating a => a -> a
sin @Double)),
          (Text
"cos", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (forall a. Floating a => a -> a
cos @Double)),
          (Text
"tan", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (forall a. Floating a => a -> a
tan @Double)),
          (Text
"asin", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (forall a. Floating a => a -> a
asin @Double)),
          (Text
"acos", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (forall a. Floating a => a -> a
acos @Double)),
          (Text
"atan", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (forall a. Floating a => a -> a
atan @Double)),
          (Text
"modulo", (Integer -> Integer -> Integer) -> Value
forall a. HasValue a => a -> Value
inj (forall a. Integral a => a -> a -> a
mod @Integer)),
          (Text
"codepoint", (Text -> Int) -> Value
forall a. HasValue a => a -> Value
inj (Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char -> Int) -> (Text -> Char) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Char
T.head)),
          (Text
"char", (Int -> Text) -> Value
forall a. HasValue a => a -> Value
inj (Char -> Text
T.singleton (Char -> Text) -> (Int -> Char) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum)),
          (Text
"encodeUTF8", (Text -> [Word8]) -> Value
forall a. HasValue a => a -> Value
inj (ByteString -> [Word8]
B.unpack (ByteString -> [Word8]) -> (Text -> ByteString) -> Text -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 :: Text -> [Word8])),
          (Text
"decodeUTF8", ([Word8] -> Text) -> Value
forall a. HasValue a => a -> Value
inj (ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ([Word8] -> ByteString) -> [Word8] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack :: [Word8] -> Text)),
          (Text
"makeArray", (Int -> (Int -> Eval Value) -> Eval [Value]) -> Value
forall a. HasValue a => a -> Value
inj Int -> (Int -> Eval Value) -> Eval [Value]
makeArray),
          (Text
"filter", ((Value -> Eval Bool) -> [Value] -> Eval [Value]) -> Value
forall a. HasValue a => a -> Value
inj (forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM @Eval @Value)),
          (Text
"objectHasEx", (HashMap Text (Hideable Thunk) -> Text -> Bool -> Bool) -> Value
forall a. HasValue a => a -> Value
inj HashMap Text (Hideable Thunk) -> Text -> Bool -> Bool
objectHasEx),
          (Text
"objectFieldsEx", (HashMap Text (Hideable Thunk) -> Bool -> [Text]) -> Value
forall a. HasValue a => a -> Value
inj HashMap Text (Hideable Thunk) -> Bool -> [Text]
objectFieldsEx),
          (Text
"parseJson", (ByteString -> Maybe Value) -> Value
forall a. HasValue a => a -> Value
inj (forall a. FromJSON a => ByteString -> Maybe a
JSON.decodeStrict @Value))
        ]

primitiveEquals :: Value -> Value -> Eval Bool
primitiveEquals :: Value -> Value -> Eval Bool
primitiveEquals Value
VNull Value
VNull = Bool -> Eval Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
primitiveEquals (VBool Bool
a) (VBool Bool
b) = Bool -> Eval Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b)
primitiveEquals (VStr Text
a) (VStr Text
b) = Bool -> Eval Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b)
primitiveEquals (VNum Scientific
a) (VNum Scientific
b) = Bool -> Eval Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific
a Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
b)
primitiveEquals Value
a Value
b =
  EvalError -> Eval Bool
forall a. EvalError -> Eval a
throwE
    ( Doc -> EvalError
StdError (Doc -> EvalError) -> Doc -> EvalError
forall a b. (a -> b) -> a -> b
$
        FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$
          Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$
            Text
"primitiveEquals operates on primitive types "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
valueType Value
a
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
valueType Value
b
    )

equals :: Value -> Value -> Eval Bool
equals :: Value -> Value -> Eval Bool
equals as :: Value
as@(VArr Array
a) bs :: Value
bs@(VArr Array
b)
  | Array -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length Array
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length Array
b = do
    [Value]
as' <- Value -> Eval [Value]
forall a. HasValue a => Value -> Eval a
proj Value
as
    [Value]
bs' <- Value -> Eval [Value]
forall a. HasValue a => Value -> Eval a
proj Value
bs
    ((Value, Value) -> Eval Bool) -> [(Value, Value)] -> Eval Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM ((Value -> Value -> Eval Bool) -> (Value, Value) -> Eval Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Value -> Value -> Eval Bool
equals) ([Value] -> [Value] -> [(Value, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Value]
as' [Value]
bs')
  | Array -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length Array
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Array -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length Array
b = Bool -> Eval Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
equals (VObj HashMap Text (Hideable Thunk)
a) (VObj HashMap Text (Hideable Thunk)
b) = do
  let fields :: [Text]
fields = HashMap Text (Hideable Thunk) -> Bool -> [Text]
objectFieldsEx HashMap Text (Hideable Thunk)
a Bool
False
  if [Text]
fields [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= HashMap Text (Hideable Thunk) -> Bool -> [Text]
objectFieldsEx HashMap Text (Hideable Thunk)
b Bool
False
    then Bool -> Eval Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    else (Text -> Eval Bool) -> [Text] -> Eval Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM Text -> Eval Bool
objectFieldEquals [Text]
fields
  where
    objectFieldEquals :: Text -> Eval Bool
objectFieldEquals Text
field = do
      Value
a' <- Thunk -> Eval Value
force (Hideable Thunk -> Thunk
forall a. Hideable a -> a
value (Hideable Thunk -> Thunk) -> Hideable Thunk -> Thunk
forall a b. (a -> b) -> a -> b
$ HashMap Text (Hideable Thunk)
a HashMap Text (Hideable Thunk) -> Text -> Hideable Thunk
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
H.! Text
field)
      Value
b' <- Thunk -> Eval Value
force (Hideable Thunk -> Thunk
forall a. Hideable a -> a
value (Hideable Thunk -> Thunk) -> Hideable Thunk -> Thunk
forall a b. (a -> b) -> a -> b
$ HashMap Text (Hideable Thunk)
b HashMap Text (Hideable Thunk) -> Text -> Hideable Thunk
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
H.! Text
field)
      Value -> Value -> Eval Bool
equals Value
a' Value
b'
equals Value
a Value
b
  | Value -> Text
valueType Value
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Text
valueType Value
b = Value -> Value -> Eval Bool
primitiveEquals Value
a Value
b
equals Value
_ Value
_ = Bool -> Eval Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

objectFieldsEx :: Object -> Bool -> [Text]
objectFieldsEx :: HashMap Text (Hideable Thunk) -> Bool -> [Text]
objectFieldsEx HashMap Text (Hideable Thunk)
o Bool
True = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort (HashMap Text (Hideable Thunk) -> [Text]
forall k v. HashMap k v -> [k]
H.keys HashMap Text (Hideable Thunk)
o) -- all fields
objectFieldsEx HashMap Text (Hideable Thunk)
o Bool
False = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ HashMap Text (Hideable Thunk) -> [Text]
forall k v. HashMap k v -> [k]
H.keys (HashMap Text (Hideable Thunk) -> [Text])
-> HashMap Text (Hideable Thunk) -> [Text]
forall a b. (a -> b) -> a -> b
$ (Hideable Thunk -> Bool)
-> HashMap Text (Hideable Thunk) -> HashMap Text (Hideable Thunk)
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
H.filter (Bool -> Bool
not (Bool -> Bool)
-> (Hideable Thunk -> Bool) -> Hideable Thunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hideable Thunk -> Bool
forall a. HasVisibility a => a -> Bool
hidden) HashMap Text (Hideable Thunk)
o -- only visible (incl. forced)

objectHasEx :: Object -> Text -> Bool -> Bool
objectHasEx :: HashMap Text (Hideable Thunk) -> Text -> Bool -> Bool
objectHasEx HashMap Text (Hideable Thunk)
o Text
f Bool
all = Text
f Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` HashMap Text (Hideable Thunk) -> Bool -> [Text]
objectFieldsEx HashMap Text (Hideable Thunk)
o Bool
all

length :: Value -> Eval Int
length :: Value -> Eval Int
length = \case
  VStr Text
s -> Int -> Eval Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Eval Int) -> Int -> Eval Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
s
  VArr Array
a -> Int -> Eval Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Eval Int) -> Int -> Eval Int
forall a b. (a -> b) -> a -> b
$ Array -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length Array
a
  VObj HashMap Text (Hideable Thunk)
o -> Int -> Eval Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Eval Int) -> Int -> Eval Int
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length (HashMap Text (Hideable Thunk) -> [Text]
forall k v. HashMap k v -> [k]
H.keys HashMap Text (Hideable Thunk)
o)
  VClos (Fun Bind (Rec [Param Core]) Core
f) Env
_ -> do
    (Rec [Param Core]
ps, Core
_) <- Bind (Rec [Param Core]) Core -> Eval (Rec [Param Core], Core)
forall p t (m :: * -> *).
(Alpha p, Alpha t, Fresh m) =>
Bind p t -> m (p, t)
unbind Bind (Rec [Param Core]) Core
f
    Int -> Eval Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Eval Int) -> Int -> Eval Int
forall a b. (a -> b) -> a -> b
$ [Param Core] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length (Rec [Param Core] -> [Param Core]
forall p. Alpha p => Rec p -> p
unrec Rec [Param Core]
ps)
  Value
v ->
    EvalError -> Eval Int
forall a. EvalError -> Eval a
throwE
      ( Doc -> EvalError
StdError (Doc -> EvalError) -> Doc -> EvalError
forall a b. (a -> b) -> a -> b
$
          FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$
            Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$
              Text
"length operates on strings, objects, functions and arrays, got "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
valueType Value
v
      )

makeArray :: Int -> (Int -> Eval Value) -> Eval [Value]
makeArray :: Int -> (Int -> Eval Value) -> Eval [Value]
makeArray Int
n Int -> Eval Value
f = (Int -> Eval Value) -> [Int] -> Eval [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Int -> Eval Value
f [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

-- hacky way of returning the current file
thisFile :: Eval (Maybe FilePath)
thisFile :: Eval (Maybe FilePath)
thisFile = Maybe SrcSpan -> Maybe FilePath
f (Maybe SrcSpan -> Maybe FilePath)
-> Eval (Maybe SrcSpan) -> Eval (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> Maybe SrcSpan) -> Eval (Maybe SrcSpan)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> Maybe SrcSpan
currentPos
  where
    f :: Maybe SrcSpan -> Maybe FilePath
f = (SrcSpan -> FilePath) -> Maybe SrcSpan -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath
takeFileName (FilePath -> FilePath)
-> (SrcSpan -> FilePath) -> SrcSpan -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> FilePath
sourceName (SourcePos -> FilePath)
-> (SrcSpan -> SourcePos) -> SrcSpan -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SourcePos
spanBegin)

allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
allM :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM a -> m Bool
p = (a -> Bool -> m Bool) -> Bool -> [a] -> m Bool
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM (\a
a Bool
b -> (Bool -> Bool -> Bool
&& Bool
b) (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m Bool
p a
a) Bool
True

instance FromJSON Value where
  parseJSON :: Value -> Parser Value
parseJSON = \case
    Value
JSON.Null -> Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
VNull
    JSON.Bool Bool
b -> Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
VBool Bool
b
    JSON.Number Scientific
n -> Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
VNum Scientific
n
    JSON.String Text
s -> Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
VStr Text
s
    JSON.Array Array
a -> Array -> Value
VArr (Array -> Value) -> Parser Array -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Thunk) -> Array -> Parser Array
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Value -> Thunk) -> Parser Value -> Parser Thunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Thunk
mkThunk' (Parser Value -> Parser Thunk)
-> (Value -> Parser Value) -> Value -> Parser Thunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Value
forall a. FromJSON a => Value -> Parser a
parseJSON) Array
a
    JSON.Object Object
o -> HashMap Text (Hideable Thunk) -> Value
VObj (HashMap Text (Hideable Thunk) -> Value)
-> (HashMap Text Value -> HashMap Text (Hideable Thunk))
-> HashMap Text Value
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Value -> HashMap Text (Hideable Thunk)
f (HashMap Text Value -> Value)
-> Parser (HashMap Text Value) -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Value) -> Object -> Parser (HashMap Text Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser Value
forall a. FromJSON a => Value -> Parser a
parseJSON Object
o
    where
      f :: HashMap Text Value -> Object
      f :: HashMap Text Value -> HashMap Text (Hideable Thunk)
f HashMap Text Value
o =
        [(Text, Hideable Thunk)] -> HashMap Text (Hideable Thunk)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
          [ (Text -> Thunk -> (Text, Hideable Thunk)
forall {a} {a}. a -> a -> (a, Hideable a)
mkField Text
k (Value -> Thunk
mkThunk' Value
v))
            | (Text
k, Value
v) <- HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
H.toList HashMap Text Value
o
          ]
      mkField :: a -> a -> (a, Hideable a)
mkField a
k a
v = (a
k, a -> Visibility -> Hideable a
forall a. a -> Visibility -> Hideable a
Hideable a
v Visibility
Visible)