Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add several new entrypoints to Dhall module #2534

Merged
merged 2 commits into from
Oct 20, 2023
Merged
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
parseWithSettings :: InputSettings -> Text -> IO (Expr Src Import)
parseWithSettings :: MonadThrow m => InputSettings -> Text -> m (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 ()
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
typecheckWithSettings :: InputSettings -> Expr Src Void -> IO ()
typecheckWithSettings :: MonadThrow m => InputSettings -> Expr Src Void -> m ()

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm going to leave this as is for right now (as I'm trying to cut a release soon), and also because a MonadThrow constraint alone is not enough. It would need to also have MonadIO, but then you could subsume the MonadThrow constraint into the MonadIO constraint (by using liftIO . throwIO), and then I feel like leaving it as IO instead of MonadIO is preferable.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@Gabriella439 I think Dhall.Core.throws adds the necessity for IO, not Dhall.TypeChech.typeWith or Dhall.Parser.exprFromText. While I am really looking forward to a new release, I thought it might be best to change the API before that and not when it is already published and part of the user interface.

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 ()
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
expectWithSettings :: InputSettings -> Decoder a -> Expr Src Void -> IO ()
expectWithSettings :: MonadThrow m => InputSettings -> Decoder a -> Expr Src Void -> m ()

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