{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP            #-}
{-# LANGUAGE DataKinds      #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE MultiWayIf     #-}
{-# LANGUAGE ViewPatterns   #-}

module Dhall.LSP.Handlers where

import Data.Void    (Void)
import Dhall.Core
    ( Expr (Embed, Note)
    , Import (..)
    , ImportHashed (..)
    , ImportType (..)
    , headers
    , pretty
    )
import Dhall.Import (localToPath)
import Dhall.Parser (Src (..))

import Dhall.LSP.Backend.Completion
    ( Completion (..)
    , buildCompletionContext
    , completeEnvironmentImport
    , completeFromContext
    , completeLocalImport
    , completeProjections
    , completionQueryAt
    )
import Dhall.LSP.Backend.Dhall
    ( FileIdentifier
    , fileIdentifierFromFilePath
    , fileIdentifierFromURI
    , invalidate
    , load
    , parse
    , parseWithHeader
    , typecheck
    )
import Dhall.LSP.Backend.Diagnostics
    ( Diagnosis (..)
    , Range (..)
    , diagnose
    , embedsWithRanges
    , explain
    , rangeFromDhall
    )
import Dhall.LSP.Backend.Formatting  (formatExpr, formatExprWithHeader)
import Dhall.LSP.Backend.Freezing
    ( computeSemanticHash
    , getAllImportsWithHashPositions
    , getImportHashPosition
    , stripHash
    )
import Dhall.LSP.Backend.Linting     (Suggestion (..), lint, suggest)
import Dhall.LSP.Backend.Parsing     (binderExprFromText)
import Dhall.LSP.Backend.Typing      (annotateLet, exprAt, typeAt)
import Dhall.LSP.State

import Control.Applicative              ((<|>))
import Control.Lens                     (assign, modifying, use, (^.))
import Control.Monad                    (forM, guard)
import Control.Monad.Trans              (lift, liftIO)
import Control.Monad.Trans.Except       (catchE, throwE)
import Data.Aeson                       (FromJSON(..), Value(..))
import Data.Maybe                       (maybeToList)
import Data.Text                        (Text, isPrefixOf)
import Language.LSP.Server              (Handlers, LspT)
import Language.LSP.Types               hiding (Range(..), line)
import Language.LSP.Types.Lens
import System.FilePath
import Text.Megaparsec                  (SourcePos (..), unPos)

import qualified Data.Aeson              as Aeson
import qualified Data.HashMap.Strict     as HashMap
import qualified Data.Map.Strict         as Map
import qualified Data.Rope.UTF16         as Rope
import qualified Data.Text               as Text
import qualified Language.LSP.Server     as LSP
import qualified Language.LSP.Types      as LSP.Types
import qualified Language.LSP.VFS        as LSP
import qualified Network.URI             as URI
import qualified Network.URI.Encode      as URI

liftLSP :: LspT ServerConfig IO a -> HandlerM a
liftLSP :: LspT ServerConfig IO a -> HandlerM a
liftLSP LspT ServerConfig IO a
m = StateT ServerState (LspT ServerConfig IO) a -> HandlerM a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LspT ServerConfig IO a
-> StateT ServerState (LspT ServerConfig IO) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LspT ServerConfig IO a
m)

-- | A helper function to query haskell-lsp's VFS.
readUri :: Uri -> HandlerM Text
readUri :: Uri -> HandlerM Text
readUri Uri
uri_ = do
  Maybe VirtualFile
mVirtualFile <- LspT ServerConfig IO (Maybe VirtualFile)
-> HandlerM (Maybe VirtualFile)
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP (NormalizedUri -> LspT ServerConfig IO (Maybe VirtualFile)
forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
LSP.getVirtualFile (Uri -> NormalizedUri
LSP.Types.toNormalizedUri Uri
uri_))
  case Maybe VirtualFile
mVirtualFile of
    Just (LSP.VirtualFile Int32
_ Int
_ Rope
rope) -> Text -> HandlerM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Rope -> Text
Rope.toText Rope
rope)
    Maybe VirtualFile
Nothing -> (Severity, Text) -> HandlerM Text
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Error, Text
"Could not find " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Uri -> String
forall a. Show a => a -> String
show Uri
uri_) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in VFS.")

loadFile :: Uri -> HandlerM (Expr Src Void)
loadFile :: Uri -> HandlerM (Expr Src Void)
loadFile Uri
uri_ = do
  Text
txt <- Uri -> HandlerM Text
readUri Uri
uri_
  FileIdentifier
fileIdentifier <- Uri -> HandlerM FileIdentifier
fileIdentifierFromUri Uri
uri_
  Cache
cache <- Getting Cache ServerState Cache
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) Cache
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Cache ServerState Cache
Lens' ServerState Cache
importCache

  Expr Src Import
expr <- case Text -> Either DhallError (Expr Src Import)
parse Text
txt of
    Right Expr Src Import
e -> Expr Src Import
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Expr Src Import)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Import
e
    Either DhallError (Expr Src Import)
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Expr Src Import)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Error, Text
"Failed to parse Dhall file.")

  Either DhallError (Cache, Expr Src Void)
loaded <- IO (Either DhallError (Cache, Expr Src Void))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Expr Src Void))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either DhallError (Cache, Expr Src Void))
 -> ExceptT
      (Severity, Text)
      (StateT ServerState (LspT ServerConfig IO))
      (Either DhallError (Cache, Expr Src Void)))
-> IO (Either DhallError (Cache, Expr Src Void))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Expr Src Void))
forall a b. (a -> b) -> a -> b
$ FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Expr Src Void))
load FileIdentifier
fileIdentifier Expr Src Import
expr Cache
cache
  (Cache
cache', Expr Src Void
expr') <- case Either DhallError (Cache, Expr Src Void)
loaded of
    Right (Cache, Expr Src Void)
x -> (Cache, Expr Src Void)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Cache, Expr Src Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Cache, Expr Src Void)
x
    Either DhallError (Cache, Expr Src Void)
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Cache, Expr Src Void)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Error, Text
"Failed to resolve imports.")
  -- Update cache. Don't cache current expression because it might not have been
  -- written to disk yet (readUri reads from the VFS).
  ASetter ServerState ServerState Cache Cache
-> Cache
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter ServerState ServerState Cache Cache
Lens' ServerState Cache
importCache Cache
cache'
  Expr Src Void -> HandlerM (Expr Src Void)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Void
expr'

-- helper
fileIdentifierFromUri :: Uri -> HandlerM FileIdentifier
fileIdentifierFromUri :: Uri -> HandlerM FileIdentifier
fileIdentifierFromUri Uri
uri_ =
  let mFileIdentifier :: Maybe FileIdentifier
mFileIdentifier = (String -> FileIdentifier) -> Maybe String -> Maybe FileIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> FileIdentifier
fileIdentifierFromFilePath (Uri -> Maybe String
uriToFilePath Uri
uri_)
                        Maybe FileIdentifier
-> Maybe FileIdentifier -> Maybe FileIdentifier
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do URI
uri' <- (String -> Maybe URI
URI.parseURI (String -> Maybe URI) -> (Uri -> String) -> Uri -> Maybe URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (Uri -> Text) -> Uri -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uri -> Text
getUri) Uri
uri_
                                URI -> Maybe FileIdentifier
fileIdentifierFromURI URI
uri')
  in case Maybe FileIdentifier
mFileIdentifier of
    Just FileIdentifier
fileIdentifier -> FileIdentifier -> HandlerM FileIdentifier
forall (m :: * -> *) a. Monad m => a -> m a
return FileIdentifier
fileIdentifier
    Maybe FileIdentifier
Nothing -> (Severity, Text) -> HandlerM FileIdentifier
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Error, Uri -> Text
getUri Uri
uri_ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a valid name for a dhall file.")

-- helper
rangeToJSON :: Range -> LSP.Types.Range
rangeToJSON :: Range -> Range
rangeToJSON (Range (Int
x1,Int
y1) (Int
x2,Int
y2)) =
    Position -> Position -> Range
LSP.Types.Range
      (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y1))
      (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x2) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y2))

hoverHandler :: Handlers HandlerM
hoverHandler :: Handlers HandlerM
hoverHandler =
    SMethod 'TextDocumentHover
