{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module                  : Language.Jsonnet
-- 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
  ( JsonnetM,
    interpret,
    Config (..),
    Value (..),
    runJsonnetM,
    parse,
    evaluate,
    desugar,
  )
where

import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Except
import Control.Monad.Reader
import qualified Data.Aeson as JSON
import Data.Functor.Identity
import Data.Functor.Sum
import qualified Data.Map.Lazy as M
import Data.Map.Strict (singleton)
import Data.Text (Text)
import qualified Data.Text.IO as T (readFile)
import Debug.Trace
import Language.Jsonnet.Annotate
import qualified Language.Jsonnet.Check as Check
import Language.Jsonnet.Common
import Language.Jsonnet.Core
import qualified Language.Jsonnet.Desugar as Desugar
import Language.Jsonnet.Error
import Language.Jsonnet.Eval
import Language.Jsonnet.Eval.Monad
import qualified Language.Jsonnet.Parser as Parser
import Language.Jsonnet.Pretty ()
import qualified Language.Jsonnet.Std.Lib as Lib
import Language.Jsonnet.Std.TH (mkStdlib)
import Language.Jsonnet.Syntax.Annotated
import Language.Jsonnet.Value
import Data.Binary (decode)

newtype JsonnetM a = JsonnetM
  { JsonnetM a -> ReaderT Config (ExceptT Error IO) a
unJsonnetM :: ReaderT Config (ExceptT Error IO) a
  }
  deriving
    ( a -> JsonnetM b -> JsonnetM a
(a -> b) -> JsonnetM a -> JsonnetM b
(forall a b. (a -> b) -> JsonnetM a -> JsonnetM b)
-> (forall a b. a -> JsonnetM b -> JsonnetM a) -> Functor JsonnetM
forall a b. a -> JsonnetM b -> JsonnetM a
forall a b. (a -> b) -> JsonnetM a -> JsonnetM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> JsonnetM b -> JsonnetM a
$c<$ :: forall a b. a -> JsonnetM b -> JsonnetM a
fmap :: (a -> b) -> JsonnetM a -> JsonnetM b
$cfmap :: forall a b. (a -> b) -> JsonnetM a -> JsonnetM b
Functor,
      Functor JsonnetM
a -> JsonnetM a
Functor JsonnetM
-> (forall a. a -> JsonnetM a)
-> (forall a b. JsonnetM (a -> b) -> JsonnetM a -> JsonnetM b)
-> (forall a b c.
    (a -> b -> c) -> JsonnetM a -> JsonnetM b -> JsonnetM c)
-> (forall a b. JsonnetM a -> JsonnetM b -> JsonnetM b)
-> (forall a b. JsonnetM a -> JsonnetM b -> JsonnetM a)
-> Applicative JsonnetM
JsonnetM a -> JsonnetM b -> JsonnetM b
JsonnetM a -> JsonnetM b -> JsonnetM a
JsonnetM (a -> b) -> JsonnetM a -> JsonnetM b
(a -> b -> c) -> JsonnetM a -> JsonnetM b -> JsonnetM c
forall a. a -> JsonnetM a
forall a b. JsonnetM a -> JsonnetM b -> JsonnetM a
forall a b. JsonnetM a -> JsonnetM b -> JsonnetM b
forall a b. JsonnetM (a -> b) -> JsonnetM a -> JsonnetM b
forall a b c.
(a -> b -> c) -> JsonnetM a -> JsonnetM b -> JsonnetM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: JsonnetM a -> JsonnetM b -> JsonnetM a
$c<* :: forall a b. JsonnetM a -> JsonnetM b -> JsonnetM a
*> :: JsonnetM a -> JsonnetM b -> JsonnetM b
$c*> :: forall a b. JsonnetM a -> JsonnetM b -> JsonnetM b
liftA2 :: (a -> b -> c) -> JsonnetM a -> JsonnetM b -> JsonnetM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> JsonnetM a -> JsonnetM b -> JsonnetM c
<*> :: JsonnetM (a -> b) -> JsonnetM a -> JsonnetM b
$c<*> :: forall a b. JsonnetM (a -> b) -> JsonnetM a -> JsonnetM b
pure :: a -> JsonnetM a
$cpure :: forall a. a -> JsonnetM a
$cp1Applicative :: Functor JsonnetM
Applicative,
      Applicative JsonnetM
a -> JsonnetM a
Applicative JsonnetM
-> (forall a b. JsonnetM a -> (a -> JsonnetM b) -> JsonnetM b)
-> (forall a b. JsonnetM a -> JsonnetM b -> JsonnetM b)
-> (forall a. a -> JsonnetM a)
-> Monad JsonnetM
JsonnetM a -> (a -> JsonnetM b) -> JsonnetM b
JsonnetM a -> JsonnetM b -> JsonnetM b
forall a. a -> JsonnetM a
forall a b. JsonnetM a -> JsonnetM b -> JsonnetM b
forall a b. JsonnetM a -> (a -> JsonnetM b) -> JsonnetM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> JsonnetM a
$creturn :: forall a. a -> JsonnetM a
>> :: JsonnetM a -> JsonnetM b -> JsonnetM b
$c>> :: forall a b. JsonnetM a -> JsonnetM b -> JsonnetM b
>>= :: JsonnetM a -> (a -> JsonnetM b) -> JsonnetM b
$c>>= :: forall a b. JsonnetM a -> (a -> JsonnetM b) -> JsonnetM b
$cp1Monad :: Applicative JsonnetM
Monad,
      Monad JsonnetM
Monad JsonnetM
-> (forall a. IO a -> JsonnetM a) -> MonadIO JsonnetM
IO a -> JsonnetM a
forall a. IO a -> JsonnetM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> JsonnetM a
$cliftIO :: forall a. IO a -> JsonnetM a
$cp1MonadIO :: Monad JsonnetM
MonadIO,
      Monad JsonnetM
Monad JsonnetM
-> (forall a. (a -> JsonnetM a) -> JsonnetM a) -> MonadFix JsonnetM
(a -> JsonnetM a) -> JsonnetM a
forall a. (a -> JsonnetM a) -> JsonnetM a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> JsonnetM a) -> JsonnetM a
$cmfix :: forall a. (a -> JsonnetM a) -> JsonnetM a
$cp1MonadFix :: Monad JsonnetM
MonadFix,
      MonadReader Config,
      MonadError Error,
      Monad JsonnetM
e -> JsonnetM a
Monad JsonnetM
-> (forall e a. Exception e => e -> JsonnetM a)
-> MonadThrow JsonnetM
forall e a. Exception e => e -> JsonnetM a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> JsonnetM a
$cthrowM :: forall e a. Exception e => e -> JsonnetM a
$cp1MonadThrow :: Monad JsonnetM
MonadThrow,
      MonadThrow JsonnetM
MonadThrow JsonnetM
-> (forall e a.
    Exception e =>
    JsonnetM a -> (e -> JsonnetM a) -> JsonnetM a)
-> MonadCatch JsonnetM
JsonnetM a -> (e -> JsonnetM a) -> JsonnetM a
forall e a.
Exception e =>
JsonnetM a -> (e -> JsonnetM a) -> JsonnetM a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: JsonnetM a -> (e -> JsonnetM a) -> JsonnetM a
$ccatch :: forall e a.
Exception e =>
JsonnetM a -> (e -> JsonnetM a) -> JsonnetM a
$cp1MonadCatch :: MonadThrow JsonnetM
MonadCatch,
      MonadCatch JsonnetM
MonadCatch JsonnetM
-> (forall b.
    ((forall a. JsonnetM a -> JsonnetM a) -> JsonnetM b) -> JsonnetM b)
-> (forall b.
    ((forall a. JsonnetM a -> JsonnetM a) -> JsonnetM b) -> JsonnetM b)
-> (forall a b c.
    JsonnetM a
    -> (a -> ExitCase b -> JsonnetM c)
    -> (a -> JsonnetM b)
    -> JsonnetM (b, c))
-> MonadMask JsonnetM
JsonnetM a
-> (a -> ExitCase b -> JsonnetM c)
-> (a -> JsonnetM b)
-> JsonnetM (b, c)
((forall a. JsonnetM a -> JsonnetM a) -> JsonnetM b) -> JsonnetM b
((forall a. JsonnetM a -> JsonnetM a) -> JsonnetM b) -> JsonnetM b
forall b.
((forall a. JsonnetM a -> JsonnetM a) -> JsonnetM b) -> JsonnetM b
forall a b c.
JsonnetM a
-> (a -> ExitCase b -> JsonnetM c)
-> (a -> JsonnetM b)
-> JsonnetM (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: JsonnetM a
-> (a -> ExitCase b -> JsonnetM c)
-> (a -> JsonnetM b)
-> JsonnetM (b, c)
$cgeneralBracket :: forall a b c.
JsonnetM a
-> (a -> ExitCase b -> JsonnetM c)
-> (a -> JsonnetM b)
-> JsonnetM (b, c)
uninterruptibleMask :: ((forall a. JsonnetM a -> JsonnetM a) -> JsonnetM b) -> JsonnetM b
$cuninterruptibleMask :: forall b.
((forall a. JsonnetM a -> JsonnetM a) -> JsonnetM b) -> JsonnetM b
mask :: ((forall a. JsonnetM a -> JsonnetM a) -> JsonnetM b) -> JsonnetM b
$cmask :: forall b.
((forall a. JsonnetM a -> JsonnetM a) -> JsonnetM b) -> JsonnetM b
$cp1MonadMask :: MonadCatch JsonnetM
MonadMask,
      Monad JsonnetM
Monad JsonnetM
-> (forall a. String -> JsonnetM a) -> MonadFail JsonnetM
String -> JsonnetM a
forall a. String -> JsonnetM a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> JsonnetM a
$cfail :: forall a. String -> JsonnetM a
$cp1MonadFail :: Monad JsonnetM
MonadFail
    )

newtype Config = Config
  { Config -> String
fname :: FilePath
  }

runJsonnetM :: Config -> JsonnetM a -> IO (Either Error a)
runJsonnetM :: Config -> JsonnetM a -> IO (Either Error a)
runJsonnetM Config
conf = ExceptT Error IO a -> IO (Either Error a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error IO a -> IO (Either Error a))
-> (JsonnetM a -> ExceptT Error IO a)
-> JsonnetM a
-> IO (Either Error a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT Config (ExceptT Error IO) a -> Config -> ExceptT Error IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Config
conf) (ReaderT Config (ExceptT Error IO) a -> ExceptT Error IO a)
-> (JsonnetM a -> ReaderT Config (ExceptT Error IO) a)
-> JsonnetM a
-> ExceptT Error IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonnetM a -> ReaderT Config (ExceptT Error IO) a
forall a. JsonnetM a -> ReaderT Config (ExceptT Error IO) a
unJsonnetM

interpret :: Config -> Text -> IO (Either Error JSON.Value)
interpret :: Config -> Text -> IO (Either Error Value)
interpret Config
conf =
  Config -> JsonnetM Value -> IO (Either Error Value)
forall a. Config -> JsonnetM a -> IO (Either Error a)
runJsonnetM Config
conf
    (JsonnetM Value -> IO (Either Error Value))
-> (Text -> JsonnetM Value) -> Text -> IO (Either Error Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> JsonnetM Expr
parse (Text -> JsonnetM Expr)
-> (Expr -> JsonnetM Value) -> Text -> JsonnetM Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Expr -> JsonnetM Expr
check (Expr -> JsonnetM Expr)
-> (Expr -> JsonnetM Value) -> Expr -> JsonnetM Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Expr -> JsonnetM Core
desugar (Expr -> JsonnetM Core)
-> (Core -> JsonnetM Value) -> Expr -> JsonnetM Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Core -> JsonnetM Value
evaluate)

parse :: Text -> JsonnetM Expr
parse :: Text -> JsonnetM Expr
parse Text
inp =
  (Config -> String) -> JsonnetM String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> String
fname JsonnetM String -> (String -> JsonnetM Expr) -> JsonnetM Expr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderT Config (ExceptT Error IO) Expr -> JsonnetM Expr
forall a. ReaderT Config (ExceptT Error IO) a -> JsonnetM a
JsonnetM (ReaderT Config (ExceptT Error IO) Expr -> JsonnetM Expr)
-> (String -> ReaderT Config (ExceptT Error IO) Expr)
-> String
-> JsonnetM Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Error IO Expr -> ReaderT Config (ExceptT Error IO) Expr
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error IO Expr -> ReaderT Config (ExceptT Error IO) Expr)
-> (String -> ExceptT Error IO Expr)
-> String
-> ReaderT Config (ExceptT Error IO) Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT Error IO Expr
forall (m :: * -> *).
(MonadError Error m, MonadIO m) =>
String -> m Expr
go
  where
    go :: String -> m Expr
