diff --git a/dhall/src/Dhall.hs b/dhall/src/Dhall.hs index ca4d6a4b0..d6d4af53e 100644 --- a/dhall/src/Dhall.hs +++ b/dhall/src/Dhall.hs @@ -50,6 +50,7 @@ module Dhall -- * Individual phases , parseWithSettings , resolveWithSettings + , resolveAndStatusWithSettings , typecheckWithSettings , checkWithSettings , expectWithSettings @@ -63,7 +64,7 @@ import Control.Applicative (Alternative, empty) import Control.Monad.Catch (MonadThrow, throwM) import Data.Either.Validation (Validation (..)) import Data.Void (Void) -import Dhall.Import (Imported (..)) +import Dhall.Import (Imported (..), Status) import Dhall.Parser (Src (..)) import Dhall.Syntax (Expr (..), Import) import Dhall.TypeCheck (DetailedTypeError (..), TypeError) @@ -262,7 +263,16 @@ expectWithSettings settings Decoder{..} expression = do `InputSettings` -} resolveWithSettings :: InputSettings -> Expr Src Import -> IO (Expr Src Void) -resolveWithSettings settings expression = do +resolveWithSettings settings expression = + fst <$> resolveAndStatusWithSettings settings expression + +-- | A version of 'resolveWithSettings' that also returns the import 'Status' +-- together with the resolved expression. +resolveAndStatusWithSettings + :: InputSettings + -> Expr Src Import + -> IO (Expr Src Void, Status) +resolveAndStatusWithSettings settings expression = do let InputSettings{..} = settings let EvaluateSettings{..} = _evaluateSettings @@ -274,9 +284,11 @@ resolveWithSettings settings expression = do let status = transform (Dhall.Import.emptyStatusWithManager _newManager _rootDirectory) - resolved <- State.evalStateT (Dhall.Import.loadWith expression) status + (resolved, status') <- State.runStateT (Dhall.Import.loadWith expression) status + + let substituted = Dhall.Substitution.substitute resolved (view substitutions settings) - pure (Dhall.Substitution.substitute resolved (view substitutions settings)) + pure (substituted, status') -- | Normalize an expression, using the supplied `InputSettings` normalizeWithSettings :: InputSettings -> Expr Src Void -> Expr Src Void diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs index 1baa77a23..613b49a2a 100644 --- a/dhall/src/Dhall/TH.hs +++ b/dhall/src/Dhall/TH.hs @@ -20,12 +20,14 @@ module Dhall.TH , defaultGenerateOptions ) where +import Control.Monad (forM_) import Data.Bifunctor (first) import Data.Text (Text) import Dhall (FromDhall, ToDhall) import Dhall.Syntax (Expr (..), FunctionBinding (..), Var (..)) import GHC.Generics (Generic) import Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ) +import Lens.Family (view) import Prettyprinter (Pretty) import Language.Haskell.TH.Syntax @@ -52,6 +54,7 @@ import qualified Data.Time as Time import qualified Data.Typeable as Typeable import qualified Dhall import qualified Dhall.Core as Core +import qualified Dhall.Import import qualified Dhall.Map import qualified Dhall.Pretty import qualified Dhall.Util @@ -90,7 +93,27 @@ staticDhallExpression :: Text -> Q Exp staticDhallExpression text = do TH.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8) - expression <- TH.runIO (Dhall.inputExpr text) + (expression, status) <- TH.runIO $ do + parsed <- Dhall.parseWithSettings Dhall.defaultInputSettings text + + (resolved, status) <- Dhall.resolveAndStatusWithSettings Dhall.defaultInputSettings parsed + + _ <- Dhall.typecheckWithSettings Dhall.defaultInputSettings resolved + + let normalized = Dhall.normalizeWithSettings Dhall.defaultInputSettings resolved + + pure (normalized, status) + + forM_ (Dhall.Map.keys (view Dhall.Import.cache status)) $ \chained -> + case Dhall.Import.chainedImport chained of + Core.Import + { importHashed = Core.ImportHashed + { importType = Core.Local prefix file + } + } -> do + fp <- Dhall.Import.localToPath prefix file + TH.addDependentFile fp + _ -> return () dataToExpQ (fmap liftText . Typeable.cast) expression where