-> Handler HandlerM 'TextDocumentHover -> Handlers HandlerM
forall (m :: Method 'FromClient 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.requestHandler SMethod 'TextDocumentHover
STextDocumentHover \RequestMessage 'TextDocumentHover
request Either ResponseError (Maybe Hover)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond -> do
        let uri_ :: Uri
uri_ = RequestMessage 'TextDocumentHover
requestRequestMessage 'TextDocumentHover
-> Getting Uri (RequestMessage 'TextDocumentHover) Uri -> Uri
forall s a. s -> Getting a s a -> a
^.(HoverParams -> Const Uri HoverParams)
-> RequestMessage 'TextDocumentHover
-> Const Uri (RequestMessage 'TextDocumentHover)
forall s a. HasParams s a => Lens' s a
params((HoverParams -> Const Uri HoverParams)
 -> RequestMessage 'TextDocumentHover
 -> Const Uri (RequestMessage 'TextDocumentHover))
-> ((Uri -> Const Uri Uri) -> HoverParams -> Const Uri HoverParams)
-> Getting Uri (RequestMessage 'TextDocumentHover) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> HoverParams -> Const Uri HoverParams
forall s a. HasTextDocument s a => Lens' s a
textDocument((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> HoverParams -> Const Uri HoverParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> HoverParams
-> Const Uri HoverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
uri

        let Position{ _line :: Position -> UInt
_line = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
_line, _character :: Position -> UInt
_character = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
_character } = RequestMessage 'TextDocumentHover
requestRequestMessage 'TextDocumentHover
-> Getting Position (RequestMessage 'TextDocumentHover) Position
-> Position
forall s a. s -> Getting a s a -> a
^.(HoverParams -> Const Position HoverParams)
-> RequestMessage 'TextDocumentHover
-> Const Position (RequestMessage 'TextDocumentHover)
forall s a. HasParams s a => Lens' s a
params((HoverParams -> Const Position HoverParams)
 -> RequestMessage 'TextDocumentHover
 -> Const Position (RequestMessage 'TextDocumentHover))
-> ((Position -> Const Position Position)
    -> HoverParams -> Const Position HoverParams)
-> Getting Position (RequestMessage 'TextDocumentHover) Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Position -> Const Position Position)
-> HoverParams -> Const Position HoverParams
forall s a. HasPosition s a => Lens' s a
position

        Map Uri DhallError
errorMap <- Getting (Map Uri DhallError) ServerState (Map Uri DhallError)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Map Uri DhallError)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Map Uri DhallError) ServerState (Map Uri DhallError)
Lens' ServerState (Map Uri DhallError)
errors

        case Uri -> Map Uri DhallError -> Maybe DhallError
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Uri
uri_ Map Uri DhallError
errorMap of
            Maybe DhallError
Nothing -> do
                Expr Src Void
expr <- Uri -> HandlerM (Expr Src Void)
loadFile Uri
uri_
                (WellTyped
welltyped, WellTyped
_) <- case Expr Src Void -> Either DhallError (WellTyped, WellTyped)
typecheck Expr Src Void
expr of
                    Left  DhallError
_  -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (WellTyped, WellTyped)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Info, Text
"Can't infer type; code does not type-check.")
                    Right (WellTyped, WellTyped)
wt -> (WellTyped, WellTyped)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (WellTyped, WellTyped)
forall (m :: * -> *) a. Monad m => a -> m a
return (WellTyped, WellTyped)
wt
                case (Int, Int) -> WellTyped -> Either String (Maybe Src, Expr Src Void)
typeAt (Int
_line, Int
_character) WellTyped
welltyped of
                    Left String
err -> (Severity, Text)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Error, String -> Text
Text.pack String
err)
                    Right (Maybe Src
mSrc, Expr Src Void
typ) -> do
                        let _range :: Maybe Range
_range = (Src -> Range) -> Maybe Src -> Maybe Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Range -> Range
rangeToJSON (Range -> Range) -> (Src -> Range) -> Src -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Src -> Range
rangeFromDhall) Maybe Src
mSrc

                        let _contents :: HoverContents
_contents = MarkupContent -> HoverContents
HoverContents (MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkPlainText (Expr Src Void -> Text
forall a. Pretty a => a -> Text
pretty Expr Src Void
typ))
                        Either ResponseError (Maybe Hover)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond (Maybe Hover -> Either ResponseError (Maybe Hover)
forall a b. b -> Either a b
Right (Hover -> Maybe Hover
forall a. a -> Maybe a
Just Hover :: HoverContents -> Maybe Range -> Hover
Hover{ HoverContents
$sel:_contents:Hover :: HoverContents
_contents :: HoverContents
_contents, Maybe Range
$sel:_range:Hover :: Maybe Range
_range :: Maybe Range
_range }))
            Just DhallError
err -> do
                let isHovered :: Diagnosis -> Bool
isHovered (Diagnosis Text
_ (Just (Range (Int, Int)
left (Int, Int)
right)) Text
_) =
                        (Int, Int)
left (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int
_line, Int
_character) Bool -> Bool -> Bool
&& (Int
_line, Int
_character) (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int, Int)
right
                    isHovered Diagnosis
_ =
                        Bool
False

                let hoverFromDiagnosis :: Diagnosis -> Maybe Hover
hoverFromDiagnosis (Diagnosis Text
_ (Just (Range (Int, Int)
left (Int, Int)
right)) Text
diagnosis) = do
                        let _range :: Maybe Range
_range = Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Range
rangeToJSON ((Int, Int) -> (Int, Int) -> Range
Range (Int, Int)
left (Int, Int)
right))
                            encodedDiag :: String
encodedDiag = String -> String
URI.encode (Text -> String
Text.unpack Text
diagnosis)

                            _kind :: MarkupKind
_kind = MarkupKind
MkMarkdown

                            _value :: Text
_value =
                                    Text
"[Explain error](dhall-explain:?"
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  String -> Text
Text.pack String
encodedDiag
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
" )"

                            _contents :: HoverContents
_contents = MarkupContent -> HoverContents
HoverContents MarkupContent :: MarkupKind -> Text -> MarkupContent
MarkupContent{Text
MarkupKind
$sel:_kind:MarkupContent :: MarkupKind
$sel:_value:MarkupContent :: Text
_value :: Text
_kind :: MarkupKind
..}
                        Hover -> Maybe Hover
forall a. a -> Maybe a
Just Hover :: HoverContents -> Maybe Range -> Hover
Hover{ HoverContents
_contents :: HoverContents
$sel:_contents:Hover :: HoverContents
_contents, Maybe Range
_range :: Maybe Range
$sel:_range:Hover :: Maybe Range
_range }
                    hoverFromDiagnosis Diagnosis
_ =
                        Maybe Hover
forall a. Maybe a
Nothing

                let mHover :: Maybe Hover
mHover = do
                        Diagnosis
explanation <- DhallError -> Maybe Diagnosis
explain DhallError
err

                        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Diagnosis -> Bool
isHovered Diagnosis
explanation)

                        Diagnosis -> Maybe Hover
hoverFromDiagnosis Diagnosis
explanation

                Either ResponseError (Maybe Hover)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond (Maybe Hover -> Either ResponseError (Maybe Hover)
forall a b. b -> Either a b
Right Maybe Hover
mHover)

documentLinkHandler :: Handlers HandlerM
documentLinkHandler :: Handlers HandlerM
documentLinkHandler =
    SMethod 'TextDocumentDocumentLink
-> Handler HandlerM 'TextDocumentDocumentLink -> Handlers HandlerM
forall (m :: Method 'FromClient 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.requestHandler SMethod 'TextDocumentDocumentLink
STextDocumentDocumentLink \RequestMessage 'TextDocumentDocumentLink
request Either ResponseError (List DocumentLink)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond -> do
        let uri_ :: Uri
uri_ = RequestMessage 'TextDocumentDocumentLink
requestRequestMessage 'TextDocumentDocumentLink
-> Getting Uri (RequestMessage 'TextDocumentDocumentLink) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^.(DocumentLinkParams -> Const Uri DocumentLinkParams)
-> RequestMessage 'TextDocumentDocumentLink
-> Const Uri (RequestMessage 'TextDocumentDocumentLink)
forall s a. HasParams s a => Lens' s a
params((DocumentLinkParams -> Const Uri DocumentLinkParams)
 -> RequestMessage 'TextDocumentDocumentLink
 -> Const Uri (RequestMessage 'TextDocumentDocumentLink))
-> ((Uri -> Const Uri Uri)
    -> DocumentLinkParams -> Const Uri DocumentLinkParams)
-> Getting Uri (RequestMessage 'TextDocumentDocumentLink) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> DocumentLinkParams -> Const Uri DocumentLinkParams
forall s a. HasTextDocument s a => Lens' s a
textDocument((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> DocumentLinkParams -> Const Uri DocumentLinkParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> DocumentLinkParams
-> Const Uri DocumentLinkParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
uri

        String
path <- case Uri -> Maybe String
uriToFilePath Uri
uri_ of
            Maybe String
Nothing ->
                (Severity, Text)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) String
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Log, Text
"Could not process document links; failed to convert URI to file path.")
            Just String
p ->
                String
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
p

        Text
txt <- Uri -> HandlerM Text
readUri Uri
uri_

        Expr Src Import
expr <- case Text -> Either DhallError (Expr Src Import)
parse Text
txt of
            Right Expr Src Import
e ->
                Expr Src Import
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Expr Src Import)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Import
e
            Left DhallError
_ ->
                (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Expr Src Import)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Log, Text
"Could not process document links; did not parse.")

        let imports :: [(Range, Import)]
imports = Expr Src Import -> [(Range, Import)]
forall a. Expr Src a -> [(Range, a)]
embedsWithRanges Expr Src Import
expr :: [(Range, Import)]

        let basePath :: String
basePath = String -> String
takeDirectory String
path

        let go :: (Range, Import) -> IO [DocumentLink]
            go :: (Range, Import) -> IO [DocumentLink]
go (Range
range_, Import (ImportHashed Maybe SHA256Digest
_ (Local FilePrefix
prefix File
file)) ImportMode
_) = do
              String
filePath <- FilePrefix -> File -> IO String
forall (io :: * -> *).
MonadIO io =>
FilePrefix -> File -> io String
localToPath FilePrefix
prefix File
file
              let filePath' :: String
filePath' = String
basePath String -> String -> String
</> String
filePath  -- absolute file path
              let _range :: Range
_range = Range -> Range
rangeToJSON Range
range_
              let _target :: Maybe Uri
_target = Uri -> Maybe Uri
forall a. a -> Maybe a
Just (String -> Uri
filePathToUri String
filePath')
              let _tooltip :: Maybe a
_tooltip = Maybe a
forall a. Maybe a
Nothing
              let _xdata :: Maybe a
_xdata = Maybe a
forall a. Maybe a
Nothing
              [DocumentLink] -> IO [DocumentLink]
forall (m :: * -> *) a. Monad m => a -> m a
return [DocumentLink :: Range -> Maybe Uri -> Maybe Text -> Maybe Value -> DocumentLink
DocumentLink {Maybe Text
Maybe Value
Maybe Uri
Range
forall a. Maybe a
$sel:_range:DocumentLink :: Range
$sel:_target:DocumentLink :: Maybe Uri
$sel:_tooltip:DocumentLink :: Maybe Text
$sel:_xdata:DocumentLink :: Maybe Value
_xdata :: forall a. Maybe a
_tooltip :: forall a. Maybe a
_target :: Maybe Uri
_range :: Range
..}]

            go (Range
range_, Import (ImportHashed Maybe SHA256Digest
_ (Remote URL
url)) ImportMode
_) = do
              let _range :: Range
_range = Range -> Range
rangeToJSON Range
range_
              let url' :: URL
url' = URL
url { headers :: Maybe (Expr Src Import)
headers = Maybe (Expr Src Import)
forall a. Maybe a
Nothing }
              let _target :: Maybe Uri
_target = Uri -> Maybe Uri
forall a. a -> Maybe a
Just (Text -> Uri
Uri (URL -> Text
forall a. Pretty a => a -> Text
pretty URL
url'))
              let _tooltip :: Maybe a
_tooltip = Maybe a
forall a. Maybe a
Nothing
              let _xdata :: Maybe a
_xdata = Maybe a
forall a. Maybe a
Nothing
              [DocumentLink] -> IO [DocumentLink]
forall (m :: * -> *) a. Monad m => a -> m a
return [DocumentLink :: Range -> Maybe Uri -> Maybe Text -> Maybe Value -> DocumentLink
DocumentLink {Maybe Text
Maybe Value
Maybe Uri
Range
forall a. Maybe a
_xdata :: forall a. Maybe a
_tooltip :: forall a. Maybe a
_target :: Maybe Uri
_range :: Range
$sel:_range:DocumentLink :: Range
$sel:_target:DocumentLink :: Maybe Uri
$sel:_tooltip:DocumentLink :: Maybe Text
$sel:_xdata:DocumentLink :: Maybe Value
..}]

            go (Range, Import)
_ = [DocumentLink] -> IO [DocumentLink]
forall (m :: * -> *) a. Monad m => a -> m a
return []

        [[DocumentLink]]
links <- IO [[DocumentLink]]
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     [[DocumentLink]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[DocumentLink]]
 -> ExceptT
      (Severity, Text)
      (StateT ServerState (LspT ServerConfig IO))
      [[DocumentLink]])
-> IO [[DocumentLink]]
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     [[DocumentLink]]
forall a b. (a -> b) -> a -> b
$ ((Range, Import) -> IO [DocumentLink])
-> [(Range, Import)] -> IO [[DocumentLink]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Range, Import) -> IO [DocumentLink]
go [(Range, Import)]
imports
        Either ResponseError (List DocumentLink)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond (List DocumentLink -> Either ResponseError (List DocumentLink)
forall a b. b -> Either a b
Right ([DocumentLink] -> List DocumentLink
forall a. [a] -> List a
List ([[DocumentLink]] -> [DocumentLink]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[DocumentLink]]
links)))


diagnosticsHandler :: Uri -> HandlerM ()
diagnosticsHandler :: Uri
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
diagnosticsHandler Uri
_uri = do
  Text
txt <- Uri -> HandlerM Text
readUri Uri
_uri
  FileIdentifier
fileIdentifier <- Uri -> HandlerM FileIdentifier
fileIdentifierFromUri Uri
_uri
  -- make sure we don't keep a stale version around
  ASetter ServerState ServerState Cache Cache
-> (Cache -> Cache)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter ServerState ServerState Cache Cache
Lens' ServerState Cache
importCache (FileIdentifier -> Cache -> Cache
invalidate FileIdentifier
fileIdentifier)
  Cache
cache <- Getting Cache ServerState Cache
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) Cache
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Cache ServerState Cache
Lens' ServerState Cache
importCache

  Maybe DhallError
errs <- (ExceptT
   DhallError
   (StateT ServerState (LspT ServerConfig IO))
   (Maybe DhallError)
 -> (DhallError
     -> ExceptT
          (Severity, Text)
          (StateT ServerState (LspT ServerConfig IO))
          (Maybe DhallError))
 -> ExceptT
      (Severity, Text)
      (StateT ServerState (LspT ServerConfig IO))
      (Maybe DhallError))
-> (DhallError
    -> ExceptT
         (Severity, Text)
         (StateT ServerState (LspT ServerConfig IO))
         (Maybe DhallError))
-> ExceptT
     DhallError
     (StateT ServerState (LspT ServerConfig IO))
     (Maybe DhallError)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Maybe DhallError)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ExceptT
  DhallError
  (StateT ServerState (LspT ServerConfig IO))
  (Maybe DhallError)
-> (DhallError
    -> ExceptT
         (Severity, Text)
         (StateT ServerState (LspT ServerConfig IO))
         (Maybe DhallError))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Maybe DhallError)
forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
catchE (Maybe DhallError
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Maybe DhallError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DhallError
 -> ExceptT
      (Severity, Text)
      (StateT ServerState (LspT ServerConfig IO))
      (Maybe DhallError))
-> (DhallError -> Maybe DhallError)
-> DhallError
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Maybe DhallError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhallError -> Maybe DhallError
forall a. a -> Maybe a
Just) (ExceptT
   DhallError
   (StateT ServerState (LspT ServerConfig IO))
   (Maybe DhallError)
 -> ExceptT
      (Severity, Text)
      (StateT ServerState (LspT ServerConfig IO))
      (Maybe DhallError))
-> ExceptT
     DhallError
     (StateT ServerState (LspT ServerConfig IO))
     (Maybe DhallError)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Maybe DhallError)
forall a b. (a -> b) -> a -> b
$ do
      Expr Src Import
expr <- case Text -> Either DhallError (Expr Src Import)
parse Text
txt of
        Right Expr Src Import
e -> Expr Src Import
-> ExceptT
     DhallError
     (StateT ServerState (LspT ServerConfig IO))
     (Expr Src Import)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Import
e
        Left DhallError
err -> DhallError
-> ExceptT
     DhallError
     (StateT ServerState (LspT ServerConfig IO))
     (Expr Src Import)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE DhallError
err
      Either DhallError (Cache, Expr Src Void)
loaded <- IO (Either DhallError (Cache, Expr Src Void))
-> ExceptT
     DhallError
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Expr Src Void))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either DhallError (Cache, Expr Src Void))
 -> ExceptT
      DhallError
      (StateT ServerState (LspT ServerConfig IO))
      (Either DhallError (Cache, Expr Src Void)))
-> IO (Either DhallError (Cache, Expr Src Void))
-> ExceptT
     DhallError
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Expr Src Void))
forall a b. (a -> b) -> a -> b
$ FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Expr Src Void))
load FileIdentifier
fileIdentifier Expr Src Import
expr Cache
cache
      (Cache
cache', Expr Src Void
expr') <- case Either DhallError (Cache, Expr Src Void)
loaded of
        Right (Cache, Expr Src Void)
x -> (Cache, Expr Src Void)
-> ExceptT
     DhallError
     (StateT ServerState (LspT ServerConfig IO))
     (Cache, Expr Src Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Cache, Expr Src Void)
x
        Left DhallError
err -> DhallError
-> ExceptT
     DhallError
     (StateT ServerState (LspT ServerConfig IO))
     (Cache, Expr Src Void)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE DhallError
err
      WellTyped
_ <- case Expr Src Void -> Either DhallError (WellTyped, WellTyped)
typecheck Expr Src Void
expr' of
        Right (WellTyped
wt, WellTyped
_typ) -> WellTyped
-> ExceptT
     DhallError (StateT ServerState (LspT ServerConfig IO)) WellTyped
forall (m :: * -> *) a. Monad m => a -> m a
return WellTyped
wt
        Left DhallError
err -> DhallError
-> ExceptT
     DhallError (StateT ServerState (LspT ServerConfig IO)) WellTyped
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE DhallError
err
      ASetter ServerState ServerState Cache Cache
-> Cache
-> ExceptT
     DhallError (StateT ServerState (LspT ServerConfig IO)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter ServerState ServerState Cache Cache
Lens' ServerState Cache
importCache Cache
cache'
      Maybe DhallError
-> ExceptT
     DhallError
     (StateT ServerState (LspT ServerConfig IO))
     (Maybe DhallError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DhallError
forall a. Maybe a
Nothing

  let suggestions :: [Suggestion]
suggestions =
        case Text -> Either DhallError (Expr Src Import)
parse Text
txt of
          Right Expr Src Import
expr -> Expr Src Import -> [Suggestion]
suggest Expr Src Import
expr
          Either DhallError (Expr Src Import)
_ -> []

      suggestionToDiagnostic :: Suggestion -> Diagnostic
suggestionToDiagnostic Suggestion { range :: Suggestion -> Range
range = Range
range_, Text
suggestion :: Suggestion -> Text
suggestion :: Text
.. } =
        let _range :: Range
_range = Range -> Range
rangeToJSON Range
range_
            _severity :: Maybe DiagnosticSeverity
_severity = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DsHint
            _source :: Maybe Text
_source = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Dhall.Lint"
            _code :: Maybe a
_code = Maybe a
forall a. Maybe a
Nothing
            _message :: Text
_message = Text
suggestion
            _tags :: Maybe a
_tags = Maybe a
forall a. Maybe a
Nothing
            _relatedInformation :: Maybe a
_relatedInformation = Maybe a
forall a. Maybe a
Nothing
        in Diagnostic :: Range
-> Maybe DiagnosticSeverity
-> Maybe (Int32 |? Text)
-> Maybe Text
-> Text
-> Maybe (List DiagnosticTag)
-> Maybe (List DiagnosticRelatedInformation)
-> Diagnostic
Diagnostic {Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
forall a. Maybe a
$sel:_range:Diagnostic :: Range
$sel:_severity:Diagnostic :: Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Maybe Text
$sel:_message:Diagnostic :: Text
$sel:_tags:Diagnostic :: Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Maybe (List DiagnosticRelatedInformation)
_relatedInformation :: forall a. Maybe a
_tags :: forall a. Maybe a
_message :: Text
_code :: forall a. Maybe a
_source :: Maybe Text
_severity :: Maybe DiagnosticSeverity
_range :: Range
..}

      diagnosisToDiagnostic :: Diagnosis -> Diagnostic
diagnosisToDiagnostic Diagnosis { range :: Diagnosis -> Maybe Range
range = Maybe Range
range_, Text
diagnosis :: Diagnosis -> Text
doctor :: Diagnosis -> Text
diagnosis :: Text
doctor :: Text
.. } =
        let _range :: Range
_range = case Maybe Range
range_ of
              Just Range
range' -> Range -> Range
rangeToJSON Range
range'
              Maybe Range
Nothing     -> Position -> Position -> Range
LSP.Types.Range (UInt -> UInt -> Position
Position UInt
0 UInt
0) (UInt -> UInt -> Position
Position UInt
0 UInt
0)
            _severity :: Maybe DiagnosticSeverity
_severity = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DsError
            _source :: Maybe Text
_source = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
doctor
            _code :: Maybe a
_code = Maybe a
forall a. Maybe a
Nothing
            _tags :: Maybe a
_tags = Maybe a
forall a. Maybe a
Nothing
            _message :: Text
_message = Text
diagnosis
            _relatedInformation :: Maybe a
_relatedInformation = Maybe a
forall a. Maybe a
Nothing
        in Diagnostic :: Range
-> Maybe DiagnosticSeverity
-> Maybe (Int32 |? Text)
-> Maybe Text
-> Text
-> Maybe (List DiagnosticTag)
-> Maybe (List DiagnosticRelatedInformation)
-> Diagnostic
Diagnostic {Maybe Text
Maybe DiagnosticSeverity
Maybe (Int32 |? Text)
Maybe (List DiagnosticTag)
Maybe (List DiagnosticRelatedInformation)
Text
Range
forall a. Maybe a
_relatedInformation :: forall a. Maybe a
_message :: Text
_tags :: forall a. Maybe a
_code :: forall a. Maybe a
_source :: Maybe Text
_severity :: Maybe DiagnosticSeverity
_range :: Range
$sel:_range:Diagnostic :: Range
$sel:_severity:Diagnostic :: Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Maybe (Int32 |? Text)
$sel:_source:Diagnostic :: Maybe Text
$sel:_message:Diagnostic :: Text
$sel:_tags:Diagnostic :: Maybe (List DiagnosticTag)
$sel:_relatedInformation:Diagnostic :: Maybe (List DiagnosticRelatedInformation)
..}

  ASetter
  ServerState ServerState (Map Uri DhallError) (Map Uri DhallError)
-> (Map Uri DhallError -> Map Uri DhallError)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter
  ServerState ServerState (Map Uri DhallError) (Map Uri DhallError)
Lens' ServerState (Map Uri DhallError)
errors ((Maybe DhallError -> Maybe DhallError)
-> Uri -> Map Uri DhallError -> Map Uri DhallError
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (Maybe DhallError -> Maybe DhallError -> Maybe DhallError
forall a b. a -> b -> a
const Maybe DhallError
errs) Uri
_uri)  -- cache errors

  let _version :: Maybe a
_version = Maybe a
forall a. Maybe a
Nothing
  let _diagnostics :: List Diagnostic
_diagnostics =
          [Diagnostic] -> List Diagnostic
forall a. [a] -> List a
List
              (   (DhallError -> [Diagnostic]) -> [DhallError] -> [Diagnostic]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Diagnosis -> Diagnostic) -> [Diagnosis] -> [Diagnostic]
forall a b. (a -> b) -> [a] -> [b]
map Diagnosis -> Diagnostic
diagnosisToDiagnostic ([Diagnosis] -> [Diagnostic])
-> (DhallError -> [Diagnosis]) -> DhallError -> [Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhallError -> [Diagnosis]
diagnose) (Maybe DhallError -> [DhallError]
forall a. Maybe a -> [a]
maybeToList Maybe DhallError
errs)
              [Diagnostic] -> [Diagnostic] -> [Diagnostic]
forall a. [a] -> [a] -> [a]
++  (Suggestion -> Diagnostic) -> [Suggestion] -> [Diagnostic]
forall a b. (a -> b) -> [a] -> [b]
map Suggestion -> Diagnostic
suggestionToDiagnostic [Suggestion]
suggestions
              )


  LspT ServerConfig IO ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP (SServerMethod 'TextDocumentPublishDiagnostics
-> MessageParams 'TextDocumentPublishDiagnostics
-> LspT ServerConfig IO ()
forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification SServerMethod 'TextDocumentPublishDiagnostics
STextDocumentPublishDiagnostics PublishDiagnosticsParams :: Uri -> Maybe UInt -> List Diagnostic -> PublishDiagnosticsParams
PublishDiagnosticsParams{ Uri
$sel:_uri:PublishDiagnosticsParams :: Uri
_uri :: Uri
_uri, Maybe UInt
forall a. Maybe a
$sel:_version:PublishDiagnosticsParams :: Maybe UInt
_version :: forall a. Maybe a
_version, List Diagnostic
$sel:_diagnostics:PublishDiagnosticsParams :: List Diagnostic
_diagnostics :: List Diagnostic
_diagnostics })

documentFormattingHandler :: Handlers HandlerM
documentFormattingHandler :: Handlers HandlerM
documentFormattingHandler =
    SMethod 'TextDocumentFormatting
-> Handler HandlerM 'TextDocumentFormatting -> Handlers HandlerM
forall (m :: Method 'FromClient 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.requestHandler SMethod 'TextDocumentFormatting
STextDocumentFormatting \RequestMessage 'TextDocumentFormatting
request Either ResponseError (List TextEdit)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond -> do
        let _uri :: Uri
_uri = RequestMessage 'TextDocumentFormatting
requestRequestMessage 'TextDocumentFormatting
-> Getting Uri (RequestMessage 'TextDocumentFormatting) Uri -> Uri
forall s a. s -> Getting a s a -> a
^.(DocumentFormattingParams -> Const Uri DocumentFormattingParams)
-> RequestMessage 'TextDocumentFormatting
-> Const Uri (RequestMessage 'TextDocumentFormatting)
forall s a. HasParams s a => Lens' s a
params((DocumentFormattingParams -> Const Uri DocumentFormattingParams)
 -> RequestMessage 'TextDocumentFormatting
 -> Const Uri (RequestMessage 'TextDocumentFormatting))
-> ((Uri -> Const Uri Uri)
    -> DocumentFormattingParams -> Const Uri DocumentFormattingParams)
-> Getting Uri (RequestMessage 'TextDocumentFormatting) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> DocumentFormattingParams -> Const Uri DocumentFormattingParams
forall s a. HasTextDocument s a => Lens' s a
textDocument((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> DocumentFormattingParams -> Const Uri DocumentFormattingParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> DocumentFormattingParams
-> Const Uri DocumentFormattingParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
uri

        Text
txt <- Uri -> HandlerM Text
readUri Uri
_uri

        (Header
header, Expr Src Import
expr) <- case Text -> Either DhallError (Header, Expr Src Import)
parseWithHeader Text
txt of
          Right (Header, Expr Src Import)
res -> (Header, Expr Src Import)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Header, Expr Src Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Header, Expr Src Import)
res
          Either DhallError (Header, Expr Src Import)
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Header, Expr Src Import)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Warning, Text
"Failed to format dhall code; parse error.")

        ServerConfig{Maybe CharacterSet
chosenCharacterSet :: ServerConfig -> Maybe CharacterSet
chosenCharacterSet :: Maybe CharacterSet
..} <- LspT ServerConfig IO ServerConfig -> HandlerM ServerConfig
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP LspT ServerConfig IO ServerConfig
forall config (m :: * -> *). MonadLsp config m => m config
LSP.getConfig

        let numLines :: UInt
numLines = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
Text.length Text
txt)
        let _newText :: Text
_newText= Maybe CharacterSet -> Expr Src Import -> Header -> Text
forall b.
Pretty b =>
Maybe CharacterSet -> Expr Src b -> Header -> Text
formatExprWithHeader Maybe CharacterSet
chosenCharacterSet Expr Src Import
expr Header
header
        let _range :: Range
_range = Position -> Position -> Range
LSP.Types.Range (UInt -> UInt -> Position
Position UInt
0 UInt
0) (UInt -> UInt -> Position
Position UInt
numLines UInt
0)

        Either ResponseError (List TextEdit)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond (List TextEdit -> Either ResponseError (List TextEdit)
forall a b. b -> Either a b
Right ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit :: Range -> Text -> TextEdit
TextEdit{Text
Range
$sel:_range:TextEdit :: Range
$sel:_newText:TextEdit :: Text
_range :: Range
_newText :: Text
..}]))

executeCommandHandler :: Handlers HandlerM
executeCommandHandler :: Handlers HandlerM
executeCommandHandler =
    SMethod 'WorkspaceExecuteCommand
-> Handler HandlerM 'WorkspaceExecuteCommand -> Handlers HandlerM
forall (m :: Method 'FromClient 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.requestHandler SMethod 'WorkspaceExecuteCommand
SWorkspaceExecuteCommand \RequestMessage 'WorkspaceExecuteCommand
request Either ResponseError Value
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond -> do
        let command_ :: Text
command_ = RequestMessage 'WorkspaceExecuteCommand
requestRequestMessage 'WorkspaceExecuteCommand
-> Getting Text (RequestMessage 'WorkspaceExecuteCommand) Text
-> Text
forall s a. s -> Getting a s a -> a
^.(ExecuteCommandParams -> Const Text ExecuteCommandParams)
-> RequestMessage 'WorkspaceExecuteCommand
-> Const Text (RequestMessage 'WorkspaceExecuteCommand)
forall s a. HasParams s a => Lens' s a
params((ExecuteCommandParams -> Const Text ExecuteCommandParams)
 -> RequestMessage 'WorkspaceExecuteCommand
 -> Const Text (RequestMessage 'WorkspaceExecuteCommand))
-> ((Text -> Const Text Text)
    -> ExecuteCommandParams -> Const Text ExecuteCommandParams)
-> Getting Text (RequestMessage 'WorkspaceExecuteCommand) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Const Text Text)
-> ExecuteCommandParams -> Const Text ExecuteCommandParams
forall s a. HasCommand s a => Lens' s a
command
        if  | Text
command_ Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dhall.server.lint" ->
                RequestMessage 'WorkspaceExecuteCommand
-> (Either ResponseError Value
    -> ExceptT
         (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ())
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a b.
RequestMessage 'WorkspaceExecuteCommand
-> (Either a Value -> HandlerM b)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeLintAndFormat RequestMessage 'WorkspaceExecuteCommand
request Either ResponseError Value
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond
            | Text
command_ Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dhall.server.annotateLet" ->
                RequestMessage 'WorkspaceExecuteCommand
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeAnnotateLet RequestMessage 'WorkspaceExecuteCommand
request
            | Text
command_ Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dhall.server.freezeImport" ->
                RequestMessage 'WorkspaceExecuteCommand
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeFreezeImport RequestMessage 'WorkspaceExecuteCommand
request
            | Text
command_ Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dhall.server.freezeAllImports" ->
                RequestMessage 'WorkspaceExecuteCommand
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeFreezeAllImports RequestMessage 'WorkspaceExecuteCommand
request
            | Bool
otherwise -> do
                (Severity, Text)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
                    ( Severity
Warning
                    , Text
"Command '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
command_ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' not known; ignored."
                    )

getCommandArguments
    :: FromJSON a => RequestMessage 'WorkspaceExecuteCommand -> HandlerM a
-- (HasParams s a, FromJSON a) => s -> HandlerM a
getCommandArguments :: RequestMessage 'WorkspaceExecuteCommand -> HandlerM a
getCommandArguments RequestMessage 'WorkspaceExecuteCommand
request = do
  Value
json <- case RequestMessage 'WorkspaceExecuteCommand
request RequestMessage 'WorkspaceExecuteCommand
-> Getting
     (Maybe (List Value))
     (RequestMessage 'WorkspaceExecuteCommand)
     (Maybe (List Value))
-> Maybe (List Value)
forall s a. s -> Getting a s a -> a
^. (ExecuteCommandParams
 -> Const (Maybe (List Value)) ExecuteCommandParams)
-> RequestMessage 'WorkspaceExecuteCommand
-> Const
     (Maybe (List Value)) (RequestMessage 'WorkspaceExecuteCommand)
forall s a. HasParams s a => Lens' s a
params ((ExecuteCommandParams
  -> Const (Maybe (List Value)) ExecuteCommandParams)
 -> RequestMessage 'WorkspaceExecuteCommand
 -> Const
      (Maybe (List Value)) (RequestMessage 'WorkspaceExecuteCommand))
-> ((Maybe (List Value)
     -> Const (Maybe (List Value)) (Maybe (List Value)))
    -> ExecuteCommandParams
    -> Const (Maybe (List Value)) ExecuteCommandParams)
-> Getting
     (Maybe (List Value))
     (RequestMessage 'WorkspaceExecuteCommand)
     (Maybe (List Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (List Value)
 -> Const (Maybe (List Value)) (Maybe (List Value)))
-> ExecuteCommandParams
-> Const (Maybe (List Value)) ExecuteCommandParams
forall s a. HasArguments s a => Lens' s a
arguments of
    Just (List (Value
x : [Value]
_)) -> Value
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
x
    Maybe (List Value)
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) Value
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Error, Text
"Failed to execute command; arguments missing.")
  case Value -> Result a
forall a. FromJSON a => Value -> Result a
Aeson.fromJSON Value
json of
    Aeson.Success a
args ->
        a -> HandlerM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
args
    Result a
_ ->
        (Severity, Text) -> HandlerM a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Error, Text
"Failed to execute command; failed to parse arguments.")

-- implements dhall.server.lint
executeLintAndFormat
    :: RequestMessage 'WorkspaceExecuteCommand
    -> (Either a Value -> HandlerM b)
    -> HandlerM ()
executeLintAndFormat :: RequestMessage 'WorkspaceExecuteCommand
-> (Either a Value -> HandlerM b)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeLintAndFormat RequestMessage 'WorkspaceExecuteCommand
request Either a Value -> HandlerM b
respond = do
  Uri
uri_ <- RequestMessage 'WorkspaceExecuteCommand -> HandlerM Uri
forall a.
FromJSON a =>
RequestMessage 'WorkspaceExecuteCommand -> HandlerM a
getCommandArguments RequestMessage 'WorkspaceExecuteCommand
request
  Text
txt <- Uri -> HandlerM Text
readUri Uri
uri_

  (Header
header, Expr Src Import
expr) <- case Text -> Either DhallError (Header, Expr Src Import)
parseWithHeader Text
txt of
    Right (Header, Expr Src Import)
res -> (Header, Expr Src Import)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Header, Expr Src Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Header, Expr Src Import)
res
    Either DhallError (Header, Expr Src Import)
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Header, Expr Src Import)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Warning, Text
"Failed to lint dhall code; parse error.")

  ServerConfig{Maybe CharacterSet
chosenCharacterSet :: Maybe CharacterSet
chosenCharacterSet :: ServerConfig -> Maybe CharacterSet
..} <- LspT ServerConfig IO ServerConfig -> HandlerM ServerConfig
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP LspT ServerConfig IO ServerConfig
forall config (m :: * -> *). MonadLsp config m => m config
LSP.getConfig

  let numLines :: UInt
numLines = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
Text.length Text
txt)

  let _newText :: Text
_newText = Maybe CharacterSet -> Expr Src Import -> Header -> Text
forall b.
Pretty b =>
Maybe CharacterSet -> Expr Src b -> Header -> Text
formatExprWithHeader Maybe CharacterSet
chosenCharacterSet (Expr Src Import -> Expr Src Import
forall s. Eq s => Expr s Import -> Expr s Import
lint Expr Src Import
expr) Header
header

  let _range :: Range
_range = Position -> Position -> Range
LSP.Types.Range (UInt -> UInt -> Position
Position UInt
0 UInt
0) (UInt -> UInt -> Position
Position UInt
numLines UInt
0)

  let _edit :: WorkspaceEdit
_edit =
          WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit
              { $sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Uri
uri_ ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit :: Range -> Text -> TextEdit
TextEdit{Text
Range
_range :: Range
_newText :: Text
$sel:_range:TextEdit :: Range
$sel:_newText:TextEdit :: Text
..}]))
              , $sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges = Maybe (List DocumentChange)
forall a. Maybe a
Nothing
              , $sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations = Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing
              }

  let _label :: Maybe a
_label = Maybe a
forall a. Maybe a
Nothing

  b
_ <- Either a Value -> HandlerM b
respond (Value -> Either a Value
forall a b. b -> Either a b
Right Value
Aeson.Null)

  LspId 'WorkspaceApplyEdit
_ <- LspT ServerConfig IO (LspId 'WorkspaceApplyEdit)
-> HandlerM (LspId 'WorkspaceApplyEdit)
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP (SServerMethod 'WorkspaceApplyEdit
-> MessageParams 'WorkspaceApplyEdit
-> (Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
    -> LspT ServerConfig IO ())
-> LspT ServerConfig IO (LspId 'WorkspaceApplyEdit)
forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit ApplyWorkspaceEditParams :: Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams{ Maybe Text
forall a. Maybe a
$sel:_label:ApplyWorkspaceEditParams :: Maybe Text
_label :: forall a. Maybe a
_label, WorkspaceEdit
$sel:_edit:ApplyWorkspaceEditParams :: WorkspaceEdit
_edit :: WorkspaceEdit
_edit } Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
-> LspT ServerConfig IO ()
forall a. a -> LspT ServerConfig IO ()
nullHandler)

  ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

executeAnnotateLet
    :: RequestMessage 'WorkspaceExecuteCommand
    -> HandlerM ()
executeAnnotateLet :: RequestMessage 'WorkspaceExecuteCommand
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeAnnotateLet RequestMessage 'WorkspaceExecuteCommand
request = do
  TextDocumentPositionParams
args <- RequestMessage 'WorkspaceExecuteCommand
-> HandlerM TextDocumentPositionParams
forall a.
FromJSON a =>
RequestMessage 'WorkspaceExecuteCommand -> HandlerM a
getCommandArguments RequestMessage 'WorkspaceExecuteCommand
request :: HandlerM TextDocumentPositionParams
  let uri_ :: Uri
uri_ = TextDocumentPositionParams
args TextDocumentPositionParams
-> Getting Uri TextDocumentPositionParams Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> TextDocumentPositionParams
-> Const Uri TextDocumentPositionParams
forall s a. HasTextDocument s a => Lens' s a
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> TextDocumentPositionParams
 -> Const Uri TextDocumentPositionParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> Getting Uri TextDocumentPositionParams Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
uri
      line_ :: Int
line_ = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TextDocumentPositionParams
args TextDocumentPositionParams
-> Getting UInt TextDocumentPositionParams UInt -> UInt
forall s a. s -> Getting a s a -> a
^. (Position -> Const UInt Position)
-> TextDocumentPositionParams
-> Const UInt TextDocumentPositionParams
forall s a. HasPosition s a => Lens' s a
position ((Position -> Const UInt Position)
 -> TextDocumentPositionParams
 -> Const UInt TextDocumentPositionParams)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> Getting UInt TextDocumentPositionParams UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasLine s a => Lens' s a
line)
      col_ :: Int
col_ = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TextDocumentPositionParams
args TextDocumentPositionParams
-> Getting UInt TextDocumentPositionParams UInt -> UInt
forall s a. s -> Getting a s a -> a
^. (Position -> Const UInt Position)
-> TextDocumentPositionParams
-> Const UInt TextDocumentPositionParams
forall s a. HasPosition s a => Lens' s a
position ((Position -> Const UInt Position)
 -> TextDocumentPositionParams
 -> Const UInt TextDocumentPositionParams)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> Getting UInt TextDocumentPositionParams UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasCharacter s a => Lens' s a
character)

  Expr Src Void
expr <- Uri -> HandlerM (Expr Src Void)
loadFile Uri
uri_
  (WellTyped
welltyped, WellTyped
_) <- case Expr Src Void -> Either DhallError (WellTyped, WellTyped)
typecheck Expr Src Void
expr of
    Left DhallError
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (WellTyped, WellTyped)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Warning, Text
"Failed to annotate let binding; not well-typed.")
    Right (WellTyped, WellTyped)
e -> (WellTyped, WellTyped)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (WellTyped, WellTyped)
forall (m :: * -> *) a. Monad m => a -> m a
return (WellTyped, WellTyped)
e

  ServerConfig{Maybe CharacterSet
chosenCharacterSet :: Maybe CharacterSet
chosenCharacterSet :: ServerConfig -> Maybe CharacterSet
..} <- LspT ServerConfig IO ServerConfig -> HandlerM ServerConfig
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP LspT ServerConfig IO ServerConfig
forall config (m :: * -> *). MonadLsp config m => m config
LSP.getConfig

  (Src (SourcePos String
_ Pos
x1 Pos
y1) (SourcePos String
_ Pos
x2 Pos
y2) Text
_, Expr Src Void
annotExpr)
    <- case (Int, Int) -> WellTyped -> Either String (Src, Expr Src Void)
annotateLet (Int
line_, Int
col_) WellTyped
welltyped of
      Right (Src, Expr Src Void)
x -> (Src, Expr Src Void)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Src, Expr Src Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Src, Expr Src Void)
x
      Left String
msg -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Src, Expr Src Void)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Warning, String -> Text
Text.pack String
msg)

  let _range :: Range
_range = Position -> Position -> Range
LSP.Types.Range (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pos -> Int
unPos Pos
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pos -> Int
unPos Pos
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
                      (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pos -> Int
unPos Pos
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pos -> Int
unPos Pos
y2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))

  let _newText :: Text
_newText= Maybe CharacterSet -> Expr Src Void -> Text
forall b. Pretty b => Maybe CharacterSet -> Expr Src b -> Text
formatExpr Maybe CharacterSet
chosenCharacterSet Expr Src Void
annotExpr

  let _edit :: WorkspaceEdit
_edit = WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit
          { $sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Uri
uri_ ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit :: Range -> Text -> TextEdit
TextEdit{Text
Range
_newText :: Text
_range :: Range
$sel:_range:TextEdit :: Range
$sel:_newText:TextEdit :: Text
..}]))
          , $sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges = Maybe (List DocumentChange)
forall a. Maybe a
Nothing
          , $sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations = Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing
          }

  let _label :: Maybe a
_label = Maybe a
forall a. Maybe a
Nothing

  LspId 'WorkspaceApplyEdit
_ <- LspT ServerConfig IO (LspId 'WorkspaceApplyEdit)
-> HandlerM (LspId 'WorkspaceApplyEdit)
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP (SServerMethod 'WorkspaceApplyEdit
-> MessageParams 'WorkspaceApplyEdit
-> (Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
    -> LspT ServerConfig IO ())
-> LspT ServerConfig IO (LspId 'WorkspaceApplyEdit)
forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit ApplyWorkspaceEditParams :: Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams{ Maybe Text
forall a. Maybe a
_label :: forall a. Maybe a
$sel:_label:ApplyWorkspaceEditParams :: Maybe Text
_label, WorkspaceEdit
_edit :: WorkspaceEdit
$sel:_edit:ApplyWorkspaceEditParams :: WorkspaceEdit
_edit } Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
-> LspT ServerConfig IO ()
forall a. a -> LspT ServerConfig IO ()
nullHandler)

  ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

executeFreezeAllImports
    :: RequestMessage 'WorkspaceExecuteCommand
    -> HandlerM ()
executeFreezeAllImports :: RequestMessage 'WorkspaceExecuteCommand
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeFreezeAllImports RequestMessage 'WorkspaceExecuteCommand
request = do
  Uri
uri_ <- RequestMessage 'WorkspaceExecuteCommand -> HandlerM Uri
forall a.
FromJSON a =>
RequestMessage 'WorkspaceExecuteCommand -> HandlerM a
getCommandArguments RequestMessage 'WorkspaceExecuteCommand
request

  FileIdentifier
fileIdentifier <- Uri -> HandlerM FileIdentifier
fileIdentifierFromUri Uri
uri_
  Text
txt <- Uri -> HandlerM Text
readUri Uri
uri_
  Expr Src Import
expr <- case Text -> Either DhallError (Expr Src Import)
parse Text
txt of
    Right Expr Src Import
e -> Expr Src Import
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Expr Src Import)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Import
e
    Left DhallError
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Expr Src Import)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Warning, Text
"Could not freeze imports; did not parse.")

  let importRanges :: [(Import, Range)]
importRanges = Expr Src Import -> [(Import, Range)]
getAllImportsWithHashPositions Expr Src Import
expr
  [TextEdit]
edits_ <- [(Import, Range)]
-> ((Import, Range)
    -> ExceptT
         (Severity, Text)
         (StateT ServerState (LspT ServerConfig IO))
         TextEdit)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     [TextEdit]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Import, Range)]
