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

module Dhall.LSP.Handlers where

import Data.Void    (Void)
import Dhall        (EvaluateSettings)
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.Protocol.Lens
    ( arguments
    , character
    , command
    , line
    , params
    , position
    , textDocument
    , uri
    )
import Language.LSP.Protocol.Message
    ( Method (..)
    , SMethod (..)
    , TRequestMessage
    )
import Language.LSP.Protocol.Types   hiding (Range (..))
import Language.LSP.Server           (Handlers, LspT)
import System.FilePath               (takeDirectory, (</>))
import Text.Megaparsec               (SourcePos (..), unPos)

import qualified Data.Aeson                  as Aeson
import qualified Data.Map.Strict             as Map
import qualified Data.Text                   as Text
import qualified Data.Text.Utf16.Rope        as Rope
import qualified Language.LSP.Protocol.Types as LSP.Types
import qualified Language.LSP.Server         as LSP
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 :: forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP LspT ServerConfig IO a
m = StateT ServerState (LspT ServerConfig IO) a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (Severity, Text) m 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 (m :: * -> *) a. Monad m => m a -> StateT ServerState m 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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 :: EvaluateSettings -> Uri -> HandlerM (Expr Src Void)
loadFile :: EvaluateSettings -> Uri -> HandlerM (Expr Src Void)
loadFile EvaluateSettings
settings 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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
IO a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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
$ EvaluateSettings
-> FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Expr Src Void))
load EvaluateSettings
settings 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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a. Maybe a -> Maybe a -> Maybe a
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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 :: EvaluateSettings -> Handlers HandlerM
hoverHandler :: EvaluateSettings
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
hoverHandler EvaluateSettings
settings =
    SMethod 'Method_TextDocumentHover
