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

Author: mmhat

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

@@ -7,7 +7,7 @@ import Dhall.Context                 (Context, empty, insert, toList)
 import Dhall.LSP.Backend.Diagnostics (Position, positionToOffset)
 import Dhall.LSP.Backend.Parsing     (holeExpr)
 import Dhall.Parser                  (Src, exprFromText)
-import Dhall.Pretty                  (UnescapedLabel(..))
+import Dhall.Pretty                  (UnescapedLabel (..))
 import Dhall.TypeCheck               (typeOf, typeWithA)
 import System.Directory              (doesDirectoryExist, listDirectory)
 import System.Environment            (getEnvironment)

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

@@ -28,28 +28,30 @@ import Data.Bifunctor                   (first)
 import Data.List.NonEmpty               (NonEmpty ((:|)))
 import Data.Text                        (Text)
 import Data.Void                        (Void)
+import Dhall                            (EvaluateSettings)
 import Network.URI                      (URI)
 import System.FilePath
     ( splitDirectories
     , takeDirectory
     , takeFileName
     )
 
-import qualified Data.Graph         as Graph
-import qualified Data.Map.Strict    as Map
-import qualified Data.Set           as Set
-import qualified Data.Text          as Text
-import qualified Dhall.Core         as Dhall
-import qualified Dhall.Import       as Dhall
+import qualified Data.Graph                  as Graph
+import qualified Data.Map.Strict             as Map
+import qualified Data.Set                    as Set
+import qualified Data.Text                   as Text
+import qualified Dhall
+import qualified Dhall.Core                  as Dhall
+import qualified Dhall.Import                as Import
 import qualified Dhall.Map
-import qualified Dhall.Parser       as Dhall
-import qualified Dhall.TypeCheck    as Dhall
+import qualified Dhall.Parser                as Dhall
+import qualified Dhall.TypeCheck             as Dhall
 import qualified Language.LSP.Protocol.Types as LSP.Types
-import qualified Network.URI        as URI
+import qualified Network.URI                 as URI
 
 
 -- | A @FileIdentifier@ represents either a local file or a remote url.
-newtype FileIdentifier = FileIdentifier Dhall.Chained
+newtype FileIdentifier = FileIdentifier Import.Chained
 
 -- | Construct a FileIdentifier from a local file path.
 fileIdentifierFromFilePath :: FilePath -> FileIdentifier
@@ -58,7 +60,7 @@ fileIdentifierFromFilePath path =
       directory = takeDirectory path
       components = map Text.pack . reverse . splitDirectories $ directory
       file = Dhall.File (Dhall.Directory components) filename
-  in FileIdentifier $ Dhall.chainedFromLocalHere Dhall.Absolute file Dhall.Code
+  in FileIdentifier $ Import.chainedFromLocalHere Dhall.Absolute file Dhall.Code
 
 -- | Construct a FileIdentifier from a given URI. Supports only "file:" URIs.
 fileIdentifierFromURI :: URI -> Maybe FileIdentifier
@@ -76,11 +78,11 @@ newtype WellTyped = WellTyped {fromWellTyped :: Expr Src Void}
 newtype Normal = Normal {fromNormal :: Expr Src Void}
 
 -- An import graph, represented by list of import dependencies.
-type ImportGraph = [Dhall.Depends]
+type ImportGraph = [Import.Depends]
 
 -- | A cache maps Dhall imports to fully normalised expressions. By reusing
 --   caches we can speeds up diagnostics etc. significantly!
-data Cache = Cache ImportGraph (Dhall.Map.Map Dhall.Chained Dhall.ImportSemantics)
+data Cache = Cache ImportGraph (Dhall.Map.Map Import.Chained Import.ImportSemantics)
 
 -- | The initial cache.
 emptyCache :: Cache
@@ -94,11 +96,11 @@ invalidate :: FileIdentifier -> Cache -> Cache
 invalidate (FileIdentifier chained) (Cache dependencies cache) =
   Cache dependencies' $ Dhall.Map.withoutKeys cache invalidImports
   where
-    imports = map Dhall.parent dependencies ++ map Dhall.child dependencies
+    imports = map Import.parent dependencies ++ map Import.child dependencies
 
     adjacencyLists = foldr
                        -- add reversed edges to adjacency lists
-                       (\(Dhall.Depends parent child) -> Map.adjust (parent :) child)
+                       (\(Import.Depends parent child) -> Map.adjust (parent :) child)
                        -- starting from the discrete graph
                        (Map.fromList [ (i,[]) | i <- imports])
                        dependencies
@@ -112,18 +114,18 @@ invalidate (FileIdentifier chained) (Cache dependencies cache) =
         do vertex <- vertexFromImport import_
            return (Graph.reachable graph vertex)
 
-    codeImport = Dhall.chainedChangeMode Dhall.Code chained
-    textImport = Dhall.chainedChangeMode Dhall.RawText chained
+    codeImport = Import.chainedChangeMode Dhall.Code chained
+    textImport = Import.chainedChangeMode Dhall.RawText chained
     invalidImports = Set.fromList $ codeImport : reachableImports codeImport
                                     ++ textImport : reachableImports textImport
 
-    dependencies' = filter (\(Dhall.Depends parent child) -> Set.notMember parent invalidImports
+    dependencies' = filter (\(Import.Depends parent child) -> Set.notMember parent invalidImports
                                 && Set.notMember child invalidImports) dependencies
 
 -- | A Dhall error. Covers parsing, resolving of imports, typechecking and
 --   normalisation.
 data DhallError = ErrorInternal SomeException