go String
fp = do
      Expr'
ast <- String -> Text -> m Expr'
forall (m :: * -> *).
MonadError Error m =>
String -> Text -> m Expr'
Parser.parse String
fp Text
inp
      String -> Expr' -> m Expr
forall (m :: * -> *).
(MonadError Error m, MonadIO m) =>
String -> Expr' -> m Expr
Parser.resolveImports String
fp Expr'
ast

check :: Expr -> JsonnetM Expr
check :: Expr -> JsonnetM Expr
check Expr
expr = do
  ()
_ <-
    ReaderT Config (ExceptT Error IO) () -> JsonnetM ()
forall a. ReaderT Config (ExceptT Error IO) a -> JsonnetM a
JsonnetM (ReaderT Config (ExceptT Error IO) () -> JsonnetM ())
-> ReaderT Config (ExceptT Error IO) () -> JsonnetM ()
forall a b. (a -> b) -> a -> b
$
      ExceptT Error IO () -> ReaderT Config (ExceptT Error IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error IO () -> ReaderT Config (ExceptT Error IO) ())
-> ExceptT Error IO () -> ReaderT Config (ExceptT Error IO) ()
forall a b. (a -> b) -> a -> b
$
        Expr -> ExceptT Error IO ()
Check.check Expr
expr
  Expr -> JsonnetM Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
