Dhall.TH: Register local imports for recompiliation checking

We call Language.Haskell.TH.addDependentFile for each local import so that GHC rebuilds if those files changes.
dhall-lang · Dec 7, 2024 · cbea45d · cbea45d
1 parent 44a9a39
commit cbea45d
Show file tree

Hide file tree

Showing 2 changed files with 40 additions and 5 deletions.
diff --git 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
@@ -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