never executed always true always false

    1 {-# LANGUAGE DataKinds #-}
    2 {-# LANGUAGE OverloadedStrings #-}
    3 {-# LANGUAGE PolyKinds #-}
    4 {-# LANGUAGE TypeFamilies #-}
    5 
    6 module Conjure.LSP.Handlers.File where
    7 
    8 import Conjure.LSP.Util (getDiagnostics, getErrorsFromText, sendErrorMessage)
    9 import Conjure.Prelude
   10 import Control.Lens
   11 import Data.Text (pack)
   12 import Language.LSP.Diagnostics (partitionBySource)
   13 import Language.LSP.Protocol.Lens (HasParams (..), HasTextDocument (textDocument), HasUri (uri))
   14 import Language.LSP.Protocol.Types (Uri, toNormalizedUri)
   15 import Language.LSP.Server (Handlers, LspM, getVirtualFile, notificationHandler, publishDiagnostics)
   16 import Language.LSP.VFS
   17 import Prettyprinter
   18 import Language.LSP.Protocol.Message (SMethod(SMethod_TextDocumentDidClose, SMethod_TextDocumentDidChange, SMethod_TextDocumentDidOpen, SMethod_CancelRequest, SMethod_TextDocumentDidSave))
   19 
   20 fileHandlers :: Handlers (LspM ())
   21 fileHandlers = mconcat [fileOpenedHandler, fileChangedHandler, fileClosedHandler]
   22 
   23 unhandled :: [Handlers (LspM ())]
   24 unhandled =
   25   [ notificationHandler SMethod_CancelRequest $ \_ -> pure (),
   26     notificationHandler SMethod_TextDocumentDidSave $ \_ -> pure ()
   27   ]
   28 
   29 fileOpenedHandler :: Handlers (LspM ())
   30 fileOpenedHandler = notificationHandler SMethod_TextDocumentDidOpen $ \req -> do
   31   let td = req ^. params . textDocument
   32   doDiagForDocument td
   33   pure ()
   34 
   35 fileChangedHandler :: Handlers (LspM ())
   36 fileChangedHandler = notificationHandler SMethod_TextDocumentDidChange $ \req -> do
   37   let td = req ^. params . textDocument
   38   doDiagForDocument td
   39   pure ()
   40 
   41 -- handle this only to suppress not implemented message
   42 fileClosedHandler :: Handlers (LspM ())
   43 fileClosedHandler = notificationHandler SMethod_TextDocumentDidClose $ \_ -> pure ()
   44 
   45 doDiagForDocument :: (HasUri a Uri, Show a) => a -> LspM () ()
   46 doDiagForDocument d = do
   47   let td = d ^. uri
   48   let doc = toNormalizedUri td
   49   mdoc <- getVirtualFile doc
   50   case mdoc of
   51     Just vf@(VirtualFile _ version _rope) -> do
   52       errs <- getErrorsFromText $ virtualFileText vf
   53       case errs of
   54         Left msg -> sendErrorMessage "An error occured:details incoming" >> sendErrorMessage msg
   55         Right file -> publishDiagnostics 10000 doc (Just $ fromIntegral version) $ partitionBySource $ getDiagnostics file
   56     _ -> sendErrorMessage $ pack . show $ "No virtual file found for: " <> stringToDoc (show d)