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

-- |
-- Module                  : Language.Jsonnet.Std.Lib
-- Copyright               : (c) 2020-2021 Alexandre Moreno
-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0
-- Maintainer              : Alexandre Moreno <alexmorenocano@gmail.com>
-- Stability               : experimental
-- Portability             : non-portable
module Language.Jsonnet.Std.Lib
  ( std,
    objectHasEx,
  )
where

import Control.Lens (view)
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 qualified Data.List as L (intercalate, sort)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.Word
import Language.Jsonnet.Common
import Language.Jsonnet.Core
import Language.Jsonnet.Error
import Language.Jsonnet.Eval
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)

-- | Jsonnet standard library built-in methods
std :: Value
std :: Value
std = Object -> Value
VObj (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Text, VField)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ([(Text, VField)] -> Object) -> [(Text, VField)] -> Object
forall a b. (a -> b) -> a -> b
$ ((Text, Value) -> (Text, VField))
-> [(Text, Value)] -> [(Text, VField)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Value) -> (Text, VField)
f [(Text, Value)]
xs
  where
    f :: (Text, Value) -> (Text, VField)
f = \(Text
k, Value
v) -> (Text
k, Value -> Value -> Value -> Visibility -> VField
VField (Text -> Value
VStr Text
k) Value
v Value
v Visibility
Hidden)
    xs :: [(Text, Value)]
xs =
      [ (Text
"type", (Value -> Eval Text) -> Value
forall a. HasValue a => a -> Value
inj Value -> Eval Text
showTy),
        (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 ((Fractional Double, Integral Int) => Double -> Int -> Double
forall a b. (Fractional a, Integral b) => a -> b -> a
(^^) @Double @Int)),
        (Text
"exp", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (Floating Double => Double -> Double
forall a. Floating a => a -> a
exp @Double)),
        (Text
"log", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (Floating Double => Double -> Double
forall a. Floating a => a -> a
log @Double)),
        (Text
"exponent", (Double -> Int) -> Value
forall a. HasValue a => a -> Value
inj (RealFloat Double => Double -> Int
forall a. RealFloat a => a -> Int
exponent @Double)),
        (Text
"mantissa", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (RealFloat Double => Double -> Double
forall a. RealFloat a => a -> a
significand @Double)),
        (Text
"floor", (Double -> Integer) -> Value
forall a. HasValue a => a -> Value
inj (Integral Integer => Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor @Double @Integer)),
        (Text
"ceil", (Double -> Integer) -> Value
forall a. HasValue a => a -> Value
inj (Integral Integer => Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling @Double @Integer)),
        (Text
"sqrt", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (Floating Double => Double -> Double
forall a. Floating a => a -> a
sqrt @Double)),
        (Text
"sin", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (Floating Double => Double -> Double
forall a. Floating a => a -> a
sin @Double)),
        (Text
"cos", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (Floating Double => Double -> Double
forall a. Floating a => a -> a
cos @Double)),
        (Text
"tan", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (Floating Double => Double -> Double
forall a. Floating a => a -> a
tan @Double)),
        (Text
"asin", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (Floating Double => Double -> Double
forall a. Floating a => a -> a
asin @Double)),
        (Text
"acos", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (Floating Double => Double -> Double
forall a. Floating a => a -> a
acos @Double)),
        (Text
"atan", (Double -> Double) -> Value
forall a. HasValue a => a -> Value
inj (Floating Double => Double -> Double
forall a. Floating a => a -> a
atan @Double)),
        (Text
"modulo", (Integer -> Integer -> Integer) -> Value
forall a. HasValue a => a -> Value
inj (Integral Integer => Integer -> Integer -> Integer
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 (Vector Value)) -> Value
forall a. HasValue a => a -> Value
inj (Monad Eval => Int -> (Int -> Eval Value) -> Eval (Vector Value)
forall (m :: * -> *).
Monad m =>
Int -> (Int -> m Value) -> m (Vector Value)
makeArray @Eval)),
        (Text
"filter", ((Value -> Eval Bool) -> [Value] -> Eval [Value]) -> Value
forall a. HasValue a => a -> Value
inj (Applicative Eval => (Value -> Eval Bool) -> [Value] -> Eval [Value]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM @Eval @Value)),
        (Text
"join", (Value -> [Value] -> Eval Value) -> Value
forall a. HasValue a => a -> Value
inj Value -> [Value] -> Eval Value
intercalate),
        (Text
"objectHasEx", (Object -> Text -> Bool -> Bool) -> Value
forall a. HasValue a => a -> Value
inj Object -> Text -> Bool -> Bool
objectHasEx),
        (Text
"objectFieldsEx", (Object -> Bool -> [Text]) -> Value
forall a. HasValue a => a -> Value
inj Object -> Bool -> [Text]
objectFieldsEx),
        (Text
"parseJson", (ByteString -> Maybe Value) -> Value
forall a. HasValue a => a -> Value
inj (FromJSON Value => ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
JSON.decodeStrict @Value))
      ]