importRanges (((Import, Range)
  -> ExceptT
       (Severity, Text)
       (StateT ServerState (LspT ServerConfig IO))
       TextEdit)
 -> ExceptT
      (Severity, Text)
      (StateT ServerState (LspT ServerConfig IO))
      [TextEdit])
-> ((Import, Range)
    -> ExceptT
         (Severity, Text)
         (StateT ServerState (LspT ServerConfig IO))
         TextEdit)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     [TextEdit]
forall a b. (a -> b) -> a -> b
$ \(Import
import_, Range (Int
x1, Int
y1) (Int
x2, Int
y2)) -> do
    Cache
cache <- Getting Cache ServerState Cache
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) Cache
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Cache ServerState Cache
Lens' ServerState Cache
importCache
    let importExpr :: Expr s Import
importExpr = Import -> Expr s Import
forall s a. a -> Expr s a
Embed (Import -> Import
stripHash Import
import_)

    Either DhallError (Cache, Text)
hashResult <- IO (Either DhallError (Cache, Text))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either DhallError (Cache, Text))
 -> ExceptT
      (Severity, Text)
      (StateT ServerState (LspT ServerConfig IO))
      (Either DhallError (Cache, Text)))
-> IO (Either DhallError (Cache, Text))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Text))
forall a b. (a -> b) -> a -> b
$ FileIdentifier
-> Expr Src Import -> Cache -> IO (Either DhallError (Cache, Text))
computeSemanticHash FileIdentifier
fileIdentifier Expr Src Import
forall s. Expr s Import
importExpr Cache
cache
    (Cache
cache', Text
hash) <- case Either DhallError (Cache, Text)
hashResult of
      Right (Cache
c, Text
t) -> (Cache, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Cache, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Cache
c, Text
t)
      Left DhallError
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Cache, Text)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Error, Text
"Could not freeze import; failed to evaluate import.")
    ASetter ServerState ServerState Cache Cache
