Skip to content

Commit cd46573

Browse files
mmhatmmhat
authored
Add an LSP server entrypoint that takes some EvaluateSettings (#2614)
* dhall-lsp-server: Provide an entrypoint that takes some EvaluateSettings * Ran stylish-haskell on dhall-lsp-server package * Added some CPP to suppress incomplete-patterns warning in dhall-lsp-server package * Expose runWith entrypoint
1 parent d1fc29b commit cd46573

File tree

6 files changed

+188
-134
lines changed

6 files changed

+188
-134
lines changed

‎dhall-lsp-server/src/Dhall/LSP/Backend/Completion.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ import Dhall.Context (Context, empty, insert, toList)
77
import Dhall.LSP.Backend.Diagnostics (Position, positionToOffset)
88
import Dhall.LSP.Backend.Parsing (holeExpr)
99
import Dhall.Parser (Src, exprFromText)
10-
import Dhall.Pretty (UnescapedLabel(..))
10+
import Dhall.Pretty (UnescapedLabel (..))
1111
import Dhall.TypeCheck (typeOf, typeWithA)
1212
import System.Directory (doesDirectoryExist, listDirectory)
1313
import System.Environment (getEnvironment)

‎dhall-lsp-server/src/Dhall/LSP/Backend/Dhall.hs

Lines changed: 49 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -28,28 +28,30 @@ import Data.Bifunctor (first)
2828
import Data.List.NonEmpty (NonEmpty ((:|)))
2929
import Data.Text (Text)
3030
import Data.Void (Void)
31+
import Dhall (EvaluateSettings)
3132
import Network.URI (URI)
3233
import System.FilePath
3334
( splitDirectories
3435
, takeDirectory
3536
, takeFileName
3637
)
3738

38-
import qualified Data.Graph as Graph
39-
import qualified Data.Map.Strict as Map
40-
import qualified Data.Set as Set
41-
import qualified Data.Text as Text
42-
import qualified Dhall.Core as Dhall
43-
import qualified Dhall.Import as Dhall
39+
import qualified Data.Graph as Graph
40+
import qualified Data.Map.Strict as Map
41+
import qualified Data.Set as Set
42+
import qualified Data.Text as Text
43+
import qualified Dhall
44+
import qualified Dhall.Core as Dhall
45+
import qualified Dhall.Import as Import
4446
import qualified Dhall.Map
45-
import qualified Dhall.Parser as Dhall
46-
import qualified Dhall.TypeCheck as Dhall
47+
import qualified Dhall.Parser as Dhall
48+
import qualified Dhall.TypeCheck as Dhall
4749
import qualified Language.LSP.Protocol.Types as LSP.Types
48-
import qualified Network.URI as URI
50+
import qualified Network.URI as URI
4951

5052

5153
-- | A @FileIdentifier@ represents either a local file or a remote url.
52-
newtype FileIdentifier = FileIdentifier Dhall.Chained
54+
newtype FileIdentifier = FileIdentifier Import.Chained
5355

5456
-- | Construct a FileIdentifier from a local file path.
5557
fileIdentifierFromFilePath :: FilePath -> FileIdentifier
@@ -58,7 +60,7 @@ fileIdentifierFromFilePath path =
5860
directory = takeDirectory path
5961
components = map Text.pack . reverse . splitDirectories $ directory
6062
file = Dhall.File (Dhall.Directory components) filename
61-
in FileIdentifier $ Dhall.chainedFromLocalHere Dhall.Absolute file Dhall.Code
63+
in FileIdentifier $ Import.chainedFromLocalHere Dhall.Absolute file Dhall.Code
6264

6365
-- | Construct a FileIdentifier from a given URI. Supports only "file:" URIs.
6466
fileIdentifierFromURI :: URI -> Maybe FileIdentifier
@@ -76,11 +78,11 @@ newtype WellTyped = WellTyped {fromWellTyped :: Expr Src Void}
7678
newtype Normal = Normal {fromNormal :: Expr Src Void}
7779

7880
-- An import graph, represented by list of import dependencies.
79-
type ImportGraph = [Dhall.Depends]
81+
type ImportGraph = [Import.Depends]
8082

8183
-- | A cache maps Dhall imports to fully normalised expressions. By reusing
8284
-- caches we can speeds up diagnostics etc. significantly!
83-
data Cache = Cache ImportGraph (Dhall.Map.Map Dhall.Chained Dhall.ImportSemantics)
85+
data Cache = Cache ImportGraph (Dhall.Map.Map Import.Chained Import.ImportSemantics)
8486

8587
-- | The initial cache.
8688
emptyCache :: Cache
@@ -94,11 +96,11 @@ invalidate :: FileIdentifier -> Cache -> Cache
9496
invalidate (FileIdentifier chained) (Cache dependencies cache) =
9597
Cache dependencies' $ Dhall.Map.withoutKeys cache invalidImports
9698
where
97-
imports = map Dhall.parent dependencies ++ map Dhall.child dependencies
99+
imports = map Import.parent dependencies ++ map Import.child dependencies
98100

99101
adjacencyLists = foldr
100102
-- add reversed edges to adjacency lists
101-
(\(Dhall.Depends parent child) -> Map.adjust (parent :) child)
103+
(\(Import.Depends parent child) -> Map.adjust (parent :) child)
102104
-- starting from the discrete graph
103105
(Map.fromList [ (i,[]) | i <- imports])
104106
dependencies
@@ -112,18 +114,18 @@ invalidate (FileIdentifier chained) (Cache dependencies cache) =
112114
do vertex <- vertexFromImport import_
113115
return (Graph.reachable graph vertex)
114116

115-
codeImport = Dhall.chainedChangeMode Dhall.Code chained
116-
textImport = Dhall.chainedChangeMode Dhall.RawText chained
117+
codeImport = Import.chainedChangeMode Dhall.Code chained
118+
textImport = Import.chainedChangeMode Dhall.RawText chained
117119
invalidImports = Set.fromList $ codeImport : reachableImports codeImport
118120
++ textImport : reachableImports textImport
119121

120-
dependencies' = filter (\(Dhall.Depends parent child) -> Set.notMember parent invalidImports
122+
dependencies' = filter (\(Import.Depends parent child) -> Set.notMember parent invalidImports
121123
&& Set.notMember child invalidImports) dependencies
122124