expr

desugar :: Expr -> JsonnetM Core
desugar :: Expr -> JsonnetM Core
desugar = Core -> JsonnetM Core
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Core -> JsonnetM Core) -> (Expr -> Core) -> Expr -> JsonnetM Core
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Core
forall a. Desugarer a => a -> Core
Desugar.desugar

-- | evaluate a Core expression with the implicit stdlib
evaluate :: Core -> JsonnetM JSON.Value
evaluate :: Core -> JsonnetM Value
evaluate Core
expr = do
  Map (Name Core) Value
env <- Name Core -> Value -> Map (Name Core) Value
forall k a. k -> a -> Map k a
singleton Name Core
"std" (Value -> Map (Name Core) Value)
-> JsonnetM Value -> JsonnetM (Map (Name Core) Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsonnetM Value
std
  ReaderT Config (ExceptT Error IO) Value -> JsonnetM Value
forall a. ReaderT Config (ExceptT Error IO) a -> JsonnetM a
JsonnetM (ReaderT Config (ExceptT Error IO) Value -> JsonnetM Value)
-> ReaderT Config (ExceptT Error IO) Value -> JsonnetM Value
forall a b. (a -> b) -> a -> b
$ ExceptT Error IO Value -> ReaderT Config (ExceptT Error IO) Value
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error IO Value -> ReaderT Config (ExceptT Error IO) Value)
-> ExceptT Error IO Value
-> ReaderT Config (ExceptT Error IO) Value
forall a b. (a -> b) -> a -> b
$ IO (Either Error Value) -> ExceptT Error IO Value
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Error Value) -> ExceptT Error IO Value)
-> IO (Either Error Value) -> ExceptT Error IO Value
forall a b. (a -> b) -> a -> b
$ Map (Name Core) Value
-> EvalM Value Value -> IO (Either Error Value)
forall a b. Ctx a -> EvalM a b -> IO (Either Error b)
runEvalM Map (Name Core) Value
env (Core -> EvalM Value Value
rnf Core
expr)