-> Cache
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter ServerState ServerState Cache Cache
Lens' ServerState Cache
importCache Cache
cache'

    let _range :: Range
_range = Position -> Position -> Range
LSP.Types.Range (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y1)) (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x2) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y2))
    let _newText :: Text
_newText = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hash
    TextEdit
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     TextEdit
forall (m :: * -> *) a. Monad m => a -> m a
return TextEdit :: Range -> Text -> TextEdit
TextEdit{Text
Range
_newText :: Text
_range :: Range
$sel:_range:TextEdit :: Range
$sel:_newText:TextEdit :: Text
..}

  let _edit :: WorkspaceEdit
_edit = WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit
          { $sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Uri
uri_ ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
edits_))
          , $sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges = Maybe (List DocumentChange)
forall a. Maybe a
Nothing
          , $sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations = Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing
          }

  let _label :: Maybe a
_label = Maybe a
forall a. Maybe a
Nothing

  LspId 'WorkspaceApplyEdit
_ <- LspT ServerConfig IO (LspId 'WorkspaceApplyEdit)
-> HandlerM (LspId 'WorkspaceApplyEdit)
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP (SServerMethod 'WorkspaceApplyEdit
-> MessageParams 'WorkspaceApplyEdit
-> (Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
    -> LspT ServerConfig IO ())
-> LspT ServerConfig IO (LspId 'WorkspaceApplyEdit)
forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit ApplyWorkspaceEditParams :: Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams{ WorkspaceEdit
_edit :: WorkspaceEdit
$sel:_edit:ApplyWorkspaceEditParams :: WorkspaceEdit
_edit, Maybe Text
forall a. Maybe a
_label :: forall a. Maybe a
$sel:_label:ApplyWorkspaceEditParams :: Maybe Text
_label } Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
-> LspT ServerConfig IO ()
forall a. a -> LspT ServerConfig IO ()
nullHandler)

  ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

executeFreezeImport
    :: RequestMessage 'WorkspaceExecuteCommand
    -> HandlerM ()
executeFreezeImport :: RequestMessage 'WorkspaceExecuteCommand
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeFreezeImport RequestMessage 'WorkspaceExecuteCommand
request = do
  TextDocumentPositionParams
args <- RequestMessage 'WorkspaceExecuteCommand
-> HandlerM TextDocumentPositionParams
forall a.
FromJSON a =>
RequestMessage 'WorkspaceExecuteCommand -> HandlerM a
getCommandArguments RequestMessage 'WorkspaceExecuteCommand
request :: HandlerM TextDocumentPositionParams
  let uri_ :: Uri
uri_  = TextDocumentPositionParams
args TextDocumentPositionParams
-> Getting Uri TextDocumentPositionParams Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> TextDocumentPositionParams
-> Const Uri TextDocumentPositionParams
forall s a. HasTextDocument s a => Lens' s a
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> TextDocumentPositionParams
 -> Const Uri TextDocumentPositionParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> Getting Uri TextDocumentPositionParams Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
uri
  let line_ :: Int
line_ = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TextDocumentPositionParams
args TextDocumentPositionParams
-> Getting UInt TextDocumentPositionParams UInt -> UInt
forall s a. s -> Getting a s a -> a
^. (Position -> Const UInt Position)
-> TextDocumentPositionParams
-> Const UInt TextDocumentPositionParams
forall s a. HasPosition s a => Lens' s a
position ((Position -> Const UInt Position)
 -> TextDocumentPositionParams
 -> Const UInt TextDocumentPositionParams)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> Getting UInt TextDocumentPositionParams UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasLine s a => Lens' s a
line)
  let col_ :: Int
col_  = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TextDocumentPositionParams
args TextDocumentPositionParams
-> Getting UInt TextDocumentPositionParams UInt -> UInt
forall s a. s -> Getting a s a -> a
^. (Position -> Const UInt Position)
-> TextDocumentPositionParams
-> Const UInt TextDocumentPositionParams
forall s a. HasPosition s a => Lens' s a
position ((Position -> Const UInt Position)
 -> TextDocumentPositionParams
 -> Const UInt TextDocumentPositionParams)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> Getting UInt TextDocumentPositionParams UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasCharacter s a => Lens' s a
character)

  Text
txt <- Uri -> HandlerM Text
readUri Uri
uri_
  Expr Src Import
expr <- case Text -> Either DhallError (Expr Src Import)
parse Text
txt of
    Right Expr Src Import
e -> Expr Src Import
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Expr Src Import)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Import
e
    Left DhallError
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Expr Src Import)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Warning, Text
"Could not freeze import; did not parse.")

  (Src
src, Import
import_)
    <- case (Int, Int) -> Expr Src Import -> Maybe (Expr Src Import)
