Skip to content

Commit

Permalink
Add several new entrypoints to Dhall module (#2534)
Browse files Browse the repository at this point in the history
This adds the following four new high-level entrypoints:

- `interpretExpr`
- `interpretExprWithSettings`
- `fromExpr`
- `fromExprWithSettings`

… as well as several new utilities for running each phase one at a
time, respecting `InputSettings`:

- `parseWithSettings`
- `resolveWithSettings`
- `typecheckWithSettings`
- `expectWithSettings`
- `normalizeWithSettings`

This also refactors the other utilities to use those new phase-based
settings.

The motivation behind this change is to make it easier for people
to work with raw `Expr`s, so that people don't need to craft strings
when trying to assemble ASTs to interpret like in this issue:

https://stackoverflow.com/questions/77037023/is-there-an-elegant-way-to-override-dhall-records-in-haskell
  • Loading branch information
Gabriella439 authored Oct 20, 2023
1 parent c566f30 commit df8ff09
Showing 1 changed file with 118 additions and 40 deletions.
158 changes: 118 additions & 40 deletions dhall/src/Dhall.hs
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,10 @@ module Dhall
, inputFileWithSettings
, inputExpr
, inputExprWithSettings
, interpretExpr
, interpretExprWithSettings
, fromExpr
, fromExprWithSettings
, rootDirectory
, sourceName
, startingContext
Expand All @@ -43,6 +47,13 @@ module Dhall
-- * Encoders
, module Dhall.Marshal.Encode

-- * Individual phases
, parseWithSettings
, resolveWithSettings
, typecheckWithSettings
, expectWithSettings
, normalizeWithSettings

-- * Miscellaneous
, rawInput
) where
Expand All @@ -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)
Expand Down Expand Up @@ -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:
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit df8ff09

Please sign in to comment.