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

module Language.Jsonnet
  ( JsonnetM,
    interpret,
    Config (..),
    Value (..),
    runJsonnetM,
    parse,
    evaluate,
  )
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 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.Core
import qualified Language.Jsonnet.Desugar as Desugar
import Language.Jsonnet.Error
import Language.Jsonnet.Eval
import Language.Jsonnet.Manifest (manifest)
import qualified Language.Jsonnet.Parser as Parser
import Language.Jsonnet.Pretty ()
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
    )

data Config = Config
  { Config -> String
fname :: FilePath,
    Config -> Thunk
stdlib :: Thunk
  }

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 Expr
expr = Core -> JsonnetM Core
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> Core
forall a. Desugarer a => a -> Core
Desugar.desugar Expr
expr)

-- evaluate a Core expression with the implicit stdlib
evaluate :: Core -> JsonnetM JSON.Value
evaluate :: Core -> JsonnetM Value
evaluate Core
expr = do
  Map (Name Core) Thunk
ctx <- Name Core -> Thunk -> Map (Name Core) Thunk
forall k a. k -> a -> Map k a
singleton Name Core
"std" (Thunk -> Map (Name Core) Thunk)
-> JsonnetM Thunk -> JsonnetM (Map (Name Core) Thunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Config -> Thunk) -> JsonnetM Thunk
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Thunk
stdlib
  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
$
      Env -> Eval Value -> ExceptT Error IO Value
forall a. Env -> Eval a -> ExceptT Error IO a
runEval (Env
emptyEnv {ctx :: Map (Name Core) Thunk
ctx = Map (Name Core) Thunk
ctx}) ((Core -> Eval Value
eval (Core -> Eval Value) -> (Value -> Eval Value) -> Core -> Eval Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> Eval Value
manifest) Core
expr)