forall a. (Int, Int) -> Expr Src a -> Maybe (Expr Src a)
exprAt (Int
line_, Int
col_) Expr Src Import
expr of
      Just (Note Src
src (Embed Import
i)) -> (Src, Import)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Src, Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Src
src, Import
i)
      Maybe (Expr Src Import)
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Src, Import)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Warning, Text
"You weren't pointing at an import!")

  Range (Int
x1, Int
y1) (Int
x2, Int
y2) <- case Src -> Maybe Range
getImportHashPosition Src
src of
      Just Range
range_ -> Range
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) Range
forall (m :: * -> *) a. Monad m => a -> m a
return Range
range_
      Maybe Range
Nothing -> (Severity, Text)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) Range
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Error, Text
"Failed to re-parse import!")

  FileIdentifier
fileIdentifier <- Uri -> HandlerM FileIdentifier
fileIdentifierFromUri Uri
uri_
  Cache
cache <- Getting Cache ServerState Cache
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) Cache
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Cache ServerState Cache
Lens' ServerState Cache
importCache
  let importExpr :: Expr s Import
importExpr = Import -> Expr s Import
forall s a. a -> Expr s a
Embed (Import -> Import
stripHash Import
import_)

  Either DhallError (Cache, Text)
hashResult <- IO (Either DhallError (Cache, Text))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either DhallError (Cache, Text))
 -> ExceptT
      (Severity, Text)
      (StateT ServerState (LspT ServerConfig IO))
      (Either DhallError (Cache, Text)))
