{- |
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
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

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

newtype JsonnetM a = JsonnetM
  { forall a. JsonnetM a -> ReaderT Config (ExceptT Error IO) a
unJsonnetM :: ReaderT Config (ExceptT Error IO) a
  }
  deriving
    ( (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
<$ :: forall a b. a -> JsonnetM b -> JsonnetM a
$c<$ :: forall a b. a -> JsonnetM b -> JsonnetM a
fmap :: forall a b. (a -> b) -> JsonnetM a -> JsonnetM b
$cfmap :: forall a b. (a -> b) -> JsonnetM a -> JsonnetM b
Functor,
      Functor JsonnetM
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
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
<* :: forall a b. JsonnetM a -> JsonnetM b -> JsonnetM a
$c<* :: forall a b. JsonnetM a -> JsonnetM b -> JsonnetM a
*> :: forall a b. JsonnetM a -> JsonnetM b -> JsonnetM b
$c*> :: forall a b. JsonnetM a -> JsonnetM b -> JsonnetM b
liftA2 :: forall a b c.
(a -> b -> c) -> JsonnetM a -> JsonnetM b -> JsonnetM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> JsonnetM a -> JsonnetM b -> JsonnetM c
<*> :: forall a b. JsonnetM (a -> b) -> JsonnetM a -> JsonnetM b
$c<*> :: forall a b. JsonnetM (a -> b) -> JsonnetM a -> JsonnetM b
pure :: forall a. a -> JsonnetM a
$cpure :: forall a. a -> JsonnetM a
Applicative,
      Applicative JsonnetM
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
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 :: forall a. a -> JsonnetM a
$creturn :: forall a. a -> JsonnetM a
>> :: forall a b. JsonnetM a -> JsonnetM b -> JsonnetM b
$c>> :: forall a b. JsonnetM a -> JsonnetM b -> JsonnetM b
>>= :: forall a b. JsonnetM a -> (a -> JsonnetM b) -> JsonnetM b
$c>>= :: forall a b. JsonnetM a -> (a -> JsonnetM b) -> JsonnetM b
Monad,
      Monad JsonnetM
Monad JsonnetM
-> (forall a. IO a -> JsonnetM a) -> MonadIO JsonnetM
forall a. IO a -> JsonnetM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> JsonnetM a
$cliftIO :: forall a. IO a -> JsonnetM a
MonadIO,
      Monad JsonnetM
Monad JsonnetM
-> (forall a. (a -> JsonnetM a) -> JsonnetM a) -> MonadFix JsonnetM
forall a. (a -> JsonnetM a) -> JsonnetM a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> JsonnetM a) -> JsonnetM a
$cmfix :: forall a. (a -> JsonnetM a) -> JsonnetM a
MonadFix,
      MonadReader Config,
      MonadError Error,
      Monad JsonnetM
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 :: forall e a. Exception e => e -> JsonnetM a
$cthrowM :: forall e a. Exception e => e -> JsonnetM a
MonadThrow,
      MonadThrow JsonnetM
MonadThrow JsonnetM
-> (forall e a.
    Exception e =>
    JsonnetM a -> (e -> JsonnetM a) -> JsonnetM a)
-> MonadCatch JsonnetM
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 :: forall e a.
Exception e =>
JsonnetM a -> (e -> JsonnetM a) -> JsonnetM a
$ccatch :: forall e a.
Exception e =>
JsonnetM a -> (e -> JsonnetM a) -> JsonnetM a
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
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 :: forall a b c.
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 b.
((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 b.
((forall a. JsonnetM a -> JsonnetM a) -> JsonnetM b) -> JsonnetM b
$cmask :: forall b.
((forall a. JsonnetM a -> JsonnetM a) -> JsonnetM b) -> JsonnetM b
MonadMask,
      Monad JsonnetM
Monad JsonnetM
-> (forall a. String -> JsonnetM a) -> MonadFail JsonnetM
forall a. String -> JsonnetM a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> JsonnetM a
$cfail :: forall a. String -> JsonnetM a
MonadFail
    )

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

runJsonnetM :: Config -> JsonnetM a -> IO (Either Error a)
runJsonnetM :: forall a. 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 = Ann ExprF () -> Core
forall a. Desugarer a => a -> Core
Desugar.desugar ((SrcSpan -> ()) -> Expr -> Ann ExprF ()
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Ann f a -> Ann f b
annMap (() -> SrcSpan -> ()
forall a b. a -> b -> a
const ()) $Char
Int
String
[(String, Maybe Expr)]
[(String, Expr)]
[EField Expr]
Maybe Expr
Char -> String -> String
Int -> Pos
String -> ExprF Expr
String -> Maybe Expr -> (String, Maybe Expr)
String -> Expr -> (String, Expr)
String -> Pos -> Pos -> SourcePos
[(String, Maybe Expr)] -> Expr -> ExprF Expr
[(String, Expr)] -> [EField Expr] -> ExprF Expr
(String, Maybe Expr)
-> [(String, Maybe Expr)] -> [(String, Maybe Expr)]
(String, Expr) -> [(String, Expr)] -> [(String, Expr)]
Product (Const SrcSpan) ExprF Expr -> Expr
Const SrcSpan Expr
-> ExprF Expr -> Product (Const SrcSpan) ExprF Expr
SourcePos -> SourcePos -> SrcSpan
SrcSpan -> Const SrcSpan Expr
forall a. [a]
forall a. Maybe a
forall a. a -> [a] -> [a]
forall a. String -> ExprF a
forall a. [(String, a)] -> [EField a] -> ExprF a
forall a. [Param a] -> a -> ExprF a
forall a b. a -> b -> (a, b)
forall {k} a (b :: k). a -> Const a b
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
forall (f :: * -> *). f (Fix f) -> Fix f
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]