-                | ErrorImportSourced (Dhall.SourcedException Dhall.MissingImports)
+                | ErrorImportSourced (Dhall.SourcedException Import.MissingImports)
                 | ErrorTypecheck (Dhall.TypeError Src Void)
                 | ErrorParse Dhall.ParseError
 
@@ -137,38 +139,50 @@ parseWithHeader :: Text -> Either DhallError (Dhall.Header, Expr Src Dhall.Impor
 parseWithHeader = first ErrorParse . Dhall.exprAndHeaderFromText ""
 
 -- | Resolve all imports in an expression.
-load :: FileIdentifier -> Expr Src Dhall.Import -> Cache ->
-  IO (Either DhallError (Cache, Expr Src Void))
-load (FileIdentifier chained) expr (Cache graph cache) = do
-  let emptyStatus = Dhall.emptyStatus ""
-      status = -- reuse cache and import graph
-               set Dhall.cache cache .
-               set Dhall.graph graph .
+load
+    :: EvaluateSettings
+    -> FileIdentifier
+    -> Expr Src Dhall.Import
+    -> Cache
+    -> IO (Either DhallError (Cache, Expr Src Void))
+load settings (FileIdentifier chained) expr (Cache graph cache) = do
+  let emptyStatus =
+             set Import.substitutions   (view Dhall.substitutions settings)
+          .  set Import.normalizer      (view Dhall.normalizer settings)
+          .  set Import.startingContext (view Dhall.startingContext settings)
+          $ Import.emptyStatusWithManager (view Dhall.newManager settings) ""
+
+  let status = -- reuse cache and import graph
+               set Import.cache cache .
+               set Import.graph graph .
                -- set "root import"
-               set Dhall.stack (chained :| [])
+               set Import.stack (chained :| [])
                  $ emptyStatus
-  (do (expr', status') <- runStateT (Dhall.loadWith expr) status
-      let cache' = view Dhall.cache status'
-          graph' = view Dhall.graph status'
+  (do (expr', status') <- runStateT (Import.loadWith expr) status
+      let cache' = view Import.cache status'
+          graph' = view Import.graph status'
       return . Right $ (Cache graph' cache', expr'))
     `catch` (\e -> return . Left $ ErrorImportSourced e)
     `catch` (\e -> return . Left $ ErrorInternal e)
 
 -- | Typecheck a fully resolved expression. Returns a certification that the
 --   input was well-typed along with its (well-typed) type.
-typecheck :: Expr Src Void -> Either DhallError (WellTyped, WellTyped)
-typecheck expr = case Dhall.typeOf expr of
+typecheck
+    :: EvaluateSettings
+    -> Expr Src Void
+    -> Either DhallError (WellTyped, WellTyped)
+typecheck settings expr = case Dhall.typeWith (view Dhall.startingContext settings) expr of
   Left err -> Left $ ErrorTypecheck err
   Right typ -> Right (WellTyped expr, WellTyped typ)
 
 -- | Normalise a well-typed expression.
-normalize :: WellTyped -> Normal
-normalize (WellTyped expr) = Normal $ Dhall.normalize expr
+normalize :: EvaluateSettings -> WellTyped -> Normal
+normalize settings (WellTyped expr) = Normal $ Dhall.normalizeWith (view Dhall.normalizer settings) expr
 
 -- | Given a normal expression compute the hash (using the default standard
 --   version) of its alpha-normal form. Returns the hash in the format used in
 --   Dhall's hash annotations (prefixed by "sha256:" and base-64 encoded).
 hashNormalToCode :: Normal -> Text
 hashNormalToCode (Normal expr) =
-  Dhall.hashExpressionToCode (Dhall.denote alphaNormal)
+  Import.hashExpressionToCode (Dhall.denote alphaNormal)
   where alphaNormal = Dhall.alphaNormalize expr

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

@@ -7,6 +7,7 @@ module Dhall.LSP.Backend.Freezing (
 
 import Control.Lens                  (universeOf)
 import Data.Text                     (Text)
+import Dhall                         (EvaluateSettings)
 import Dhall.Core
     ( Expr (..)
     , Import (..)
@@ -37,16 +38,20 @@ import qualified Data.Text as Text
 
 -- | Given an expression (potentially still containing imports) compute its
 -- 'semantic' hash in the textual representation used to freeze Dhall imports.
-computeSemanticHash :: FileIdentifier -> Expr Src Import -> Cache ->
-  IO (Either DhallError (Cache, Text))
-computeSemanticHash fileid expr cache = do
-  loaded <- load fileid expr cache
+computeSemanticHash
+    :: EvaluateSettings
+    -> FileIdentifier
+    -> Expr Src Import
+    -> Cache
+    -> IO (Either DhallError (Cache, Text))
+computeSemanticHash settings fileid expr cache = do
+  loaded <- load settings fileid expr cache
   case loaded of
     Left err -> return (Left err)
-    Right (cache', expr') -> case typecheck expr' of
+    Right (cache', expr') -> case typecheck settings expr' of
       Left err -> return (Left err)
       Right (wt,_) ->
-        return (Right (cache', hashNormalToCode (normalize wt)))
+        return (Right (cache', hashNormalToCode (normalize settings wt)))
 
 stripHash :: Import -> Import
 stripHash (Import (ImportHashed _ importType) mode) =