-> IO (Either DhallError (Cache, Text))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Text))
forall a b. (a -> b) -> a -> b
$ FileIdentifier
-> Expr Src Import -> Cache -> IO (Either DhallError (Cache, Text))
computeSemanticHash FileIdentifier
fileIdentifier Expr Src Import
forall s. Expr s Import
importExpr Cache
cache
  (Cache
cache', Text
hash) <- case Either DhallError (Cache, Text)
hashResult of
    Right (Cache
c, Text
t) -> (Cache, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Cache, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Cache
c, Text
t)
    Left DhallError
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Cache, Text)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Error, Text
"Could not freeze import; failed to evaluate import.")
  ASetter ServerState ServerState Cache Cache
-> Cache
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter ServerState ServerState Cache Cache
Lens' ServerState Cache
importCache Cache
cache'

  let _range :: Range
_range = Position -> Position -> Range
LSP.Types.Range (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y1)) (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x2) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y2))
  let _newText :: Text
_newText = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hash

  let _edit :: WorkspaceEdit
_edit = WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit
          { $sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Uri
uri_ ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit :: Range -> Text -> TextEdit
TextEdit{Text
Range
_newText :: Text
_range :: Range
$sel:_range:TextEdit :: Range
$sel:_newText:TextEdit :: Text
..}]))
          , $sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges = Maybe (List DocumentChange)
forall a. Maybe a
Nothing
          , $sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations = Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing
          }

  let _label :: Maybe a
_label = Maybe a
forall a. Maybe a
Nothing

  LspId 'WorkspaceApplyEdit
