diff --git a/dhall/src/Dhall.hs b/dhall/src/Dhall.hs index e2d11dcbe..310472647 100644 --- a/dhall/src/Dhall.hs +++ b/dhall/src/Dhall.hs @@ -24,6 +24,10 @@ module Dhall , inputFileWithSettings , inputExpr , inputExprWithSettings + , interpretExpr + , interpretExprWithSettings + , fromExpr + , fromExprWithSettings , rootDirectory , sourceName , startingContext @@ -43,6 +47,13 @@ module Dhall -- * Encoders , module Dhall.Marshal.Encode + -- * Individual phases + , parseWithSettings + , resolveWithSettings + , typecheckWithSettings + , expectWithSettings + , normalizeWithSettings + -- * Miscellaneous , rawInput ) where @@ -52,7 +63,7 @@ import Data.Either.Validation (Validation (..)) import Data.Void (Void) import Dhall.Import (Imported (..)) import Dhall.Parser (Src (..)) -import Dhall.Syntax (Expr (..)) +import Dhall.Syntax (Expr (..), Import) import Dhall.TypeCheck (DetailedTypeError (..), TypeError) import GHC.Generics import Lens.Family (LensLike', view) @@ -195,6 +206,68 @@ instance HasEvaluateSettings InputSettings where instance HasEvaluateSettings EvaluateSettings where evaluateSettings = id +-- | Parse an expression, using the supplied `InputSettings` +parseWithSettings :: InputSettings -> Text -> IO (Expr Src Import) +parseWithSettings settings text = do + Core.throws (Dhall.Parser.exprFromText (view sourceName settings) text) + +-- | Type-check an expression, using the supplied `InputSettings` +typecheckWithSettings :: InputSettings -> Expr Src Void -> IO () +typecheckWithSettings settings expression = do + _ <- Core.throws (Dhall.TypeCheck.typeWith (view startingContext settings) expression) + + return () + +{-| Type-check an expression against a `Decoder`'s expected type, using the + supplied `InputSettings` +-} +expectWithSettings :: InputSettings -> Decoder a -> Expr Src Void -> IO () +expectWithSettings settings Decoder{..} expression = do + expected' <- case expected of + Success x -> return x + Failure e -> Control.Exception.throwIO e + + let suffix = Dhall.Pretty.Internal.prettyToStrictText expected' + + let annotated = case expression of + Note (Src begin end bytes) _ -> + Note (Src begin end bytes') (Annot expression expected') + where + bytes' = bytes <> " : " <> suffix + _ -> + Annot expression expected' + + typecheckWithSettings settings annotated + + return () + +{-| Resolve an expression, using the supplied `InputSettings` + + Note that this also applies any substitutions specified in the + `InputSettings` +-} +resolveWithSettings :: InputSettings -> Expr Src Import -> IO (Expr Src Void) +resolveWithSettings settings expression = do + let InputSettings{..} = settings + + let EvaluateSettings{..} = _evaluateSettings + + let transform = + Lens.Family.set Dhall.Import.substitutions _substitutions + . Lens.Family.set Dhall.Import.normalizer _normalizer + . Lens.Family.set Dhall.Import.startingContext _startingContext + + let status = transform (Dhall.Import.emptyStatusWithManager _newManager _rootDirectory) + + resolved <- State.evalStateT (Dhall.Import.loadWith expression) status + + pure (Dhall.Substitution.substitute resolved (view substitutions settings)) + +-- | Normalize an expression, using the supplied `InputSettings` +normalizeWithSettings :: InputSettings -> Expr Src Void -> Expr Src Void +normalizeWithSettings settings = + Core.normalizeWith (view normalizer settings) + {-| Type-check and evaluate a Dhall program, decoding the result into Haskell The first argument determines the type of value that you decode: @@ -236,24 +309,17 @@ inputWithSettings -- ^ The Dhall program -> IO a -- ^ The decoded value in Haskell -inputWithSettings settings (Decoder {..}) txt = do - expected' <- case expected of - Success x -> return x - Failure e -> Control.Exception.throwIO e +inputWithSettings settings decoder@Decoder{..} text = do + parsed <- parseWithSettings settings text - let suffix = Dhall.Pretty.Internal.prettyToStrictText expected' - let annotate substituted = case substituted of - Note (Src begin end bytes) _ -> - Note (Src begin end bytes') (Annot substituted expected') - where - bytes' = bytes <> " : " <> suffix - _ -> - Annot substituted expected' + resolved <- resolveWithSettings settings parsed - normExpr <- inputHelper annotate settings txt + expectWithSettings settings decoder resolved - case extract normExpr of - Success x -> return x + let normalized = normalizeWithSettings settings resolved + + case extract normalized of + Success x -> return x Failure e -> Control.Exception.throwIO e {-| Type-check and evaluate a Dhall program that is read from the @@ -320,39 +386,51 @@ inputExprWithSettings -- ^ The Dhall program -> IO (Expr Src Void) -- ^ The fully normalized AST -inputExprWithSettings = inputHelper id +inputExprWithSettings settings text = do + parsed <- parseWithSettings settings text + + resolved <- resolveWithSettings settings parsed + + _ <- typecheckWithSettings settings resolved + + pure (Core.normalizeWith (view normalizer settings) resolved) -{-| Helper function for the input* function family +{-| Interpret a Dhall Expression -@since 1.30 + This takes care of import resolution, type-checking, and normalization -} -inputHelper - :: (Expr Src Void -> Expr Src Void) - -> InputSettings - -> Text - -- ^ The Dhall program - -> IO (Expr Src Void) - -- ^ The fully normalized AST -inputHelper annotate settings txt = do - expr <- Core.throws (Dhall.Parser.exprFromText (view sourceName settings) txt) +interpretExpr :: Expr Src Import -> IO (Expr Src Void) +interpretExpr = interpretExprWithSettings defaultInputSettings - let InputSettings {..} = settings +-- | Like `interpretExpr`, but customizable using `InputSettings` +interpretExprWithSettings + :: InputSettings -> Expr Src Import -> IO (Expr Src Void) +interpretExprWithSettings settings parsed = do + resolved <- resolveWithSettings settings parsed - let EvaluateSettings {..} = _evaluateSettings + typecheckWithSettings settings resolved - let transform = - Lens.Family.set Dhall.Import.substitutions _substitutions - . Lens.Family.set Dhall.Import.normalizer _normalizer - . Lens.Family.set Dhall.Import.startingContext _startingContext + pure (Core.normalizeWith (view normalizer settings) resolved) - let status = transform (Dhall.Import.emptyStatusWithManager _newManager _rootDirectory) +{- | Decode a Dhall expression + + This takes care of import resolution, type-checking and normalization +-} +fromExpr :: Decoder a -> Expr Src Import -> IO a +fromExpr = fromExprWithSettings defaultInputSettings + +-- | Like `fromExpr`, but customizable using `InputSettings` +fromExprWithSettings :: InputSettings -> Decoder a -> Expr Src Import -> IO a +fromExprWithSettings settings decoder@Decoder{..} expression = do + resolved <- resolveWithSettings settings expression - expr' <- State.evalStateT (Dhall.Import.loadWith expr) status + expectWithSettings settings decoder resolved - let substituted = Dhall.Substitution.substitute expr' $ view substitutions settings - let annot = annotate substituted - _ <- Core.throws (Dhall.TypeCheck.typeWith (view startingContext settings) annot) - pure (Core.normalizeWith (view normalizer settings) substituted) + let normalized = Core.normalizeWith (view normalizer settings) resolved + + case extract normalized of + Success x -> return x + Failure e -> Control.Exception.throwIO e -- | Use this function to extract Haskell values directly from Dhall AST. -- The intended use case is to allow easy extraction of Dhall values for