intercalate :: Value -> [Value] -> Eval Value
intercalate :: Value -> [Value] -> Eval Value
intercalate Value
sep [Value]
arr = Value -> [Value] -> Eval Value
go Value
sep ((Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter Value -> Bool
null [Value]
arr)
  where
    null :: Value -> Bool
null Value
VNull = Bool
False
    null Value
_ = Bool
True
    go :: Value -> [Value] -> Eval Value
go sep :: Value
sep@(VArr Vector Value
_) = ([Value] -> [[Value]] -> [Value]) -> Value -> [Value] -> Eval Value
forall (t :: * -> *) a a b.
(Traversable t, HasValue a, HasValue a, HasValue b) =>
(a -> t b -> a) -> Value -> t Value -> Eval Value
app ([Value] -> [[Value]] -> [Value]
forall a. [a] -> [[a]] -> [a]
L.intercalate @Value) Value
sep
    go sep :: Value
sep@(VStr Text
_) = (Text -> [Text] -> Text) -> Value -> [Value] -> Eval Value
forall (t :: * -> *) a a b.
(Traversable t, HasValue a, HasValue a, HasValue b) =>
(a -> t b -> a) -> Value -> t Value -> Eval Value
app Text -> [Text] -> Text
T.intercalate Value
sep
    app :: (a -> t b -> a) -> Value -> t Value -> Eval Value
app a -> t b -> a
f Value
sep t Value
arr = a -> Value
forall a. HasValue a => a -> Value
inj (a -> Value) -> EvalM Value a -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> t b -> a
f (a -> t b -> a) -> EvalM Value a -> EvalM Value (t b -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> EvalM Value a
forall a. HasValue a => Value -> Eval a
proj Value
sep EvalM Value (t b -> a) -> EvalM Value (t b) -> EvalM Value a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> EvalM Value b) -> t Value -> EvalM Value (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> EvalM Value b
forall a. HasValue a => Value -> Eval a
proj t Value
arr)

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 Vector Value
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
$ Vector Value -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length Vector Value
a
  VObj Object
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 (Object -> [Text]
forall k v. HashMap k v -> [k]
H.keys Object
o)
  VClos Lam
f Env
_ -> do
    (Rec [Param Core]
ps, Core
_) <- Lam -> EvalM Value (Rec [Param Core], Core)
forall p t (m :: * -> *).
(Alpha p, Alpha t, Fresh m) =>
Bind p t -> m (p, t)
unbind Lam
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 b. EvalError -> EvalM a b
throwE
      ( Doc -> EvalError
StdError (Doc -> EvalError) -> Doc -> EvalError
forall a b. (a -> b) -> a -> b
$
          String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$
            Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
              Text
"length operates on strings, objects, functions and arrays, got "
              --   <> showTy v
      )

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

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 -> Vector Value -> Value
VArr (Vector Value -> Value) -> Parser (Vector Value) -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Value) -> Array -> Parser (Vector 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 Array
a
    JSON.Object Object
o -> Object -> Value
VObj (Object -> Value)
-> (HashMap Text Value -> Object) -> HashMap Text Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Value -> Object
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 -> Object
f HashMap Text Value
o =
        [(Text, VField)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
          [ Text -> Value -> (Text, VField)
mkField Text
k 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 :: Text -> Value -> (Text, VField)
mkField Text
k Value
v = (Text
k, Value -> Value -> Value -> Visibility -> VField
VField (Text -> Value
VStr Text
k) Value
v Value
v Visibility
Visible)