_ <- LspT ServerConfig IO (LspId 'WorkspaceApplyEdit)
-> HandlerM (LspId 'WorkspaceApplyEdit)
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP (SServerMethod 'WorkspaceApplyEdit
-> MessageParams 'WorkspaceApplyEdit
-> (Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
    -> LspT ServerConfig IO ())
-> LspT ServerConfig IO (LspId 'WorkspaceApplyEdit)
forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit ApplyWorkspaceEditParams :: Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams{ WorkspaceEdit
_edit :: WorkspaceEdit
$sel:_edit:ApplyWorkspaceEditParams :: WorkspaceEdit
_edit, Maybe Text
forall a. Maybe a
_label :: forall a. Maybe a
$sel:_label:ApplyWorkspaceEditParams :: Maybe Text
_label } Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
-> LspT ServerConfig IO ()
forall a. a -> LspT ServerConfig IO ()
nullHandler)

  ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

completionHandler :: Handlers HandlerM
completionHandler :: Handlers HandlerM
completionHandler =
  SMethod 'TextDocumentCompletion
-> Handler HandlerM 'TextDocumentCompletion -> Handlers HandlerM
forall (m :: Method 'FromClient 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.requestHandler SMethod 'TextDocumentCompletion
STextDocumentCompletion \RequestMessage 'TextDocumentCompletion
request Either ResponseError (List CompletionItem |? CompletionList)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond -> do
    let uri_ :: Uri
uri_  = RequestMessage 'TextDocumentCompletion
request RequestMessage 'TextDocumentCompletion
-> Getting Uri (RequestMessage 'TextDocumentCompletion) Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (CompletionParams -> Const Uri CompletionParams)
-> RequestMessage 'TextDocumentCompletion
-> Const Uri (RequestMessage 'TextDocumentCompletion)
forall s a. HasParams s a => Lens' s a
params ((CompletionParams -> Const Uri CompletionParams)
 -> RequestMessage 'TextDocumentCompletion
 -> Const Uri (RequestMessage 'TextDocumentCompletion))
-> ((Uri -> Const Uri Uri)
    -> CompletionParams -> Const Uri CompletionParams)
-> Getting Uri (RequestMessage 'TextDocumentCompletion) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> CompletionParams -> Const Uri CompletionParams
forall s a. HasTextDocument s a => Lens' s a
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> CompletionParams -> Const Uri CompletionParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> CompletionParams
-> Const Uri CompletionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
uri
        line_ :: Int
line_ = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (RequestMessage 'TextDocumentCompletion
request RequestMessage 'TextDocumentCompletion
-> Getting UInt (RequestMessage 'TextDocumentCompletion) UInt
-> UInt
forall s a. s -> Getting a s a -> a
^. (CompletionParams -> Const UInt CompletionParams)
-> RequestMessage 'TextDocumentCompletion
-> Const UInt (RequestMessage 'TextDocumentCompletion)
forall s a. HasParams s a => Lens' s a
params ((CompletionParams -> Const UInt CompletionParams)
 -> RequestMessage 'TextDocumentCompletion
 -> Const UInt (RequestMessage 'TextDocumentCompletion))
-> ((UInt -> Const UInt UInt)
    -> CompletionParams -> Const UInt CompletionParams)
-> Getting UInt (RequestMessage 'TextDocumentCompletion) UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const UInt Position)
-> CompletionParams -> Const UInt CompletionParams
forall s a. HasPosition s a => Lens' s a
position ((Position -> Const UInt Position)
 -> CompletionParams -> Const UInt CompletionParams)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> (UInt -> Const UInt UInt)
-> CompletionParams
-> Const UInt CompletionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasLine s a => Lens' s a
line)
        col_ :: Int
col_  = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (RequestMessage 'TextDocumentCompletion
request RequestMessage 'TextDocumentCompletion
-> Getting UInt (RequestMessage 'TextDocumentCompletion) UInt
-> UInt
forall s a. s -> Getting a s a -> a
^. (CompletionParams -> Const UInt CompletionParams)
-> RequestMessage 'TextDocumentCompletion
-> Const UInt (RequestMessage 'TextDocumentCompletion)
forall s a. HasParams s a => Lens' s a
params ((CompletionParams -> Const UInt CompletionParams)
 -> RequestMessage 'TextDocumentCompletion
 -> Const UInt (RequestMessage 'TextDocumentCompletion))
-> ((UInt -> Const UInt UInt)
    -> CompletionParams -> Const UInt CompletionParams)
-> Getting UInt (RequestMessage 'TextDocumentCompletion) UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const UInt Position)
-> CompletionParams -> Const UInt CompletionParams
forall s a. HasPosition s a => Lens' s a
position ((Position -> Const UInt Position)
 -> CompletionParams -> Const UInt CompletionParams)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> (UInt -> Const UInt UInt)
-> CompletionParams
-> Const UInt CompletionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasCharacter s a => Lens' s a
character)

    Text
txt <- Uri -> HandlerM Text
readUri Uri
uri_
    let (Text
completionLeadup, Text
completionPrefix) = Text -> (Int, Int) -> (Text, Text)
completionQueryAt Text
txt (Int
line_, Int
col_)

    let computeCompletions :: ExceptT
  (Severity, Text)
  (StateT ServerState (LspT ServerConfig IO))
  [Completion]
computeCompletions
          -- environment variable
          | Text
"env:" Text -> Text -> Bool
`isPrefixOf` Text
completionPrefix =
            IO [Completion]
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     [Completion]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Completion]
completeEnvironmentImport

          -- local import
          | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`isPrefixOf` Text
completionPrefix) [ Text
"/", Text
"./", Text
"../", Text
"~/" ] = do
            let relativeTo :: String
relativeTo | Just String
path <- Uri -> Maybe String
uriToFilePath Uri
uri_ = String
path
                         | Bool
otherwise = String
"."
            IO [Completion]
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     [Completion]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Completion]
 -> ExceptT
      (Severity, Text)
      (StateT ServerState (LspT ServerConfig IO))
      [Completion])
-> IO [Completion]
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     [Completion]
forall a b. (a -> b) -> a -> b
$ String -> String -> IO [Completion]
completeLocalImport String
relativeTo (Text -> String
Text.unpack Text
completionPrefix)

          -- record projection / union constructor
          | (Text
target_, Text
_) <- Text -> Text -> (Text, Text)
Text.breakOnEnd Text
"." Text
completionPrefix
          , Bool -> Bool
not (Text -> Bool
Text.null Text
target_) = do
            let bindersExpr :: Expr Src Import
bindersExpr = Text -> Expr Src Import
binderExprFromText Text
completionLeadup

            FileIdentifier
fileIdentifier <- Uri -> HandlerM FileIdentifier
fileIdentifierFromUri Uri
uri_
            Cache
cache <- Getting Cache ServerState Cache
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) Cache
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Cache ServerState Cache
Lens' ServerState Cache
importCache
            Either DhallError (Cache, Expr Src Void)
loadedBinders <- IO (Either DhallError (Cache, Expr Src Void))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Expr Src Void))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either DhallError (Cache, Expr Src Void))
 -> ExceptT
      (Severity, Text)
      (StateT ServerState (LspT ServerConfig IO))
      (Either DhallError (Cache, Expr Src Void)))
-> IO (Either DhallError (Cache, Expr Src Void))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Expr Src Void))
forall a b. (a -> b) -> a -> b
$ FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Expr Src Void))
load FileIdentifier
fileIdentifier Expr Src Import
bindersExpr Cache
cache

            (Cache
cache', Expr Src Void
bindersExpr') <-
              case Either DhallError (Cache, Expr Src Void)
loadedBinders of
                Right (Cache
cache', Expr Src Void
binders) ->
                  (Cache, Expr Src Void)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Cache, Expr Src Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Cache
cache', Expr Src Void
binders)
                Left DhallError
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Cache, Expr Src Void)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Log, Text
"Could not complete projection; failed to load binders expression.")

            let completionContext :: CompletionContext
completionContext = Expr Src Void -> CompletionContext
buildCompletionContext Expr Src Void
bindersExpr'

            Expr Src Import
targetExpr <- case Text -> Either DhallError (Expr Src Import)
parse (Int -> Text -> Text
Text.dropEnd Int
1 Text
target_) of
              Right Expr Src Import
e -> Expr Src Import
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Expr Src Import)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Import
e
              Left DhallError
_ -> (Severity, Text)
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Expr Src Import)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Log, Text
"Could not complete projection; prefix did not parse.")

            Either DhallError (Cache, Expr Src Void)
loaded' <- IO (Either DhallError (Cache, Expr Src Void))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Expr Src Void))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either DhallError (Cache, Expr Src Void))
 -> ExceptT
      (Severity, Text)
      (StateT ServerState (LspT ServerConfig IO))
      (Either DhallError (Cache, Expr Src Void)))
-> IO (Either DhallError (Cache, Expr Src Void))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Expr Src Void))
forall a b. (a -> b) -> a -> b
$ FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Expr Src Void))
load FileIdentifier
fileIdentifier Expr Src Import
targetExpr Cache
cache'
            case Either DhallError (Cache, Expr Src Void)
loaded' of
              Right (Cache
cache'', Expr Src Void
targetExpr') -> do
                ASetter ServerState ServerState Cache Cache
-> Cache
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter ServerState ServerState Cache Cache
Lens' ServerState Cache
importCache Cache
cache''
                [Completion]
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     [Completion]
forall (m :: * -> *) a. Monad m => a -> m a
return (CompletionContext -> Expr Src Void -> [Completion]
completeProjections CompletionContext
completionContext Expr Src Void
targetExpr')
              Left DhallError
_ -> [Completion]
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     [Completion]
forall (m :: * -> *) a. Monad m => a -> m a
return []

          -- complete identifiers in scope
          | Bool
otherwise = do
            let bindersExpr :: Expr Src Import
bindersExpr = Text -> Expr Src Import
binderExprFromText Text
completionLeadup

            FileIdentifier
fileIdentifier <- Uri -> HandlerM FileIdentifier
fileIdentifierFromUri Uri
uri_
            Cache
cache <- Getting Cache ServerState Cache
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) Cache
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Cache ServerState Cache
Lens' ServerState Cache
importCache  -- todo save cache afterwards
            Either DhallError (Cache, Expr Src Void)
loadedBinders <- IO (Either DhallError (Cache, Expr Src Void))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Expr Src Void))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either DhallError (Cache, Expr Src Void))
 -> ExceptT
      (Severity, Text)
      (StateT ServerState (LspT ServerConfig IO))
      (Either DhallError (Cache, Expr Src Void)))
-> IO (Either DhallError (Cache, Expr Src Void))
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     (Either DhallError (Cache, Expr Src Void))
forall a b. (a -> b) -> a -> b
$ FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Expr Src Void))
load FileIdentifier
fileIdentifier Expr Src Import
bindersExpr Cache
cache

            Expr Src Void
bindersExpr' <-
              case Either DhallError (Cache, Expr Src Void)
loadedBinders of
                Right (Cache
cache', Expr Src Void
binders) -> do
                  ASetter ServerState ServerState Cache Cache