-> Handler
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
     'Method_TextDocumentHover
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.requestHandler SMethod 'Method_TextDocumentHover
SMethod_TextDocumentHover \TRequestMessage 'Method_TextDocumentHover
request Either ResponseError (Hover |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond -> (Either ResponseError (Hover |? Null)
 -> ExceptT
      (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ())
-> (Hover |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a1 b a2.
(Either a1 b -> HandlerM a2) -> b -> HandlerM a2 -> HandlerM a2
handleErrorWithDefault Either ResponseError (Hover |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond (Null -> Hover |? Null
forall a b. b -> a |? b
InR Null
LSP.Types.Null) do
        let uri_ :: Uri
uri_ = TRequestMessage 'Method_TextDocumentHover
requestTRequestMessage 'Method_TextDocumentHover
-> Getting Uri (TRequestMessage 'Method_TextDocumentHover) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^.(HoverParams -> Const Uri HoverParams)
-> TRequestMessage 'Method_TextDocumentHover
-> Const Uri (TRequestMessage 'Method_TextDocumentHover)
forall s a. HasParams s a => Lens' s a
Lens' (TRequestMessage 'Method_TextDocumentHover) HoverParams
params((HoverParams -> Const Uri HoverParams)
 -> TRequestMessage 'Method_TextDocumentHover
 -> Const Uri (TRequestMessage 'Method_TextDocumentHover))
-> ((Uri -> Const Uri Uri) -> HoverParams -> Const Uri HoverParams)
-> Getting Uri (TRequestMessage 'Method_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
Lens' HoverParams TextDocumentIdentifier
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
Lens' TextDocumentIdentifier Uri
uri

        let Position{ $sel:_line:Position :: Position -> UInt
_line = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
_line, $sel:_character:Position :: Position -> UInt
_character = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
_character } = TRequestMessage 'Method_TextDocumentHover
requestTRequestMessage 'Method_TextDocumentHover
-> Getting
     Position (TRequestMessage 'Method_TextDocumentHover) Position
-> Position
forall s a. s -> Getting a s a -> a
^.(HoverParams -> Const Position HoverParams)
-> TRequestMessage 'Method_TextDocumentHover
-> Const Position (TRequestMessage 'Method_TextDocumentHover)
forall s a. HasParams s a => Lens' s a
Lens' (TRequestMessage 'Method_TextDocumentHover) HoverParams
params((HoverParams -> Const Position HoverParams)
 -> TRequestMessage 'Method_TextDocumentHover
 -> Const Position (TRequestMessage 'Method_TextDocumentHover))
-> ((Position -> Const Position Position)
    -> HoverParams -> Const Position HoverParams)
-> Getting
     Position (TRequestMessage 'Method_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
Lens' HoverParams Position
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 <- EvaluateSettings -> Uri -> HandlerM (Expr Src Void)
loadFile EvaluateSettings
settings Uri
uri_
                (WellTyped
welltyped, WellTyped
_) <- case EvaluateSettings
-> Expr Src Void -> Either DhallError (WellTyped, WellTyped)
typecheck EvaluateSettings
settings 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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a b. (a -> b) -> Maybe a -> Maybe b
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 :: MarkupContent |? b
_contents = MarkupContent -> MarkupContent |? b
forall a b. a -> a |? b
InL (Text -> MarkupContent
mkPlainText (Expr Src Void -> Text
forall a. Pretty a => a -> Text
pretty Expr Src Void
typ))
                        Either ResponseError (Hover |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond ((Hover |? Null) -> Either ResponseError (Hover |? Null)
forall a b. b -> Either a b
Right (Hover -> Hover |? Null
forall a b. a -> a |? b
InL Hover{ MarkupContent |? (MarkedString |? [MarkedString])
forall {b}. MarkupContent |? b
_contents :: forall {b}. MarkupContent |? b
$sel:_contents:Hover :: MarkupContent |? (MarkedString |? [MarkedString])
_contents, Maybe Range
_range :: Maybe Range
$sel:_range:Hover :: 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
MarkupKind_Markdown

                            _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 :: MarkupContent |? b
_contents = MarkupContent -> MarkupContent |? b
forall a b. a -> a |? b
InL MarkupContent{Text
MarkupKind
_kind :: MarkupKind
_value :: Text
$sel:_kind:MarkupContent :: MarkupKind
$sel:_value:MarkupContent :: Text
..}
                        Hover -> Maybe Hover
forall a. a -> Maybe a
Just Hover{ MarkupContent |? (MarkedString |? [MarkedString])
forall {b}. MarkupContent |? b
$sel:_contents:Hover :: MarkupContent |? (MarkedString |? [MarkedString])
_contents :: forall {b}. MarkupContent |? b
_contents, Maybe Range
$sel:_range:Hover :: Maybe Range
_range :: 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 (Hover |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond ((Hover |? Null) -> Either ResponseError (Hover |? Null)
forall a b. b -> Either a b
Right (Maybe Hover -> Hover |? Null
forall a. Maybe a -> a |? Null
maybeToNull Maybe Hover
mHover))

documentLinkHandler :: Handlers HandlerM
documentLinkHandler :: Handlers
  (ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
documentLinkHandler =
    SMethod 'Method_TextDocumentDocumentLink
-> Handler
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
     'Method_TextDocumentDocumentLink
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.requestHandler SMethod 'Method_TextDocumentDocumentLink
SMethod_TextDocumentDocumentLink \TRequestMessage 'Method_TextDocumentDocumentLink
request Either ResponseError ([DocumentLink] |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond -> (Either ResponseError ([DocumentLink] |? Null)
 -> ExceptT
      (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ())
-> ([DocumentLink] |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a1 b a2.
(Either a1 b -> HandlerM a2) -> b -> HandlerM a2 -> HandlerM a2
handleErrorWithDefault Either ResponseError ([DocumentLink] |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond ([DocumentLink] -> [DocumentLink] |? Null
forall a b. a -> a |? b
InL []) do
        let uri_ :: Uri
uri_ = TRequestMessage 'Method_TextDocumentDocumentLink
requestTRequestMessage 'Method_TextDocumentDocumentLink
-> Getting
     Uri (TRequestMessage 'Method_TextDocumentDocumentLink) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^.(DocumentLinkParams -> Const Uri DocumentLinkParams)
-> TRequestMessage 'Method_TextDocumentDocumentLink
-> Const Uri (TRequestMessage 'Method_TextDocumentDocumentLink)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentDocumentLink)
  DocumentLinkParams
params((DocumentLinkParams -> Const Uri DocumentLinkParams)
 -> TRequestMessage 'Method_TextDocumentDocumentLink
 -> Const Uri (TRequestMessage 'Method_TextDocumentDocumentLink))
-> ((Uri -> Const Uri Uri)
    -> DocumentLinkParams -> Const Uri DocumentLinkParams)
-> Getting
     Uri (TRequestMessage 'Method_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
Lens' DocumentLinkParams TextDocumentIdentifier
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
Lens' TextDocumentIdentifier Uri
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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 Text
_target = Text -> Maybe Text
forall a. a -> Maybe a
Just (Uri -> Text
getUri (String -> Uri
filePathToUri String
filePath'))
              let _tooltip :: Maybe a
_tooltip = Maybe a
forall a. Maybe a
Nothing
              let _data_ :: Maybe a
_data_ = Maybe a
forall a. Maybe a
Nothing
              [DocumentLink] -> IO [DocumentLink]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DocumentLink {Maybe Value
Maybe Text
Range
forall a. Maybe a
_range :: Range
_target :: Maybe Text
_tooltip :: forall a. Maybe a
_data_ :: forall a. Maybe a
$sel:_range:DocumentLink :: Range
$sel:_target:DocumentLink :: Maybe Text
$sel:_tooltip:DocumentLink :: Maybe Text
$sel:_data_:DocumentLink :: Maybe Value
..}]

            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 = Nothing }
              let _target :: Maybe Text
_target = Text -> Maybe Text
forall a. a -> Maybe a
Just (URL -> Text
forall a. Pretty a => a -> Text
pretty URL
url')
              let _tooltip :: Maybe a
_tooltip = Maybe a
forall a. Maybe a
Nothing
              let _data_ :: Maybe a
_data_ = Maybe a
forall a. Maybe a
Nothing
              [DocumentLink] -> IO [DocumentLink]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DocumentLink {Maybe Value
Maybe Text
Range
forall a. Maybe a
$sel:_range:DocumentLink :: Range
$sel:_target:DocumentLink :: Maybe Text
$sel:_tooltip:DocumentLink :: Maybe Text
$sel:_data_:DocumentLink :: Maybe Value
_range :: Range
_target :: Maybe Text
_tooltip :: forall a. Maybe a
_data_ :: forall a. Maybe a
..}]

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

        [[DocumentLink]]
links <- IO [[DocumentLink]]
-> ExceptT
     (Severity, Text)
     (StateT ServerState (LspT ServerConfig IO))
     [[DocumentLink]]
forall a.
IO a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Range, Import) -> IO [DocumentLink]
go [(Range, Import)]
imports
        Either ResponseError ([DocumentLink] |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond (([DocumentLink] |? Null)
-> Either ResponseError ([DocumentLink] |? Null)
forall a b. b -> Either a b
Right ([DocumentLink] -> [DocumentLink] |? Null
forall a b. a -> a |? b
InL ([[DocumentLink]] -> [DocumentLink]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[DocumentLink]]
links)))


diagnosticsHandler :: EvaluateSettings -> Uri -> HandlerM ()
diagnosticsHandler :: EvaluateSettings
-> Uri
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
diagnosticsHandler EvaluateSettings
settings 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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
a
-> ExceptT DhallError (StateT ServerState (LspT ServerConfig IO)) a
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 a.
IO a
-> ExceptT DhallError (StateT ServerState (LspT ServerConfig IO)) a
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
$ EvaluateSettings
-> FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Expr Src Void))
load EvaluateSettings
settings 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 a.
a
-> ExceptT DhallError (StateT ServerState (LspT ServerConfig IO)) a
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 EvaluateSettings
-> Expr Src Void -> Either DhallError (WellTyped, WellTyped)
typecheck EvaluateSettings
settings Expr Src Void
expr' of
        Right (WellTyped
wt, WellTyped
_typ) -> WellTyped
-> ExceptT
     DhallError (StateT ServerState (LspT ServerConfig IO)) WellTyped
forall a.
a
-> ExceptT DhallError (StateT ServerState (LspT ServerConfig IO)) a
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 a.
a
-> ExceptT DhallError (StateT ServerState (LspT ServerConfig IO)) a
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 :: Text
suggestion :: 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
DiagnosticSeverity_Hint
            _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
            _codeDescription :: Maybe a
_codeDescription = 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
            _data_ :: Maybe a
_data_ = Maybe a
forall a. Maybe a
Nothing
        in Diagnostic {Maybe [DiagnosticTag]
Maybe [DiagnosticRelatedInformation]
Maybe Value
Maybe Text
Maybe (Int32 |? Text)
Maybe DiagnosticSeverity
Maybe CodeDescription
Text
Range
forall a. Maybe a
_range :: Range
_severity :: Maybe DiagnosticSeverity
_source :: Maybe Text
_code :: forall a. Maybe a
_codeDescription :: forall a. Maybe a
_message :: Text
_tags :: forall a. Maybe a
_relatedInformation :: forall a. Maybe a
_data_ :: forall a. Maybe a
$sel:_range:Diagnostic :: Range
$sel:_severity:Diagnostic :: Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Maybe CodeDescription
$sel:_source:Diagnostic :: Maybe Text
$sel:_message:Diagnostic :: Text
$sel:_tags:Diagnostic :: Maybe [DiagnosticTag]
$sel:_relatedInformation:Diagnostic :: Maybe [DiagnosticRelatedInformation]
$sel:_data_:Diagnostic :: Maybe Value
..}

      diagnosisToDiagnostic :: Diagnosis -> Diagnostic
diagnosisToDiagnostic Diagnosis { range :: Diagnosis -> Maybe Range
range = Maybe Range
range_, Text
doctor :: Text
diagnosis :: Text
doctor :: Diagnosis -> Text
diagnosis :: Diagnosis -> 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
DiagnosticSeverity_Error
            _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
            _codeDescription :: Maybe a
_codeDescription = 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
            _data_ :: Maybe a
_data_ = Maybe a
forall a. Maybe a
Nothing
        in Diagnostic {Maybe [DiagnosticTag]
Maybe [DiagnosticRelatedInformation]
Maybe Value
Maybe Text
Maybe (Int32 |? Text)
Maybe DiagnosticSeverity
Maybe CodeDescription
Text
Range
forall a. Maybe a
$sel:_range:Diagnostic :: Range
$sel:_severity:Diagnostic :: Maybe DiagnosticSeverity
$sel:_code:Diagnostic :: Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Maybe CodeDescription
$sel:_source:Diagnostic :: Maybe Text
$sel:_message:Diagnostic :: Text
$sel:_tags:Diagnostic :: Maybe [DiagnosticTag]
$sel:_relatedInformation:Diagnostic :: Maybe [DiagnosticRelatedInformation]
$sel:_data_:Diagnostic :: Maybe Value
_range :: Range
_severity :: Maybe DiagnosticSeverity
_source :: Maybe Text
_code :: forall a. Maybe a
_codeDescription :: forall a. Maybe a
_tags :: forall a. Maybe a
_message :: Text
_relatedInformation :: forall a. Maybe a
_data_ :: forall a. Maybe a
..}

  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 :: [Diagnostic]
_diagnostics =
              (   (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 'Method_TextDocumentPublishDiagnostics
-> MessageParams 'Method_TextDocumentPublishDiagnostics
-> LspT ServerConfig IO ()
forall (m :: Method 'ServerToClient 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification SServerMethod 'Method_TextDocumentPublishDiagnostics
SMethod_TextDocumentPublishDiagnostics PublishDiagnosticsParams{ Uri
_uri :: Uri
$sel:_uri:PublishDiagnosticsParams :: Uri
_uri, Maybe Int32
forall a. Maybe a
_version :: forall a. Maybe a
$sel:_version:PublishDiagnosticsParams :: Maybe Int32
_version, [Diagnostic]
_diagnostics :: [Diagnostic]
$sel:_diagnostics:PublishDiagnosticsParams :: [Diagnostic]
_diagnostics })

documentFormattingHandler :: Handlers HandlerM
documentFormattingHandler :: Handlers
  (ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
documentFormattingHandler =
    SMethod 'Method_TextDocumentFormatting
-> Handler
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
     'Method_TextDocumentFormatting
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.requestHandler SMethod 'Method_TextDocumentFormatting
SMethod_TextDocumentFormatting \TRequestMessage 'Method_TextDocumentFormatting
request Either ResponseError ([TextEdit] |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond -> (Either ResponseError ([TextEdit] |? Null)
 -> ExceptT
      (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ())
-> ([TextEdit] |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a1 b a2.
(Either a1 b -> HandlerM a2) -> b -> HandlerM a2 -> HandlerM a2
handleErrorWithDefault Either ResponseError ([TextEdit] |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond ([TextEdit] -> [TextEdit] |? Null
forall a b. a -> a |? b
InL []) do
        let _uri :: Uri
_uri = TRequestMessage 'Method_TextDocumentFormatting
requestTRequestMessage 'Method_TextDocumentFormatting
-> Getting Uri (TRequestMessage 'Method_TextDocumentFormatting) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^.(DocumentFormattingParams -> Const Uri DocumentFormattingParams)
-> TRequestMessage 'Method_TextDocumentFormatting
-> Const Uri (TRequestMessage 'Method_TextDocumentFormatting)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentFormatting)
  DocumentFormattingParams
params((DocumentFormattingParams -> Const Uri DocumentFormattingParams)
 -> TRequestMessage 'Method_TextDocumentFormatting
 -> Const Uri (TRequestMessage 'Method_TextDocumentFormatting))
-> ((Uri -> Const Uri Uri)
    -> DocumentFormattingParams -> Const Uri DocumentFormattingParams)
-> Getting Uri (TRequestMessage 'Method_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
Lens' DocumentFormattingParams TextDocumentIdentifier
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
Lens' TextDocumentIdentifier Uri
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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 :: 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 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 ([TextEdit] |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond (([TextEdit] |? Null) -> Either ResponseError ([TextEdit] |? Null)
forall a b. b -> Either a b
Right ([TextEdit] -> [TextEdit] |? Null
forall a b. a -> a |? b
InL [TextEdit{Text
Range
_newText :: Text
_range :: Range
$sel:_range:TextEdit :: Range
$sel:_newText:TextEdit :: Text
..}]))


executeCommandHandler :: EvaluateSettings -> Handlers HandlerM
executeCommandHandler :: EvaluateSettings
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
executeCommandHandler EvaluateSettings
settings =
    SMethod 'Method_WorkspaceExecuteCommand
-> Handler
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
     'Method_WorkspaceExecuteCommand
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.requestHandler SMethod 'Method_WorkspaceExecuteCommand
SMethod_WorkspaceExecuteCommand \TRequestMessage 'Method_WorkspaceExecuteCommand
request Either ResponseError (Value |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond -> (Either ResponseError (Value |? Null)
 -> ExceptT
      (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ())
-> (Value |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a1 b a2.
(Either a1 b -> HandlerM a2) -> b -> HandlerM a2 -> HandlerM a2
handleErrorWithDefault Either ResponseError (Value |? Null)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond (Value -> Value |? Null
forall a b. a -> a |? b
InL Value
Aeson.Null) do
        let command_ :: Text
command_ = TRequestMessage 'Method_WorkspaceExecuteCommand
requestTRequestMessage 'Method_WorkspaceExecuteCommand
-> Getting
     Text (TRequestMessage 'Method_WorkspaceExecuteCommand) Text
-> Text
forall s a. s -> Getting a s a -> a
^.(ExecuteCommandParams -> Const Text ExecuteCommandParams)
-> TRequestMessage 'Method_WorkspaceExecuteCommand
-> Const Text (TRequestMessage 'Method_WorkspaceExecuteCommand)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_WorkspaceExecuteCommand)
  ExecuteCommandParams
params((ExecuteCommandParams -> Const Text ExecuteCommandParams)
 -> TRequestMessage 'Method_WorkspaceExecuteCommand
 -> Const Text (TRequestMessage 'Method_WorkspaceExecuteCommand))
-> ((Text -> Const Text Text)
    -> ExecuteCommandParams -> Const Text ExecuteCommandParams)
-> Getting
     Text (TRequestMessage 'Method_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
Lens' ExecuteCommandParams Text
command
        if  | Text
command_ Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dhall.server.lint" ->
                TRequestMessage 'Method_WorkspaceExecuteCommand
-> (Either ResponseError (Value |? Null)
    -> ExceptT
         (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ())
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a b.
TRequestMessage 'Method_WorkspaceExecuteCommand
-> (Either a (Value |? Null) -> HandlerM b)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeLintAndFormat TRequestMessage 'Method_WorkspaceExecuteCommand
request Either ResponseError (Value |? Null)
-> 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" ->
                EvaluateSettings
-> TRequestMessage 'Method_WorkspaceExecuteCommand
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeAnnotateLet EvaluateSettings
settings TRequestMessage 'Method_WorkspaceExecuteCommand
request
            | Text
command_ Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dhall.server.freezeImport" ->
                EvaluateSettings
-> TRequestMessage 'Method_WorkspaceExecuteCommand
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeFreezeImport EvaluateSettings
settings TRequestMessage 'Method_WorkspaceExecuteCommand
request
            | Text
command_ Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dhall.server.freezeAllImports" ->
                EvaluateSettings
-> TRequestMessage 'Method_WorkspaceExecuteCommand
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeFreezeAllImports EvaluateSettings
settings TRequestMessage 'Method_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 => TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM a
-- (HasParams s a, FromJSON a) => s -> HandlerM a
getCommandArguments :: forall a.
FromJSON a =>
TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM a
getCommandArguments TRequestMessage 'Method_WorkspaceExecuteCommand
request = do
  Value
json <- case TRequestMessage 'Method_WorkspaceExecuteCommand
request TRequestMessage 'Method_WorkspaceExecuteCommand
-> Getting
     (Maybe [Value])
     (TRequestMessage 'Method_WorkspaceExecuteCommand)
     (Maybe [Value])
-> Maybe [Value]
forall s a. s -> Getting a s a -> a
^. (ExecuteCommandParams
 -> Const (Maybe [Value]) ExecuteCommandParams)
-> TRequestMessage 'Method_WorkspaceExecuteCommand
-> Const
     (Maybe [Value]) (TRequestMessage 'Method_WorkspaceExecuteCommand)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_WorkspaceExecuteCommand)
  ExecuteCommandParams
params ((ExecuteCommandParams
  -> Const (Maybe [Value]) ExecuteCommandParams)
 -> TRequestMessage 'Method_WorkspaceExecuteCommand
 -> Const
      (Maybe [Value]) (TRequestMessage 'Method_WorkspaceExecuteCommand))
-> ((Maybe [Value] -> Const (Maybe [Value]) (Maybe [Value]))
    -> ExecuteCommandParams
    -> Const (Maybe [Value]) ExecuteCommandParams)
-> Getting
     (Maybe [Value])
     (TRequestMessage 'Method_WorkspaceExecuteCommand)
     (Maybe [Value])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [Value] -> Const (Maybe [Value]) (Maybe [Value]))
-> ExecuteCommandParams
-> Const (Maybe [Value]) ExecuteCommandParams
forall s a. HasArguments s a => Lens' s a
Lens' ExecuteCommandParams (Maybe [Value])
arguments of
    Just (Value
x : [Value]
_) -> Value
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) Value
forall a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
x
    Maybe [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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) 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
    :: TRequestMessage 'Method_WorkspaceExecuteCommand
    -> (Either a (Value |? Null) -> HandlerM b)
    -> HandlerM ()
executeLintAndFormat :: forall a b.
TRequestMessage 'Method_WorkspaceExecuteCommand
-> (Either a (Value |? Null) -> HandlerM b)
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeLintAndFormat TRequestMessage 'Method_WorkspaceExecuteCommand
request Either a (Value |? Null) -> HandlerM b
respond = do
  Uri
uri_ <- TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM Uri
forall a.
FromJSON a =>
TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM a
getCommandArguments TRequestMessage 'Method_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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 :: 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 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
              { $sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
_changes = Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
Map.singleton Uri
uri_ [TextEdit{Text
Range
$sel:_range:TextEdit :: Range
$sel:_newText:TextEdit :: Text
_newText :: Text
_range :: Range
..}])
              , $sel:_documentChanges:WorkspaceEdit :: Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_documentChanges = Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a. Maybe a
Nothing
              , $sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
_changeAnnotations = Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing
              }

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

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

  LspId 'Method_WorkspaceApplyEdit
_ <- LspT ServerConfig IO (LspId 'Method_WorkspaceApplyEdit)
-> HandlerM (LspId 'Method_WorkspaceApplyEdit)
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP (SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> (Either ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
    -> LspT ServerConfig IO ())
-> LspT ServerConfig IO (LspId 'Method_WorkspaceApplyEdit)
forall (m :: Method 'ServerToClient 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (MessageResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit 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 ApplyWorkspaceEditResult
-> LspT ServerConfig IO ()
Either ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
-> LspT ServerConfig IO ()
forall a. a -> LspT ServerConfig IO ()
nullHandler)

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

executeAnnotateLet
    :: EvaluateSettings
    -> TRequestMessage 'Method_WorkspaceExecuteCommand
    -> HandlerM ()
executeAnnotateLet :: EvaluateSettings
-> TRequestMessage 'Method_WorkspaceExecuteCommand
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeAnnotateLet EvaluateSettings
settings TRequestMessage 'Method_WorkspaceExecuteCommand
request = do
  TextDocumentPositionParams
args <- TRequestMessage 'Method_WorkspaceExecuteCommand
-> HandlerM TextDocumentPositionParams
forall a.
FromJSON a =>
TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM a
getCommandArguments TRequestMessage 'Method_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
Lens' TextDocumentPositionParams TextDocumentIdentifier
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
Lens' TextDocumentIdentifier Uri
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
Lens' TextDocumentPositionParams Position
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
Lens' Position UInt
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
Lens' TextDocumentPositionParams Position
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
Lens' Position UInt
character)

  Expr Src Void
expr <- EvaluateSettings -> Uri -> HandlerM (Expr Src Void)
loadFile EvaluateSettings
settings Uri
uri_
  (WellTyped
welltyped, WellTyped
_) <- case EvaluateSettings
-> Expr Src Void -> Either DhallError (WellTyped, WellTyped)
typecheck EvaluateSettings
settings 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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WellTyped, WellTyped)
e

  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

  (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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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
          { $sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
_changes = Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
Map.singleton Uri
uri_ [TextEdit{Text
Range
$sel:_range:TextEdit :: Range
$sel:_newText:TextEdit :: Text
_range :: Range
_newText :: Text
..}])
          , $sel:_documentChanges:WorkspaceEdit :: Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_documentChanges = Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a. Maybe a
Nothing
          , $sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
_changeAnnotations = Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing
          }

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

  LspId 'Method_WorkspaceApplyEdit
_ <- LspT ServerConfig IO (LspId 'Method_WorkspaceApplyEdit)
-> HandlerM (LspId 'Method_WorkspaceApplyEdit)
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP (SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> (Either ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
    -> LspT ServerConfig IO ())
-> LspT ServerConfig IO (LspId 'Method_WorkspaceApplyEdit)
forall (m :: Method 'ServerToClient 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (MessageResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit 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 ApplyWorkspaceEditResult
-> LspT ServerConfig IO ()
Either ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
-> LspT ServerConfig IO ()
forall a. a -> LspT ServerConfig IO ()
nullHandler)

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

executeFreezeAllImports
    :: EvaluateSettings
    -> TRequestMessage 'Method_WorkspaceExecuteCommand
    -> HandlerM ()
executeFreezeAllImports :: EvaluateSettings
-> TRequestMessage 'Method_WorkspaceExecuteCommand
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeFreezeAllImports EvaluateSettings
settings TRequestMessage 'Method_WorkspaceExecuteCommand
request = do
  Uri
uri_ <- TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM Uri
forall a.
FromJSON a =>
TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM a
getCommandArguments TRequestMessage 'Method_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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
IO a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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
$ EvaluateSettings
-> FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Text))
computeSemanticHash EvaluateSettings
settings 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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return TextEdit{Text
Range
$sel:_range:TextEdit :: Range
$sel:_newText:TextEdit :: Text
_range :: Range
_newText :: Text
..}

  let _edit :: WorkspaceEdit
_edit = WorkspaceEdit
          { $sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
_changes = Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
Map.singleton Uri
uri_ [TextEdit]
edits_)
          , $sel:_documentChanges:WorkspaceEdit :: Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_documentChanges = Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a. Maybe a
Nothing
          , $sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
_changeAnnotations = Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing
          }

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

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

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

executeFreezeImport
    :: EvaluateSettings
    -> TRequestMessage 'Method_WorkspaceExecuteCommand
    -> HandlerM ()
executeFreezeImport :: EvaluateSettings
-> TRequestMessage 'Method_WorkspaceExecuteCommand
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
executeFreezeImport EvaluateSettings
settings TRequestMessage 'Method_WorkspaceExecuteCommand
request = do
  TextDocumentPositionParams
args <- TRequestMessage 'Method_WorkspaceExecuteCommand
-> HandlerM TextDocumentPositionParams
forall a.
FromJSON a =>
TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM a
getCommandArguments TRequestMessage 'Method_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
Lens' TextDocumentPositionParams TextDocumentIdentifier
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
Lens' TextDocumentIdentifier Uri
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
Lens' TextDocumentPositionParams Position
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
Lens' Position UInt
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
Lens' TextDocumentPositionParams Position
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
Lens' Position UInt
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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
IO a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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
$ EvaluateSettings
-> FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Text))
computeSemanticHash EvaluateSettings
settings 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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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
          { $sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
_changes = Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
Map.singleton Uri
uri_ [TextEdit{Text
Range
$sel:_range:TextEdit :: Range
$sel:_newText:TextEdit :: Text
_range :: Range
_newText :: Text
..}])
          , $sel:_documentChanges:WorkspaceEdit :: Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_documentChanges = Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a. Maybe a
Nothing
          , $sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
_changeAnnotations = Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing
          }

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

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

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

completionHandler :: EvaluateSettings -> Handlers HandlerM
completionHandler :: EvaluateSettings
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
completionHandler EvaluateSettings
settings =
  SMethod 'Method_TextDocumentCompletion
-> Handler
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
     'Method_TextDocumentCompletion
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.requestHandler SMethod 'Method_TextDocumentCompletion
SMethod_TextDocumentCompletion \TRequestMessage 'Method_TextDocumentCompletion
request Either ResponseError ([CompletionItem] |? (CompletionList |? Null))
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond -> (Either
   ResponseError ([CompletionItem] |? (CompletionList |? Null))
 -> ExceptT
      (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ())
-> ([CompletionItem] |? (CompletionList |? Null))
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a1 b a2.
(Either a1 b -> HandlerM a2) -> b -> HandlerM a2 -> HandlerM a2
handleErrorWithDefault Either ResponseError ([CompletionItem] |? (CompletionList |? Null))
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond ((CompletionList |? Null)
-> [CompletionItem] |? (CompletionList |? Null)
forall a b. b -> a |? b
InR (CompletionList -> CompletionList |? Null
forall a b. a -> a |? b
InL (Bool
-> Maybe
     (Rec
        (("commitCharacters" .== Maybe [Text])
         .+ (("editRange"
              .== Maybe
                    (Range
                     |? Rec (("insert" .== Range) .+ (("replace" .== Range) .+ Empty))))
             .+ (("insertTextFormat" .== Maybe InsertTextFormat)
                 .+ (("insertTextMode" .== Maybe InsertTextMode)
                     .+ (("data" .== Maybe Value) .+ Empty))))))
-> [CompletionItem]
-> CompletionList
CompletionList Bool
False Maybe
  (Rec
     (("commitCharacters" .== Maybe [Text])
      .+ (("editRange"
           .== Maybe
                 (Range
                  |? Rec (("insert" .== Range) .+ (("replace" .== Range) .+ Empty))))
          .+ (("insertTextFormat" .== Maybe InsertTextFormat)
              .+ (("insertTextMode" .== Maybe InsertTextMode)
                  .+ (("data" .== Maybe Value) .+ Empty))))))
Maybe
  (Rec
     ('R
        '["commitCharacters" ':-> Maybe [Text], "data" ':-> Maybe Value,
          "editRange"
          ':-> Maybe
                 (Range |? Rec ('R '["insert" ':-> Range, "replace" ':-> Range])),
          "insertTextFormat" ':-> Maybe InsertTextFormat,
          "insertTextMode" ':-> Maybe InsertTextMode]))
forall a. Maybe a
Nothing []))) do
    let uri_ :: Uri
uri_  = TRequestMessage 'Method_TextDocumentCompletion
request TRequestMessage 'Method_TextDocumentCompletion
-> Getting Uri (TRequestMessage 'Method_TextDocumentCompletion) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (CompletionParams -> Const Uri CompletionParams)
-> TRequestMessage 'Method_TextDocumentCompletion
-> Const Uri (TRequestMessage 'Method_TextDocumentCompletion)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentCompletion) CompletionParams
params ((CompletionParams -> Const Uri CompletionParams)
 -> TRequestMessage 'Method_TextDocumentCompletion
 -> Const Uri (TRequestMessage 'Method_TextDocumentCompletion))
-> ((Uri -> Const Uri Uri)
    -> CompletionParams -> Const Uri CompletionParams)
-> Getting Uri (TRequestMessage 'Method_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
Lens' CompletionParams TextDocumentIdentifier
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
Lens' TextDocumentIdentifier Uri
uri
        line_ :: Int
line_ = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TRequestMessage 'Method_TextDocumentCompletion
request TRequestMessage 'Method_TextDocumentCompletion
-> Getting
     UInt (TRequestMessage 'Method_TextDocumentCompletion) UInt
-> UInt
forall s a. s -> Getting a s a -> a
^. (CompletionParams -> Const UInt CompletionParams)
-> TRequestMessage 'Method_TextDocumentCompletion
-> Const UInt (TRequestMessage 'Method_TextDocumentCompletion)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentCompletion) CompletionParams
params ((CompletionParams -> Const UInt CompletionParams)
 -> TRequestMessage 'Method_TextDocumentCompletion
 -> Const UInt (TRequestMessage 'Method_TextDocumentCompletion))
-> ((UInt -> Const UInt UInt)
    -> CompletionParams -> Const UInt CompletionParams)
-> Getting
     UInt (TRequestMessage 'Method_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
Lens' CompletionParams Position
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
Lens' Position UInt
line)
        col_ :: Int
col_  = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TRequestMessage 'Method_TextDocumentCompletion
request TRequestMessage 'Method_TextDocumentCompletion
-> Getting
     UInt (TRequestMessage 'Method_TextDocumentCompletion) UInt
-> UInt
forall s a. s -> Getting a s a -> a
^. (CompletionParams -> Const UInt CompletionParams)
-> TRequestMessage 'Method_TextDocumentCompletion
-> Const UInt (TRequestMessage 'Method_TextDocumentCompletion)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentCompletion) CompletionParams
params ((CompletionParams -> Const UInt CompletionParams)
 -> TRequestMessage 'Method_TextDocumentCompletion
 -> Const UInt (TRequestMessage 'Method_TextDocumentCompletion))
-> ((UInt -> Const UInt UInt)
    -> CompletionParams -> Const UInt CompletionParams)
-> Getting
     UInt (TRequestMessage 'Method_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
Lens' CompletionParams Position
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
Lens' Position UInt
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 a.
IO a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
IO a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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
_) <- HasCallStack => Text -> Text -> (Text, 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 a.
IO a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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
$ EvaluateSettings
-> FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Expr Src Void))
load EvaluateSettings
settings 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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
IO a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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
$ EvaluateSettings
-> FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Expr Src Void))
load EvaluateSettings
settings 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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
IO a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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
$ EvaluateSettings
-> FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Expr Src Void))
load EvaluateSettings
settings 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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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 a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
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
completeText :: Text
completeType :: Maybe (Expr Src Void)
completeText :: Completion -> Text
completeType :: Completion -> Maybe (Expr Src Void)
..}) = CompletionItem {Maybe Bool
Maybe [Text]
Maybe [TextEdit]
Maybe [CompletionItemTag]
Maybe Value
Maybe Text
Maybe (Text |? MarkupContent)
Maybe (TextEdit |? InsertReplaceEdit)
Maybe InsertTextMode
Maybe InsertTextFormat
Maybe CompletionItemLabelDetails
Maybe CompletionItemKind
Maybe Command
Text
forall a. Maybe a
_label :: Text
_labelDetails :: forall a. Maybe a
_kind :: forall a. Maybe a
_tags :: Maybe [CompletionItemTag]
_detail :: Maybe Text
_documentation :: forall a. Maybe a
_deprecated :: forall a. Maybe a
_preselect :: forall a. Maybe a
_sortText :: forall a. Maybe a
_filterText :: forall a. Maybe a
_insertText :: forall a. Maybe a
_insertTextFormat :: forall a. Maybe a
_insertTextMode :: forall a. Maybe a
_textEdit :: forall a. Maybe a
_textEditText :: forall a. Maybe a
_additionalTextEdits :: forall a. Maybe a
_commitCharacters :: forall a. Maybe a
_command :: forall a. Maybe a
_data_ :: forall a. Maybe a
$sel:_label:CompletionItem :: Text
$sel:_labelDetails:CompletionItem :: Maybe CompletionItemLabelDetails
$sel:_kind:CompletionItem :: Maybe CompletionItemKind
$sel:_tags:CompletionItem :: Maybe [CompletionItemTag]
$sel:_detail:CompletionItem :: Maybe Text
$sel:_documentation:CompletionItem :: Maybe (Text |? MarkupContent)
$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 (TextEdit |? InsertReplaceEdit)
$sel:_textEditText:CompletionItem :: Maybe Text
$sel:_additionalTextEdits:CompletionItem :: Maybe [TextEdit]
$sel:_commitCharacters:CompletionItem :: Maybe [Text]
$sel:_command:CompletionItem :: Maybe Command
$sel:_data_:CompletionItem :: Maybe Value
..}
         where
          _label :: Text
_label = Text
completeText
          _labelDetails :: Maybe a
_labelDetails = Maybe a
forall a. Maybe a
Nothing
          _kind :: Maybe a
_kind = Maybe a
forall a. Maybe a
Nothing
          _tags :: Maybe [CompletionItemTag]
_tags = Maybe [CompletionItemTag]
forall a. Monoid a => a
mempty
          _detail :: Maybe Text
_detail = (Expr Src Void -> Text) -> Maybe (Expr Src Void) -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
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
          _textEditText :: Maybe a
_textEditText = 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
          _data_ :: Maybe a
_data_ = Maybe a
forall a. Maybe a
Nothing

    let _items :: [CompletionItem]
_items = ((Completion -> CompletionItem) -> [Completion] -> [CompletionItem]
forall a b. (a -> b) -> [a] -> [b]
map Completion -> CompletionItem
toCompletionItem [Completion]
completions)
    let _itemDefaults :: Maybe a
_itemDefaults = Maybe a
forall a. Maybe a
Nothing
    let _isIncomplete :: Bool
_isIncomplete = Bool
False

    Either ResponseError ([CompletionItem] |? (CompletionList |? Null))
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
respond (([CompletionItem] |? (CompletionList |? Null))
-> Either
     ResponseError ([CompletionItem] |? (CompletionList |? Null))
forall a b. b -> Either a b
Right ((CompletionList |? Null)
-> [CompletionItem] |? (CompletionList |? Null)
forall a b. b -> a |? b
InR (CompletionList -> CompletionList |? Null
forall a b. a -> a |? b
InL CompletionList{Bool
[CompletionItem]
Maybe
  (Rec
     (("commitCharacters" .== Maybe [Text])
      .+ (("editRange"
           .== Maybe
                 (Range
                  |? Rec (("insert" .== Range) .+ (("replace" .== Range) .+ Empty))))
          .+ (("insertTextFormat" .== Maybe InsertTextFormat)
              .+ (("insertTextMode" .== Maybe InsertTextMode)
                  .+ (("data" .== Maybe Value) .+ Empty))))))
Maybe
  (Rec
     ('R
        '["commitCharacters" ':-> Maybe [Text], "data" ':-> Maybe Value,
          "editRange"
          ':-> Maybe
                 (Range |? Rec ('R '["insert" ':-> Range, "replace" ':-> Range])),
          "insertTextFormat" ':-> Maybe InsertTextFormat,
          "insertTextMode" ':-> Maybe InsertTextMode]))
forall a. Maybe a
_items :: [CompletionItem]
_itemDefaults :: forall a. Maybe a
_isIncomplete :: Bool
$sel:_isIncomplete:CompletionList :: Bool
$sel:_itemDefaults:CompletionList :: Maybe
  (Rec
     (("commitCharacters" .== Maybe [Text])
      .+ (("editRange"
           .== Maybe
                 (Range
                  |? Rec (("insert" .== Range) .+ (("replace" .== Range) .+ Empty))))
          .+ (("insertTextFormat" .== Maybe InsertTextFormat)
              .+ (("insertTextMode" .== Maybe InsertTextMode)
                  .+ (("data" .== Maybe Value) .+ Empty))))))
$sel:_items:CompletionList :: [CompletionItem]
..})))

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

didOpenTextDocumentNotificationHandler :: EvaluateSettings -> Handlers HandlerM
didOpenTextDocumentNotificationHandler :: EvaluateSettings
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
didOpenTextDocumentNotificationHandler EvaluateSettings
settings =
    SMethod 'Method_TextDocumentDidOpen
-> Handler
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
     'Method_TextDocumentDidOpen
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.notificationHandler SMethod 'Method_TextDocumentDidOpen
SMethod_TextDocumentDidOpen \TNotificationMessage 'Method_TextDocumentDidOpen
notification -> do
        let _uri :: Uri
_uri = TNotificationMessage 'Method_TextDocumentDidOpen
notificationTNotificationMessage 'Method_TextDocumentDidOpen
-> Getting
     Uri (TNotificationMessage 'Method_TextDocumentDidOpen) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^.(DidOpenTextDocumentParams -> Const Uri DidOpenTextDocumentParams)
-> TNotificationMessage 'Method_TextDocumentDidOpen
-> Const Uri (TNotificationMessage 'Method_TextDocumentDidOpen)
forall s a. HasParams s a => Lens' s a
Lens'
  (TNotificationMessage 'Method_TextDocumentDidOpen)
  DidOpenTextDocumentParams
params((DidOpenTextDocumentParams -> Const Uri DidOpenTextDocumentParams)
 -> TNotificationMessage 'Method_TextDocumentDidOpen
 -> Const Uri (TNotificationMessage 'Method_TextDocumentDidOpen))
-> ((Uri -> Const Uri Uri)
    -> DidOpenTextDocumentParams
    -> Const Uri DidOpenTextDocumentParams)
-> Getting
     Uri (TNotificationMessage 'Method_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
Lens' DidOpenTextDocumentParams TextDocumentItem
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
Lens' TextDocumentItem Uri
uri
        EvaluateSettings
-> Uri
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
diagnosticsHandler EvaluateSettings
settings Uri
_uri

didSaveTextDocumentNotificationHandler :: EvaluateSettings -> Handlers HandlerM
didSaveTextDocumentNotificationHandler :: EvaluateSettings
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
didSaveTextDocumentNotificationHandler EvaluateSettings
settings =
    SMethod 'Method_TextDocumentDidSave
-> Handler
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
     'Method_TextDocumentDidSave
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.notificationHandler SMethod 'Method_TextDocumentDidSave
SMethod_TextDocumentDidSave \TNotificationMessage 'Method_TextDocumentDidSave
notification -> do
        let _uri :: Uri
_uri = TNotificationMessage 'Method_TextDocumentDidSave
notificationTNotificationMessage 'Method_TextDocumentDidSave
-> Getting
     Uri (TNotificationMessage 'Method_TextDocumentDidSave) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^.(DidSaveTextDocumentParams -> Const Uri DidSaveTextDocumentParams)
-> TNotificationMessage 'Method_TextDocumentDidSave
-> Const Uri (TNotificationMessage 'Method_TextDocumentDidSave)
forall s a. HasParams s a => Lens' s a
Lens'
  (TNotificationMessage 'Method_TextDocumentDidSave)
  DidSaveTextDocumentParams
params((DidSaveTextDocumentParams -> Const Uri DidSaveTextDocumentParams)
 -> TNotificationMessage 'Method_TextDocumentDidSave
 -> Const Uri (TNotificationMessage 'Method_TextDocumentDidSave))
-> ((Uri -> Const Uri Uri)
    -> DidSaveTextDocumentParams
    -> Const Uri DidSaveTextDocumentParams)
-> Getting
     Uri (TNotificationMessage 'Method_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
Lens' DidSaveTextDocumentParams TextDocumentIdentifier
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
Lens' TextDocumentIdentifier Uri
uri
        EvaluateSettings
-> Uri
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
diagnosticsHandler EvaluateSettings
settings Uri
_uri


-- this handler is a stab to prevent `lsp:no handler for:` messages.
initializedHandler :: Handlers HandlerM
initializedHandler :: Handlers
  (ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
initializedHandler =
    SMethod 'Method_Initialized
-> Handler
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
     'Method_Initialized
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.notificationHandler SMethod 'Method_Initialized
SMethod_Initialized \TNotificationMessage 'Method_Initialized
_ -> ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- this handler is a stab to prevent `lsp:no handler for:` messages.
workspaceChangeConfigurationHandler :: Handlers HandlerM
workspaceChangeConfigurationHandler :: Handlers
  (ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
workspaceChangeConfigurationHandler =
    SMethod 'Method_WorkspaceDidChangeConfiguration
-> Handler
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
     'Method_WorkspaceDidChangeConfiguration
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.notificationHandler SMethod 'Method_WorkspaceDidChangeConfiguration
SMethod_WorkspaceDidChangeConfiguration \TNotificationMessage 'Method_WorkspaceDidChangeConfiguration
_ -> ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- this handler is a stab to prevent `lsp:no handler for:` messages.
textDocumentChangeHandler :: Handlers HandlerM
textDocumentChangeHandler :: Handlers
  (ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
textDocumentChangeHandler =
    SMethod 'Method_TextDocumentDidChange
-> Handler
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
     'Method_TextDocumentDidChange
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.notificationHandler SMethod 'Method_TextDocumentDidChange
SMethod_TextDocumentDidChange \TNotificationMessage 'Method_TextDocumentDidChange
_ -> ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- this handler is a stab to prevent `lsp:no handler for:` messages.
cancelationHandler :: Handlers HandlerM
cancelationHandler :: Handlers
  (ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
cancelationHandler =
    SMethod 'Method_CancelRequest
-> Handler
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
     'Method_CancelRequest
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.notificationHandler SMethod 'Method_CancelRequest
forall {f :: MessageDirection}. SMethod 'Method_CancelRequest
SMethod_CancelRequest \TNotificationMessage 'Method_CancelRequest
_ -> ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- This handler is a stub to prevent `lsp:no handler for:` messages.
documentDidCloseHandler :: Handlers HandlerM
documentDidCloseHandler :: Handlers
  (ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
documentDidCloseHandler =
    SMethod 'Method_TextDocumentDidClose
-> Handler
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
     'Method_TextDocumentDidClose
-> Handlers
     (ExceptT
        (Severity, Text) (StateT ServerState (LspT ServerConfig IO)))
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
LSP.notificationHandler SMethod 'Method_TextDocumentDidClose
SMethod_TextDocumentDidClose \TNotificationMessage 'Method_TextDocumentDidClose
_ -> ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a.
a
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

handleErrorWithDefault :: (Either a1 b -> HandlerM a2)
 -> b
 -> HandlerM a2
 -> HandlerM a2
handleErrorWithDefault :: forall a1 b a2.
(Either a1 b -> HandlerM a2) -> b -> HandlerM a2 -> HandlerM a2
handleErrorWithDefault Either a1 b -> HandlerM a2
respond b
_default = (HandlerM a2 -> ((Severity, Text) -> HandlerM a2) -> HandlerM a2)
-> ((Severity, Text) -> HandlerM a2) -> HandlerM a2 -> HandlerM a2
forall a b c. (a -> b -> c) -> b -> a -> c
flip HandlerM a2 -> ((Severity, Text) -> HandlerM a2) -> HandlerM a2
forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
catchE (Severity, Text) -> HandlerM a2
handler
  where
    handler :: (Severity, Text) -> HandlerM a2
handler (Severity
Log, Text
_message)  = do
                    let _type_ :: MessageType
_type_ = MessageType
MessageType_Log
                    LspT ServerConfig IO ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP (LspT ServerConfig IO ()
 -> ExceptT
      (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ())
-> LspT ServerConfig IO ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a b. (a -> b) -> a -> b
$ SServerMethod 'Method_WindowLogMessage
-> MessageParams 'Method_WindowLogMessage
-> LspT ServerConfig IO ()
forall (m :: Method 'ServerToClient 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification SServerMethod 'Method_WindowLogMessage
SMethod_WindowLogMessage LogMessageParams{Text
MessageType
_message :: Text
_type_ :: MessageType
$sel:_type_:LogMessageParams :: MessageType
$sel:_message:LogMessageParams :: Text
..}
                    Either a1 b -> HandlerM a2
respond (b -> Either a1 b
forall a b. b -> Either a b
Right b
_default)

    handler (Severity
severity_, Text
_message) = do
                    let _type_ :: MessageType
_type_ = case Severity
severity_ of
                          Severity
Error   -> MessageType
MessageType_Error
                          Severity
Warning -> MessageType
MessageType_Warning
                          Severity
Info    -> MessageType
MessageType_Info
#if !MIN_TOOL_VERSION_ghc(9,2,0)
                          Log     -> MessageType_Log
#endif

                    LspT ServerConfig IO ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a. LspT ServerConfig IO a -> HandlerM a
liftLSP (LspT ServerConfig IO ()
 -> ExceptT
      (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ())
-> LspT ServerConfig IO ()
-> ExceptT
     (Severity, Text) (StateT ServerState (LspT ServerConfig IO)) ()
forall a b. (a -> b) -> a -> b
$ SServerMethod 'Method_WindowShowMessage
-> MessageParams 'Method_WindowShowMessage
-> LspT ServerConfig IO ()
forall (m :: Method 'ServerToClient 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification SServerMethod 'Method_WindowShowMessage
SMethod_WindowShowMessage ShowMessageParams{Text
MessageType
_message :: Text
_type_ :: MessageType
$sel:_type_:ShowMessageParams :: MessageType
$sel:_message:ShowMessageParams :: Text
..}
                    Either a1 b -> HandlerM a2
respond (b -> Either a1 b
forall a b. b -> Either a b
Right b
_default)