123125
-- | A Dhall error. Covers parsing, resolving of imports, typechecking and
124126
-- normalisation.
125127
data DhallError = ErrorInternal SomeException
126-
| ErrorImportSourced (Dhall.SourcedException Dhall.MissingImports)
128+
| ErrorImportSourced (Dhall.SourcedException Import.MissingImports)
127129
| ErrorTypecheck (Dhall.TypeError Src Void)
128130
| ErrorParse Dhall.ParseError
129131

@@ -137,38 +139,50 @@ parseWithHeader :: Text -> Either DhallError (Dhall.Header, Expr Src Dhall.Impor
137139
parseWithHeader = first ErrorParse . Dhall.exprAndHeaderFromText ""
138140

139141
-- | Resolve all imports in an expression.
140-
load :: FileIdentifier -> Expr Src Dhall.Import -> Cache ->
141-
IO (Either DhallError (Cache, Expr Src Void))
142-
load (FileIdentifier chained) expr (Cache graph cache) = do
143-
let emptyStatus = Dhall.emptyStatus ""
144-
status = -- reuse cache and import graph
145-
set Dhall.cache cache .
146-
set Dhall.graph graph .
142+
load
143+
:: EvaluateSettings
144+
-> FileIdentifier
145+
-> Expr Src Dhall.Import
146+
-> Cache
147+
-> IO (Either DhallError (Cache, Expr Src Void))
148+
load settings (FileIdentifier chained) expr (Cache graph cache) = do
149+
let emptyStatus =
150+
set Import.substitutions (view Dhall.substitutions settings)
151+
. set Import.normalizer (view Dhall.normalizer settings)
152+
. set Import.startingContext (view Dhall.startingContext settings)
153+
$ Import.emptyStatusWithManager (view Dhall.newManager settings) ""
154+
155+
let status = -- reuse cache and import graph
156+
set Import.cache cache .
157+
set Import.graph graph .
147158
-- set "root import"
148-
set Dhall.stack (chained :| [])
159+
set Import.stack (chained :| [])
149160
$ emptyStatus
150-
(do (expr', status') <- runStateT (Dhall.loadWith expr) status
151-
let cache' = view Dhall.cache status'
152-
graph' = view Dhall.graph status'
161+
(do (expr', status') <- runStateT (Import.loadWith expr) status
162+
let cache' = view Import.cache status'
163+
graph' = view Import.graph status'
153164
return . Right $ (Cache graph' cache', expr'))
154165
`catch` (\e -> return . Left $ ErrorImportSourced e)
155166
`catch` (\e -> return . Left $ ErrorInternal e)
156167

157168
-- | Typecheck a fully resolved expression. Returns a certification that the
158169
-- input was well-typed along with its (well-typed) type.
159-
typecheck :: Expr Src Void -> Either DhallError (WellTyped, WellTyped)
160-
typecheck expr = case Dhall.typeOf expr of
170+
typecheck
171+
:: EvaluateSettings
172+
-> Expr Src Void
173+
-> Either DhallError (WellTyped, WellTyped)
174+
typecheck settings expr = case Dhall.typeWith (view Dhall.startingContext settings) expr of
161175
Left err -> Left $ ErrorTypecheck err
162176
Right typ -> Right (WellTyped expr, WellTyped typ)
163177

164178
-- | Normalise a well-typed expression.
165-
normalize :: WellTyped -> Normal
166-
normalize (WellTyped expr) = Normal $ Dhall.normalize expr
179+
normalize :: EvaluateSettings -> WellTyped -> Normal
180+
normalize settings (WellTyped expr) = Normal $ Dhall.normalizeWith (view Dhall.normalizer settings) expr
167181

168182
-- | Given a normal expression compute the hash (using the default standard
169183
-- version) of its alpha-normal form. Returns the hash in the format used in
170184
-- Dhall's hash annotations (prefixed by "sha256:" and base-64 encoded).
171185
hashNormalToCode :: Normal -> Text
172186
hashNormalToCode (Normal expr) =
173-
Dhall.hashExpressionToCode (Dhall.denote alphaNormal)
187+
Import.hashExpressionToCode (Dhall.denote alphaNormal)
174188
where alphaNormal = Dhall.alphaNormalize expr

‎dhall-lsp-server/src/Dhall/LSP/Backend/Freezing.hs

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ module Dhall.LSP.Backend.Freezing (
77

88
import Control.Lens (universeOf)
99
import Data.Text (Text)
10+
import Dhall (EvaluateSettings)
1011
import Dhall.Core
1112
( Expr (..)
1213
, Import (..)
@@ -37,16 +38,20 @@ import qualified Data.Text as Text
3738

3839
-- | Given an expression (potentially still containing imports) compute its
3940
-- 'semantic' hash in the textual representation used to freeze Dhall imports.
40-
computeSemanticHash :: FileIdentifier -> Expr Src Import -> Cache ->
41-
IO (Either DhallError (Cache, Text))
42-
computeSemanticHash fileid expr cache = do
43-
loaded <- load fileid expr cache
41+
computeSemanticHash
42+
:: EvaluateSettings
43+
-> FileIdentifier
44+
-> Expr Src Import
45+
-> Cache
46+
-> IO (Either DhallError (Cache, Text))
47+
computeSemanticHash settings fileid expr cache = do
48+
loaded <- load settings fileid expr cache
4449
case loaded of
4550
Left err -> return (Left err)
46-
Right (cache', expr') -> case typecheck expr' of
51+
Right (cache', expr') -> case typecheck settings expr' of
4752
Left err -> return (Left err)
4853
Right (wt,_) ->
49-
return (Right (cache', hashNormalToCode (normalize wt)))
54+
return (Right (cache', hashNormalToCode (normalize settings wt)))
5055

5156
stripHash :: Import -> Import
5257
stripHash (Import (ImportHashed _ importType) mode) =

0 commit comments

Comments
 (0)