-> Cache
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter ServerState ServerState Cache Cache
Lens' ServerState Cache
importCache Cache
cache'
                  Expr Src Void -> HandlerM (Expr Src Void)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Void
binders
                Left DhallError
_ -> (Severity, Text) -> HandlerM (Expr Src Void)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Severity
Log, Text
"Could not complete projection; failed to load binders expression.")

            let context_ :: CompletionContext
context_ = Expr Src Void -> CompletionContext
buildCompletionContext Expr Src Void
bindersExpr'

            [Completion]
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     [Completion]
forall (m :: * -> *) a. Monad m => a -> m a
return (CompletionContext -> [Completion]
completeFromContext CompletionContext
context_)

    [Completion]
completions <- ExceptT
  (Severity, Text)
  (StateT ServerState (LspT ServerConfig IO))
  [Completion]
computeCompletions

    let toCompletionItem :: Completion -> CompletionItem
toCompletionItem (Completion {Maybe (Expr Src Void)
Text
completeType :: Completion -> Maybe (Expr Src Void)
completeText :: Completion -> Text
completeType :: Maybe (Expr Src Void)
completeText :: Text
..}) = CompletionItem :: Text
-> Maybe CompletionItemKind
-> Maybe (List CompletionItemTag)
-> Maybe Text
-> Maybe CompletionDoc
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InsertTextFormat
-> Maybe InsertTextMode
-> Maybe CompletionEdit
-> Maybe (List TextEdit)
-> Maybe (List Text)
-> Maybe Command
-> Maybe Value
-> CompletionItem
CompletionItem {Maybe Bool
Maybe Text
Maybe Value
Maybe CompletionEdit
Maybe InsertTextFormat
Maybe CompletionDoc
Maybe InsertTextMode
Maybe CompletionItemKind
Maybe Command
Maybe (List Text)
Maybe (List CompletionItemTag)
Maybe (List TextEdit)
Text
forall a. Maybe a
$sel:_label:CompletionItem :: Text
$sel:_kind:CompletionItem :: Maybe CompletionItemKind
$sel:_tags:CompletionItem :: Maybe (List CompletionItemTag)
$sel:_detail:CompletionItem :: Maybe Text
$sel:_documentation:CompletionItem :: Maybe CompletionDoc
$sel:_deprecated:CompletionItem :: Maybe Bool
$sel:_preselect:CompletionItem :: Maybe Bool
$sel:_sortText:CompletionItem :: Maybe Text
$sel:_filterText:CompletionItem :: Maybe Text
$sel:_insertText:CompletionItem :: Maybe Text
$sel:_insertTextFormat:CompletionItem :: Maybe InsertTextFormat
$sel:_insertTextMode:CompletionItem :: Maybe InsertTextMode
$sel:_textEdit:CompletionItem :: Maybe CompletionEdit
$sel:_additionalTextEdits:CompletionItem :: Maybe (List TextEdit)
$sel:_commitCharacters:CompletionItem :: Maybe (List Text)
$sel:_command:CompletionItem :: Maybe Command
$sel:_xdata:CompletionItem :: Maybe Value
_xdata :: forall a. Maybe a
_command :: forall a. Maybe a
_commitCharacters :: forall a. Maybe a
_additionalTextEdits :: forall a. Maybe a
_textEdit :: forall a. Maybe a
_insertTextMode :: forall a. Maybe a
_insertTextFormat :: forall a. Maybe a
_insertText :: forall a. Maybe a
_filterText :: forall a. Maybe a
_sortText :: forall a. Maybe a
_preselect :: forall a. Maybe a
_deprecated :: forall a. Maybe a
_documentation :: forall a. Maybe a
_detail :: Maybe Text
_tags :: Maybe (List CompletionItemTag)
_kind :: forall a. Maybe a
_label :: Text
..}
         where
          _label :: Text
_label = Text
completeText
          _kind :: Maybe a
_kind = Maybe a
forall a. Maybe a
Nothing
          _tags :: Maybe (List CompletionItemTag)
_tags = Maybe (List CompletionItemTag)
forall a. Monoid a => a
mempty
          _detail :: Maybe Text
_detail = (Expr Src Void -> Text) -> Maybe (Expr Src Void) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr Src Void -> Text
forall a. Pretty a => a -> Text
pretty Maybe (Expr Src Void)
completeType
          _documentation :: Maybe a
_documentation = Maybe a
forall a. Maybe a
Nothing
          _deprecated :: Maybe a
_deprecated = Maybe a
forall a. Maybe a
Nothing
          _preselect :: Maybe a
_preselect = Maybe a
forall a. Maybe a
Nothing
          _sortText :: Maybe a
_sortText = Maybe a
forall a. Maybe a
Nothing
          _filterText :: Maybe a
_filterText = Maybe a
forall a. Maybe a
Nothing
          _insertText :: Maybe a
_insertText = Maybe a
forall a. Maybe a
Nothing
          _insertTextFormat :: Maybe a
_insertTextFormat = Maybe a
forall a. Maybe a
Nothing
          _insertTextMode :: Maybe a
_insertTextMode = Maybe a
forall a. Maybe a
Nothing
          _textEdit :: Maybe a
_textEdit = Maybe a
forall a. Maybe a
Nothing
          _additionalTextEdits :: Maybe a
_additionalTextEdits = Maybe a
forall a. Maybe a
Nothing
          _commitCharacters :: Maybe a
_commitCharacters = Maybe a
forall a. Maybe a
Nothing
          _command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing
          _xdata :: Maybe a
_xdata = Maybe a
forall a. Maybe a
Nothing

    let _items :: List CompletionItem
_items = [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List ((Completion -> CompletionItem) -> [Completion] -> [CompletionItem]
forall a b. (a -> b) -> [a] -> [b]
map Completion -> CompletionItem
toCompletionItem [Completion]
completions)

    let _isIncomplete :: Bool
_isIncomplete = Bool
False

    Either ResponseError (List CompletionItem |? CompletionList)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond ((List CompletionItem |? CompletionList)
-> Either ResponseError (List CompletionItem |? CompletionList)
forall a b. b -> Either a b
Right (CompletionList -> List CompletionItem |? CompletionList
forall a b. b -> a |? b
InR CompletionList :: Bool -> List CompletionItem -> CompletionList
CompletionList{Bool
List CompletionItem
$sel:_isIncomplete:CompletionList :: Bool
$sel:_items:CompletionList :: List CompletionItem
_isIncomplete :: Bool
_items :: List CompletionItem
..}))

nullHandler :: a -> LspT ServerConfig IO ()
nullHandler :: a -> LspT ServerConfig IO ()
nullHandler a
_ = () -> LspT ServerConfig IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

didOpenTextDocumentNotificationHandler :: Handlers HandlerM
didOpenTextDocumentNotificationHandler :: Handlers HandlerM
didOpenTextDocumentNotificationHandler =
    SMethod 'TextDocumentDidOpen
-> Handler HandlerM 'TextDocumentDidOpen -> Handlers HandlerM
forall (m :: Method 'FromClient 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.notificationHandler SMethod 'TextDocumentDidOpen
STextDocumentDidOpen \NotificationMessage 'TextDocumentDidOpen
notification -> do
        let _uri :: Uri
_uri = NotificationMessage 'TextDocumentDidOpen
notificationNotificationMessage 'TextDocumentDidOpen
-> Getting Uri (NotificationMessage 'TextDocumentDidOpen) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^.(DidOpenTextDocumentParams -> Const Uri DidOpenTextDocumentParams)
-> NotificationMessage 'TextDocumentDidOpen
-> Const Uri (NotificationMessage 'TextDocumentDidOpen)
forall s a. HasParams s a => Lens' s a
params((DidOpenTextDocumentParams -> Const Uri DidOpenTextDocumentParams)
 -> NotificationMessage 'TextDocumentDidOpen
 -> Const Uri (NotificationMessage 'TextDocumentDidOpen))
-> ((Uri -> Const Uri Uri)
    -> DidOpenTextDocumentParams
    -> Const Uri DidOpenTextDocumentParams)
-> Getting Uri (NotificationMessage 'TextDocumentDidOpen) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TextDocumentItem -> Const Uri TextDocumentItem)
-> DidOpenTextDocumentParams -> Const Uri DidOpenTextDocumentParams
forall s a. HasTextDocument s a => Lens' s a
textDocument((TextDocumentItem -> Const Uri TextDocumentItem)
 -> DidOpenTextDocumentParams
 -> Const Uri DidOpenTextDocumentParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentItem -> Const Uri TextDocumentItem)
-> (Uri -> Const Uri Uri)
-> DidOpenTextDocumentParams
-> Const Uri DidOpenTextDocumentParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Uri -> Const Uri Uri)
-> TextDocumentItem -> Const Uri TextDocumentItem
forall s a. HasUri s a => Lens' s a
uri
        Uri
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
diagnosticsHandler Uri
_uri

didSaveTextDocumentNotificationHandler :: Handlers HandlerM
didSaveTextDocumentNotificationHandler :: Handlers HandlerM
didSaveTextDocumentNotificationHandler =
    SMethod 'TextDocumentDidSave
-> Handler HandlerM 'TextDocumentDidSave -> Handlers HandlerM
forall (m :: Method 'FromClient 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.notificationHandler SMethod 'TextDocumentDidSave
STextDocumentDidSave \NotificationMessage 'TextDocumentDidSave
notification -> do
        let _uri :: Uri
_uri = NotificationMessage 'TextDocumentDidSave
notificationNotificationMessage 'TextDocumentDidSave
-> Getting Uri (NotificationMessage 'TextDocumentDidSave) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^.(DidSaveTextDocumentParams -> Const Uri DidSaveTextDocumentParams)
-> NotificationMessage 'TextDocumentDidSave
-> Const Uri (NotificationMessage 'TextDocumentDidSave)
forall s a. HasParams s a => Lens' s a
params((DidSaveTextDocumentParams -> Const Uri DidSaveTextDocumentParams)
 -> NotificationMessage 'TextDocumentDidSave
 -> Const Uri (NotificationMessage 'TextDocumentDidSave))
-> ((Uri -> Const Uri Uri)
    -> DidSaveTextDocumentParams
    -> Const Uri DidSaveTextDocumentParams)
-> Getting Uri (NotificationMessage 'TextDocumentDidSave) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> DidSaveTextDocumentParams -> Const Uri DidSaveTextDocumentParams
forall s a. HasTextDocument s a => Lens' s a
textDocument((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> DidSaveTextDocumentParams
 -> Const Uri DidSaveTextDocumentParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> DidSaveTextDocumentParams
-> Const Uri DidSaveTextDocumentParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
uri
        Uri
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
diagnosticsHandler Uri
_uri