diff --git a/jsonnet.cabal b/jsonnet.cabal --- a/jsonnet.cabal +++ b/jsonnet.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: jsonnet -version: 0.3.0.1 +version: 0.3.1.1 synopsis: Jsonnet implementaton in pure Haskell description: Please see the README on GitHub at homepage: https://github.com/moleike/haskell-jsonnet#readme @@ -74,7 +74,9 @@ megaparsec >= 9.0.1 && < 9.1, parser-combinators >= 1.3.0 && < 1.4, unbound-generics >= 0.4.1 && < 0.5, - th-utilities == 0.2.4.2 + th-utilities == 0.2.4.2, + binary >= 0.8.8 && < 0.9, + th-lift-instances >= 0.1.18 && < 0.2 default-language: Haskell2010 default-extensions: diff --git a/src/Language/Jsonnet.hs b/src/Language/Jsonnet.hs --- a/src/Language/Jsonnet.hs +++ b/src/Language/Jsonnet.hs @@ -1,11 +1,3 @@ -{- | -Module : Language.Jsonnet -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} @@ -14,6 +6,13 @@ {-# 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 +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet ( JsonnetM, interpret, @@ -51,6 +50,7 @@ import Language.Jsonnet.Std.TH (mkStdlib) import Language.Jsonnet.Syntax.Annotated import Language.Jsonnet.Value +import Data.Binary (decode) newtype JsonnetM a = JsonnetM { unJsonnetM :: ReaderT Config (ExceptT Error IO) a @@ -112,5 +112,5 @@ std = JsonnetM $ lift $ ExceptT $ runEvalM M.empty stdlib where stdlib = whnf core >>= flip mergeObjects Lib.std - core = Desugar.desugar (annMap (const ()) $mkStdlib) + core = decode $(mkStdlib) mergeObjects x y = whnfPrim (BinOp Add) [Pos x, Pos y] diff --git a/src/Language/Jsonnet/Annotate.hs b/src/Language/Jsonnet/Annotate.hs --- a/src/Language/Jsonnet/Annotate.hs +++ b/src/Language/Jsonnet/Annotate.hs @@ -1,16 +1,14 @@ -{- | -Module : Language.Jsonnet.Annotate -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable - -Annotated trees, based on fixplate - --} {-# LANGUAGE PatternSynonyms #-} +-- | +-- Module : Language.Jsonnet.Annotate +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable +-- +-- Annotated trees, based on fixplate module Language.Jsonnet.Annotate where import Control.Applicative (Const (..)) diff --git a/src/Language/Jsonnet/Check.hs b/src/Language/Jsonnet/Check.hs --- a/src/Language/Jsonnet/Check.hs +++ b/src/Language/Jsonnet/Check.hs @@ -1,14 +1,13 @@ -{- | -Module : Language.Jsonnet.Check -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} +-- | +-- Module : Language.Jsonnet.Check +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Check where import Control.Monad.Except diff --git a/src/Language/Jsonnet/Common.hs b/src/Language/Jsonnet/Common.hs --- a/src/Language/Jsonnet/Common.hs +++ b/src/Language/Jsonnet/Common.hs @@ -1,11 +1,3 @@ -{- | -Module : Language.Jsonnet.Common -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} @@ -18,8 +10,16 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} +-- | +-- Module : Language.Jsonnet.Common +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Common where +import Data.Binary (Binary) import Data.Data (Data) import Data.Functor.Classes import Data.Functor.Classes.Generic @@ -42,6 +42,8 @@ makeClosedAlpha ''Literal +instance Binary Literal + instance Subst a Literal where subst _ _ = id substs _ = id @@ -54,6 +56,8 @@ instance Alpha Prim +instance Binary Prim + data BinOp = Add | Sub @@ -79,6 +83,8 @@ instance Alpha BinOp +instance Binary BinOp + data UnyOp = Compl | LNot @@ -89,11 +95,15 @@ instance Alpha UnyOp +instance Binary UnyOp + data Strictness = Strict | Lazy deriving (Eq, Read, Show, Generic, Typeable, Data) instance Alpha Strictness +instance Binary Strictness + data Arg a = Pos a | Named String a deriving ( Eq, @@ -112,6 +122,8 @@ instance Alpha a => Alpha (Arg a) +instance Binary a => Binary (Arg a) + data Args a = Args { args :: [Arg a], strictness :: Strictness @@ -132,6 +144,8 @@ instance Alpha a => Alpha (Args a) +instance Binary a => Binary (Args a) + data Assert a = Assert { cond :: a, msg :: Maybe a, @@ -194,6 +208,8 @@ ) instance Alpha Visibility + +instance Binary Visibility class HasVisibility a where visible :: a -> Bool diff --git a/src/Language/Jsonnet/Core.hs b/src/Language/Jsonnet/Core.hs --- a/src/Language/Jsonnet/Core.hs +++ b/src/Language/Jsonnet/Core.hs @@ -1,14 +1,9 @@ -{- | -Module : Language.Jsonnet.Core -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveLift #-} {-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTSyntax #-} @@ -16,15 +11,25 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE StandaloneDeriving #-} +-- | +-- Module : Language.Jsonnet.Core +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Core where +import Data.Binary (Binary) import Data.Data (Data) -import Data.String +import Data.String ( IsString(..) ) import Data.Typeable (Typeable) import GHC.Generics (Generic) -import Language.Jsonnet.Common -import Language.Jsonnet.Parser.SrcSpan +import Language.Jsonnet.Common ( Args, Prim, Literal, Visibility ) +import Language.Jsonnet.Parser.SrcSpan ( SrcSpan ) +import Text.Megaparsec.Pos (Pos, SourcePos) import Unbound.Generics.LocallyNameless + ( string2Name, Bind, Rec, Embed, Name, Alpha ) type Param a = (Name a, Embed a) @@ -36,21 +41,34 @@ -- | fieldVis :: Visibility } - deriving (Show, Generic) + deriving + ( Show, + Generic, + Alpha, + Binary + ) mkField :: Core -> Core -> Visibility -> CField mkField = CField ---pattern CField k v h <- CField_ k _ v h +instance Binary a => Binary (Name a) -instance Alpha CField +instance Binary a => Binary (Rec a) +instance Binary a => Binary (Embed a) + +instance (Binary a, Binary b) => Binary (Bind a b) + data Comp = ArrC (Bind (Name Core) (Core, Maybe Core)) | ObjC (Bind (Name Core) (CField, Maybe Core)) - deriving (Show, Typeable, Generic) - -instance Alpha Comp + deriving + ( Show, + Typeable, + Generic, + Alpha, + Binary + ) type Lam = Bind (Rec [Param Core]) Core @@ -67,9 +85,13 @@ CObj :: [CField] -> Core CArr :: [Core] -> Core CComp :: Comp -> Core -> Core - deriving (Show, Typeable, Generic) - -instance Alpha Core + deriving + ( Show, + Typeable, + Generic, + Alpha, + Binary + ) --data Params -- = EmptyPs diff --git a/src/Language/Jsonnet/Desugar.hs b/src/Language/Jsonnet/Desugar.hs --- a/src/Language/Jsonnet/Desugar.hs +++ b/src/Language/Jsonnet/Desugar.hs @@ -1,11 +1,3 @@ -{- | -Module : Language.Jsonnet.Desugar -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -16,6 +8,13 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeSynonymInstances #-} +-- | +-- Module : Language.Jsonnet.Desugar +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Desugar (desugar) where import qualified Data.Bifunctor diff --git a/src/Language/Jsonnet/Error.hs b/src/Language/Jsonnet/Error.hs --- a/src/Language/Jsonnet/Error.hs +++ b/src/Language/Jsonnet/Error.hs @@ -1,16 +1,15 @@ -{- | -Module : Language.Jsonnet.Error -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +-- | +-- Module : Language.Jsonnet.Error +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Error where import Control.Exception diff --git a/src/Language/Jsonnet/Eval.hs b/src/Language/Jsonnet/Eval.hs --- a/src/Language/Jsonnet/Eval.hs +++ b/src/Language/Jsonnet/Eval.hs @@ -1,11 +1,3 @@ -{- | -Module : Language.Jsonnet.Eval -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -14,9 +6,15 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} - {-# OPTIONS_GHC -fno-warn-orphans #-} +-- | +-- Module : Language.Jsonnet.Eval +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Eval where import Control.Applicative diff --git a/src/Language/Jsonnet/Eval/Monad.hs b/src/Language/Jsonnet/Eval/Monad.hs --- a/src/Language/Jsonnet/Eval/Monad.hs +++ b/src/Language/Jsonnet/Eval/Monad.hs @@ -1,16 +1,15 @@ -{- | -Module : Language.Jsonnet.Eval.Monad -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} +-- | +-- Module : Language.Jsonnet.Eval.Monad +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Eval.Monad where import Control.Lens (locally, makeLenses, view) diff --git a/src/Language/Jsonnet/Parser.hs b/src/Language/Jsonnet/Parser.hs --- a/src/Language/Jsonnet/Parser.hs +++ b/src/Language/Jsonnet/Parser.hs @@ -1,19 +1,17 @@ -{- | -Module : Language.Jsonnet.Parser -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable - -Parser for Jsonnet source code. - --} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} +-- | +-- Module : Language.Jsonnet.Parser +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable +-- +-- Parser for Jsonnet source code. module Language.Jsonnet.Parser ( parse, resolveImports, diff --git a/src/Language/Jsonnet/Parser/SrcSpan.hs b/src/Language/Jsonnet/Parser/SrcSpan.hs --- a/src/Language/Jsonnet/Parser/SrcSpan.hs +++ b/src/Language/Jsonnet/Parser/SrcSpan.hs @@ -1,23 +1,23 @@ -{- | -Module : Language.Jsonnet.Parser.SrcSpan -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} +-- | +-- Module : Language.Jsonnet.Parser.SrcSpan +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Parser.SrcSpan where +import Data.Binary (Binary) import Data.Data import Data.Function (on) import GHC.Generics (Generic) -import Text.Megaparsec.Pos (SourcePos (..)) +import Text.Megaparsec.Pos (Pos, SourcePos (..)) import Unbound.Generics.LocallyNameless import Unbound.Generics.LocallyNameless.TH @@ -36,6 +36,12 @@ ) $(makeClosedAlpha ''SrcSpan) + +instance Binary SourcePos + +instance Binary Pos + +instance Binary SrcSpan instance Subst b SrcSpan where subst _ _ = id diff --git a/src/Language/Jsonnet/Pretty.hs b/src/Language/Jsonnet/Pretty.hs --- a/src/Language/Jsonnet/Pretty.hs +++ b/src/Language/Jsonnet/Pretty.hs @@ -1,11 +1,3 @@ -{- | -Module : Language.Jsonnet.Pretty -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -13,6 +5,13 @@ {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-orphans #-} +-- | +-- Module : Language.Jsonnet.Pretty +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Pretty where import qualified Data.Aeson as JSON diff --git a/src/Language/Jsonnet/Std/Lib.hs b/src/Language/Jsonnet/Std/Lib.hs --- a/src/Language/Jsonnet/Std/Lib.hs +++ b/src/Language/Jsonnet/Std/Lib.hs @@ -1,11 +1,3 @@ -{- | -Module : Language.Jsonnet.Std.Lib -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE LiberalTypeSynonyms #-} @@ -14,6 +6,13 @@ {-# 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 +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Std.Lib ( std, objectHasEx, diff --git a/src/Language/Jsonnet/Std/TH.hs b/src/Language/Jsonnet/Std/TH.hs --- a/src/Language/Jsonnet/Std/TH.hs +++ b/src/Language/Jsonnet/Std/TH.hs @@ -1,21 +1,20 @@ -{- | -Module : Language.Jsonnet.Std.TH -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} +-- | +-- Module : Language.Jsonnet.Std.TH +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Std.TH where import qualified Data.Text.IO as TIO import Language.Haskell.TH import Language.Haskell.TH.Quote () import Language.Haskell.TH.Syntax (addDependentFile) -import Language.Jsonnet.TH (parse) +import Language.Jsonnet.TH (compile) import TH.RelativePaths (pathRelativeToCabalPackage) stdlibPath :: String @@ -26,5 +25,5 @@ fp <- pathRelativeToCabalPackage stdlibPath addDependentFile fp src <- runIO (TIO.readFile stdlibPath) - ast <- parse stdlibPath src - pure ast + lbs <- compile stdlibPath src + pure lbs diff --git a/src/Language/Jsonnet/Syntax.hs b/src/Language/Jsonnet/Syntax.hs --- a/src/Language/Jsonnet/Syntax.hs +++ b/src/Language/Jsonnet/Syntax.hs @@ -1,11 +1,3 @@ -{- | -Module : Language.Jsonnet.Syntax -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} @@ -13,6 +5,13 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE TemplateHaskell #-} +-- | +-- Module : Language.Jsonnet.Syntax +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Syntax where import Control.Applicative (Const (..)) diff --git a/src/Language/Jsonnet/Syntax/Annotated.hs b/src/Language/Jsonnet/Syntax/Annotated.hs --- a/src/Language/Jsonnet/Syntax/Annotated.hs +++ b/src/Language/Jsonnet/Syntax/Annotated.hs @@ -1,11 +1,10 @@ -{- | -Module : Language.Jsonnet.Syntax.Annotated -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} +-- | +-- Module : Language.Jsonnet.Syntax.Annotated +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Syntax.Annotated where import Data.Fix diff --git a/src/Language/Jsonnet/TH.hs b/src/Language/Jsonnet/TH.hs --- a/src/Language/Jsonnet/TH.hs +++ b/src/Language/Jsonnet/TH.hs @@ -1,11 +1,3 @@ -{- | -Module : Language.Jsonnet.TH -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveLift #-} @@ -16,6 +8,13 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +-- | +-- Module : Language.Jsonnet.TH +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.TH where import Control.Monad.Except hiding (lift) @@ -27,12 +26,17 @@ import Language.Haskell.TH import Language.Haskell.TH.Syntax import Language.Jsonnet.Common +import Language.Jsonnet.Desugar +import Language.Jsonnet.Core import qualified Language.Jsonnet.Parser as Parser import Language.Jsonnet.Parser.SrcSpan import Language.Jsonnet.Pretty () import Language.Jsonnet.Syntax import Language.Jsonnet.Syntax.Annotated import Text.PrettyPrint.ANSI.Leijen (pretty) +import Data.Binary (Binary, encode) +import Language.Jsonnet.Annotate (annMap) +import Instances.TH.Lift () instance Data a => Lift (Arg a) where lift = liftData @@ -108,3 +112,23 @@ . ( Parser.parse path >=> Parser.resolveImports path ) + +parse0 :: FilePath -> Text -> Q Expr +parse0 path str = do + parse' str >>= \case + Left err -> fail (show $ pretty err) + Right res -> pure res + where + parse' = + runExceptT + . ( Parser.parse path + >=> Parser.resolveImports path + ) + +-- | compiles a Jsonnet program down to a Core expression stripped of +-- annotations +compile :: FilePath -> Text -> Q Exp +compile path str = do + ast <- parse0 path str + let core = desugar (annMap (const ()) ast) + lift $ encode core diff --git a/src/Language/Jsonnet/TH/QQ.hs b/src/Language/Jsonnet/TH/QQ.hs --- a/src/Language/Jsonnet/TH/QQ.hs +++ b/src/Language/Jsonnet/TH/QQ.hs @@ -1,11 +1,10 @@ -{- | -Module : Language.Jsonnet.TH.QQ -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} +-- | +-- Module : Language.Jsonnet.TH.QQ +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.TH.QQ where import qualified Data.Text as T @@ -15,7 +14,7 @@ jsonnet :: QuasiQuoter jsonnet = QuasiQuoter - { quoteExp = \str -> parse "" (T.pack str), + { quoteExp = parse "" . T.pack, quotePat = error "Usage as a pattern is not supported", quoteType = error "Usage as a type is not supported", quoteDec = error "Usage as a declaration is not supported" diff --git a/src/Language/Jsonnet/Value.hs b/src/Language/Jsonnet/Value.hs --- a/src/Language/Jsonnet/Value.hs +++ b/src/Language/Jsonnet/Value.hs @@ -1,11 +1,3 @@ -{- | -Module : Language.Jsonnet.Value -Copyright : (c) 2020-2021 Alexandre Moreno -SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 -Maintainer : Alexandre Moreno -Stability : experimental -Portability : non-portable --} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} @@ -15,6 +7,13 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} +-- | +-- Module : Language.Jsonnet.Value +-- Copyright : (c) 2020-2021 Alexandre Moreno +-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0 +-- Maintainer : Alexandre Moreno +-- Stability : experimental +-- Portability : non-portable module Language.Jsonnet.Value where import Control.Lens (view)