-- | the jsonnet stdlib is written in both jsonnet and Haskell, here we merge
--   the native (a small subset) with the interpreted (the splice mkStdlib)
std :: JsonnetM Value
std :: JsonnetM Value
std = ReaderT Config (ExceptT Error IO) Value -> JsonnetM Value
forall a. ReaderT Config (ExceptT Error IO) a -> JsonnetM a
JsonnetM (ReaderT Config (ExceptT Error IO) Value -> JsonnetM Value)
-> ReaderT Config (ExceptT Error IO) Value -> JsonnetM Value
forall a b. (a -> b) -> a -> b
$ ExceptT Error IO Value -> ReaderT Config (ExceptT Error IO) Value
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error IO Value -> ReaderT Config (ExceptT Error IO) Value)
-> ExceptT Error IO Value
-> ReaderT Config (ExceptT Error IO) Value
forall a b. (a -> b) -> a -> b
$ IO (Either Error Value) -> ExceptT Error IO Value
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Error Value) -> ExceptT Error IO Value)
-> IO (Either Error Value) -> ExceptT Error IO Value
forall a b. (a -> b) -> a -> b
$ Map (Name Core) Value
-> EvalM Value Value -> IO (Either Error Value)
forall a b. Ctx a -> EvalM a b -> IO (Either Error b)
runEvalM Map (Name Core) Value
forall k a. Map k a
M.empty EvalM Value Value
stdlib
  where
    stdlib :: EvalM Value Value
stdlib = Core -> EvalM Value Value
whnf Core
core EvalM Value Value
-> (Value -> EvalM Value Value) -> EvalM Value Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Value -> EvalM Value Value)
-> Value -> Value -> EvalM Value Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value -> Value -> EvalM Value Value
mergeObjects Value
Lib.std
    core :: Core
core = ByteString -> Core
forall a. Binary a => ByteString -> a
decode $(Addr#
Int
[ByteString]
Int -> Addr# -> IO ByteString
[ByteString] -> ByteString
IO ByteString -> ByteString
forall a. IO a -> a
unsafePackAddressLen :: Int -> Addr# -> IO ByteString
fromChunks :: [ByteString] -> ByteString
unsafePerformIO :: forall a. IO a -> a
mkStdlib)
    mergeObjects :: Value -> Value -> EvalM Value Value
mergeObjects Value
x Value
y = Prim -> [Arg Value] -> EvalM Value Value
whnfPrim (BinOp -> Prim
BinOp BinOp
Add) [Value -> Arg Value
forall a. a -> Arg a
Pos Value
x, Value -> Arg Value
forall a. a -> Arg a
Pos Value
y]