ehmry/dhall-haskell
ehmry
/
dhall-haskell
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

dhall-lsp-server: Fix cache to correctly invalidate transitive dependencies (#1069) 

* Move "Dot" import graph generation to Dhall.Main

Previously `Dhall.Import` would generate the import graph in "dot"
format while resolving imports. This change simplifies `Dhall.Import` to
only keep track of the adjacency list representing the import graph,
moving the logic for generating "dot" files to Dhall.Main.

This change will allow us to implement proper cache invalidation for
`dhall-lsp-server`.

* Correctly invalidate transitive dependencies

Fixes dhall-lsp-server`s caching behaviour to correctly invalidate
cached imports that (possibly indirectly) depend on the changed file.

Example:

Suppose we have the following three files:
{- In A.dhall -} 2 : ./B.dhall
{- In B.dhall -} ./C.dhall
{- In C.dhall -} Natural

Previously, changing C.dhall to `Text` would not cause `A.dhall` to stop
type-checking, since the old version of `B.dhall` (which evaluated to
`Natural`) would still have been in the cache. This change fixes that
behaviour.

* Make edges of import graph self-documenting

As suggested by @Gabriel439

* Don't cache expressions manually

After computing the diagnostics for a given file we added its normal
form to the cache, but forgot to add its dependencies to the dependency
graph. This bug points out that keeping the import graph consistent
manually is probably not a good idea. With this commit we never mess
with the import cache manually; this means that files are only cached
once they are depended upon by some other file, potentially causing us
to duplicate work (but no more than once).

* Fix left-overs from previous commit
This commit is contained in:
Frederik Ramcke 2019-07-08 10:55:15 +00:00 committed by GitHub
parent aff138e192
commit 8ae7b603fe
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 93 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
dhall-lsp-server/src/Dhall/LSP/Backend/Dhall.hs
View File

@ -8,7 +8,6 @@ module Dhall.LSP.Backend.Dhall (
fromNormal,
Cache,
emptyCache,
cacheExpr,
invalidate,
DhallError(..),
parse,
@ -28,15 +27,15 @@ import qualified Dhall.Parser.Token as Dhall
import qualified Dhall.Parser as Dhall
import qualified Dhall.TypeCheck as Dhall
import qualified Text.Dot as Dot
import qualified Data.Graph as Graph
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Network.URI as URI
import qualified Language.Haskell.LSP.Types as LSP.Types
import qualified Data.Text as Text
import qualified Text.Megaparsec as Megaparsec
import Data.List.NonEmpty (NonEmpty((:|)))
import Crypto.Hash (Digest, SHA256)
import Data.Text (Text)
import System.FilePath (splitDirectories, takeFileName, takeDirectory)
import Lens.Family (view, set)
@ -77,23 +76,16 @@ newtype WellTyped = WellTyped {fromWellTyped :: Expr Src X}
-- | A fully normalised expression.
newtype Normal = Normal {fromNormal :: Expr Src X}
-- An import graph, represented by list of import dependencies.
type ImportGraph = [Dhall.Depends]
-- | A cache maps Dhall imports to fully normalised expressions. By reusing
-- caches we can speeds up diagnostics etc. significantly!
newtype Cache = Cache (Map.Map Dhall.Import (Dot.NodeId, Expr Src X))
data Cache = Cache ImportGraph (Map.Map Dhall.Import (Expr Src X))
-- | The initial cache.
emptyCache :: Cache
emptyCache = Cache Map.empty
-- | Cache a given normal expression.
cacheExpr :: FileIdentifier -> Normal -> Cache -> Cache
cacheExpr fileid (Normal expr) (Cache c) =
let unhashedImport = importFromFileIdentifier fileid
alpha = Dhall.alphaNormalize expr -- we need to alpha-normalise before
hash = Dhall.hashExpression maxBound alpha -- calculating the hash
hashedImport = hashedImportFromFileIdentifier fileid hash
in Cache $ Map.insert unhashedImport (Dot.userNodeId 0, expr)
$ Map.insert hashedImport (Dot.userNodeId 0, expr) c
emptyCache = Cache [] Map.empty
-- Construct the unhashed import corresponding to the given file.
importFromFileIdentifier :: FileIdentifier -> Dhall.Import
@ -102,25 +94,39 @@ importFromFileIdentifier (FileIdentifier importType) =
importMode = Dhall.Code }
-- Construct the hashed import corresponding to the given file.
hashedImportFromFileIdentifier :: FileIdentifier -> Digest SHA256 -> Dhall.Import
hashedImportFromFileIdentifier (FileIdentifier importType) hash =
Dhall.Import { importHashed = Dhall.ImportHashed (Just hash) importType,
importMode = Dhall.Code }
-- | Invalidate any _unhashed_ imports of the given file. Hashed imports are
-- kept around as per
-- https://github.com/dhall-lang/dhall-lang/blob/master/standard/imports.md.
-- Note to future self: this doesn't correctly invalidate reverse
-- dependencies, i.e. other cached expressions that imported the invalidated
-- one. We need to change the representation of the import graph in
-- Dhall.Import in order to be able to implement this correctly!
-- Transitively invalidates any imports depending on the changed file.
invalidate :: FileIdentifier -> Cache -> Cache
invalidate (FileIdentifier fileid) (Cache cache) =
Cache $ Map.delete codeImport (Map.delete textImport cache)
invalidate (FileIdentifier fileid) (Cache dependencies cache) =
Cache dependencies' $ Map.withoutKeys cache invalidImports
where
codeImport = Dhall.Import (Dhall.ImportHashed Nothing fileid) Dhall.Code
textImport = Dhall.Import (Dhall.ImportHashed Nothing fileid) Dhall.RawText
imports = map Dhall.parent dependencies ++ map Dhall.child dependencies
adjacencyLists = foldr
-- add reversed edges to adjacency lists
(\(Dhall.Depends parent child) -> Map.adjust (parent :) child)
-- starting from the discrete graph
(Map.fromList [ (i,[]) | i <- imports])
dependencies
(graph, importFromVertex, vertexFromImport) = Graph.graphFromEdges
[(node, node, neighbours) | (node, neighbours) <- Map.assocs adjacencyLists]
-- compute the reverse dependencies, i.e. the imports reachable in the transposed graph
reachableImports import_ =
map (\(i,_,_) -> i) . map importFromVertex . concat $
do vertex <- vertexFromImport import_
return (Graph.reachable graph vertex)
codeImport = Dhall.Import (Dhall.ImportHashed Nothing fileid) Dhall.Code
textImport = Dhall.Import (Dhall.ImportHashed Nothing fileid) Dhall.RawText
invalidImports = Set.fromList $ codeImport : reachableImports codeImport
++ textImport : reachableImports textImport
dependencies' = filter (\(Dhall.Depends parent child) -> Set.notMember parent invalidImports
&& Set.notMember child invalidImports) dependencies
-- | A Dhall error. Covers parsing, resolving of imports, typechecking and
-- normalisation.
@ -141,16 +147,18 @@ parseWithHeader = first ErrorParse . Dhall.exprAndHeaderFromText ""
-- | Resolve all imports in an expression.
load :: FileIdentifier -> Expr Src Dhall.Import -> Cache ->
IO (Either DhallError (Cache, Expr Src X))
load fileid expr (Cache cache) = do
load fileid expr (Cache graph cache) = do
let emptyStatus = Dhall.emptyStatus ""
status = -- reuse cache
status = -- reuse cache and import graph
set Dhall.cache cache .
set Dhall.graph graph .
-- set "root import"
set Dhall.stack (importFromFileIdentifier fileid :| [])
$ emptyStatus
(do (expr', status') <- runStateT (Dhall.loadWith expr) status
let cache' = Cache $ view Dhall.cache status'
return . Right $ (cache', expr'))
let cache' = view Dhall.cache status'
graph' = view Dhall.graph status'
return . Right $ (Cache graph' cache', expr'))
`catch` (\e -> return . Left $ ErrorImportSourced e)
`catch` (\e -> return . Left $ ErrorInternal e)

9
dhall-lsp-server/src/Dhall/LSP/Handlers.hs
View File

@ -13,8 +13,7 @@ import Dhall.Parser (Src(..))
import Dhall.TypeCheck (X)
import Dhall.LSP.Backend.Dhall (FileIdentifier, parse, load, typecheck,
normalize, fileIdentifierFromFilePath, fileIdentifierFromURI, invalidate,
cacheExpr, parseWithHeader)
fileIdentifierFromFilePath, fileIdentifierFromURI, invalidate, parseWithHeader)
import Dhall.LSP.Backend.Diagnostics (Range(..), Diagnosis(..), explain,
rangeFromDhall, diagnose)
import Dhall.LSP.Backend.Formatting (formatExprWithHeader)
@ -198,12 +197,10 @@ diagnosticsHandler uri = do
(cache', expr') <- case loaded of
Right x -> return x
Left err -> throwE err
welltyped <- case typecheck expr' of
_ <- case typecheck expr' of
Right (wt, _typ) -> return wt
Left err -> throwE err
let normal = normalize welltyped
-- cache the new expression
assign importCache (cacheExpr fileIdentifier normal cache')
assign importCache cache'
return Nothing
let suggestions =

41
dhall/src/Dhall/Import.hs
View File

@ -111,6 +111,8 @@ module Dhall.Import (
, emptyStatus
, stack
, cache
, Depends(..)
, graph
, manager
, standardVersion
, normalizer
@ -164,7 +166,6 @@ import Dhall.Core
import Dhall.Import.HTTP
#endif
import Dhall.Import.Types
import Text.Dot ((.->.), userNodeId)
import Dhall.Parser (Parser(..), ParseError(..), Src(..), SourcedException(..))
import Dhall.TypeCheck (X(..))
@ -784,15 +785,10 @@ loadWith expr₀ = case expr₀ of
then throwMissingImport (Imported _stack (Cycle import₀))
else do
case Map.lookup child _cache of
Just (childNode, expr) -> do
zoom dot . State.modify $ \getDot -> do
parentNode <- getDot
-- Add edge between parent and child
parentNode .->. childNode
-- Return parent NodeId
pure parentNode
Just expr -> do
zoom graph . State.modify $
-- Add the edge `parent -> child` to the import graph
\edges -> Depends parent child : edges
pure expr
Nothing -> do
@ -831,29 +827,14 @@ loadWith expr₀ = case expr₀ of
let stackWithNewImport = NonEmpty.cons newImport _stack
let childNodeId = userNodeId _nextNodeId
-- Increment the next node id
zoom nextNodeId $ State.modify succ
-- Make current node the dot graph
zoom dot . State.put $ importNode childNodeId child
zoom stack (State.put stackWithNewImport)
expr'' <- loadWith resolvedExpression
zoom stack (State.put _stack)
zoom dot . State.modify $ \getSubDot -> do
parentNode <- _dot
-- Get current node back from sub-graph
childNode <- getSubDot
-- Add edge between parent and child
parentNode .->. childNode
-- Return parent NodeId
pure parentNode
zoom graph . State.modify $
-- Add the edge `parent -> newImport` to the import graph,
-- where `newImport` is `child` with normalized headers.
\edges -> Depends parent newImport : edges
_cacher child expr''
@ -870,7 +851,7 @@ loadWith expr₀ = case expr₀ of
expr''' <- case Dhall.TypeCheck.typeWith _startingContext expr'' of
Left err -> throwM (Imported _stack' err)
Right _ -> return (Dhall.Core.normalizeWith _normalizer expr'')
zoom cache (State.modify' (Map.insert child (childNodeId, expr''')))
zoom cache (State.modify' (Map.insert child expr'''))
return expr'''
case hash (importHashed import₀) of

38
dhall/src/Dhall/Import/Types.hs
View File

@ -22,13 +22,11 @@ import Dhall.Core
, ImportMode (..)
, ImportType (..)
, ReifiedNormalizer(..)
, pretty
)
import Dhall.Parser (Src)
import Dhall.TypeCheck (X)
import Lens.Family (LensLike')
import System.FilePath (isRelative, splitDirectories)
import Text.Dot (Dot, NodeId, userNode, userNodeId)
import qualified Dhall.Binary
import qualified Dhall.Context
@ -43,19 +41,20 @@ data Resolved = Resolved
-- downstream imports
}
-- | `parent` imports (i.e. depends on) `child`
data Depends = Depends { parent :: Import, child :: Import }
-- | State threaded throughout the import process
data Status m = Status
{ _stack :: NonEmpty Import
-- ^ Stack of `Import`s that we've imported along the way to get to the
-- current point
, _dot :: Dot NodeId
-- ^ Graph of all the imports visited so far
, _graph :: [Depends]
-- ^ Graph of all the imports visited so far, represented by a list of
-- import dependencies.
, _nextNodeId :: Int
-- ^ Next node id to be used for the dot graph generation
, _cache :: Map Import (NodeId, Expr Src X)
, _cache :: Map Import (Expr Src X)
-- ^ Cache of imported expressions with their node id in order to avoid
-- importing the same expression twice with different values
@ -83,9 +82,7 @@ emptyStatusWith _resolver _cacher rootDirectory = Status {..}
where
_stack = pure rootImport
_dot = importNode (userNodeId 0) rootImport
_nextNodeId = 1
_graph = []
_cache = Map.empty
@ -114,26 +111,13 @@ emptyStatusWith _resolver _cacher rootDirectory = Status {..}
, importMode = Code
}
importNode :: NodeId -> Import -> Dot NodeId
importNode nodeId i = do
userNode
nodeId
[ ("label", Data.Text.unpack $ pretty i)
, ("shape", "box")
, ("style", "rounded")
]
pure nodeId
stack :: Functor f => LensLike' f (Status m) (NonEmpty Import)
stack k s = fmap (\x -> s { _stack = x }) (k (_stack s))
dot :: Functor f => LensLike' f (Status m) (Dot NodeId)
dot k s = fmap (\x -> s { _dot = x }) (k (_dot s))
graph :: Functor f => LensLike' f (Status m) [Depends]
graph k s = fmap (\x -> s { _graph = x }) (k (_graph s))
nextNodeId :: Functor f => LensLike' f (Status m) Int
nextNodeId k s = fmap (\x -> s { _nextNodeId = x }) (k (_nextNodeId s))
cache :: Functor f => LensLike' f (Status m) (Map Import (NodeId, Expr Src X))
cache :: Functor f => LensLike' f (Status m) (Map Import (Expr Src X))
cache k s = fmap (\x -> s { _cache = x }) (k (_cache s))
manager :: Functor f => LensLike' f (Status m) (Maybe Dynamic)

33
dhall/src/Dhall/Main.hs
View File

@ -21,14 +21,15 @@ module Dhall.Main
import Control.Applicative (optional, (<|>))
import Control.Exception (SomeException)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Text.Prettyprint.Doc (Doc, Pretty)
import Data.Version (showVersion)
import Dhall.Binary (StandardVersion)
import Dhall.Core (Expr(..), Import)
import Dhall.Core (Expr(..), Import, pretty)
import Dhall.Freeze (Intent(..), Scope(..))
import Dhall.Import (Imported(..))
import Dhall.Import (Imported(..), Depends(..))
import Dhall.Parser (Src)
import Dhall.Pretty (Ann, CharacterSet(..), annToAnsiStyle, layoutOpts)
import Dhall.TypeCheck (DetailedTypeError(..), TypeError, X)
@ -36,6 +37,7 @@ import Lens.Family (set)
import Options.Applicative (Parser, ParserInfo)
import System.Exit (exitFailure)
import System.IO (Handle)
import Text.Dot ((.->.))
import qualified Codec.CBOR.JSON
import qualified Codec.CBOR.Read
@ -389,12 +391,31 @@ command (Options {..}) = do
Resolve { resolveMode = Just Dot, ..} -> do
expression <- getExpression file
(Dhall.Import.Types.Status { _dot}) <-
(Dhall.Import.Types.Status { _graph, _stack }) <-
State.execStateT (Dhall.Import.loadWith expression) (toStatus file)
putStr . ("strict " <>) . Text.Dot.showDot $
Text.Dot.attribute ("rankdir", "LR") >>
_dot
let (rootImport :| _) = _stack
imports = rootImport : map parent _graph ++ map child _graph
importIds = Data.Map.fromList (zip imports [Text.Dot.userNodeId i | i <- [0..]])
let dotNode (i, nodeId) =
Text.Dot.userNode
nodeId
[ ("label", Data.Text.unpack $ pretty i)
, ("shape", "box")
, ("style", "rounded")
]
let dotEdge (Depends parent child) =
case (Data.Map.lookup parent importIds, Data.Map.lookup child importIds) of
(Just from, Just to) -> from .->. to
_ -> pure ()
let dot = do Text.Dot.attribute ("rankdir", "LR")
mapM_ dotNode (Data.Map.assocs importIds)
mapM_ dotEdge _graph
putStr . ("strict " <>) . Text.Dot.showDot $ dot
Resolve { resolveMode = Just ListImmediateDependencies, ..} -> do
expression <- getExpression file