From 49f4a26867eb81eb59cfea78374bb09dd45edfa3 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Mon, 26 Feb 2024 21:27:58 +0100
Subject: Diagnostics refactor

---
 lsp/Main.hs | 23 +++++++++++------------
 1 file changed, 11 insertions(+), 12 deletions(-)

(limited to 'lsp')

diff --git a/lsp/Main.hs b/lsp/Main.hs
index c3928d6..1784aec 100644
--- a/lsp/Main.hs
+++ b/lsp/Main.hs
@@ -15,29 +15,28 @@ import qualified Language.LSP.Protocol.Lens as L
 import qualified Language.LSP.VFS as L
 import Language.LSP.Server
 
+import qualified HSVIS.Diagnostic as HV
 import qualified HSVIS.Parser as HV
 
 
 parseFile :: NormalizedUri -> T.Text -> [Diagnostic]
 parseFile (NormalizedUri _ fpath) source =
-  case HV.parse (T.unpack fpath) (T.unpack source) of
-    HV.This errs -> map mkDiag errs
-    HV.These errs _ -> map mkDiag errs
-    HV.That _ -> []
+  let (errs, _) = HV.parse (T.unpack fpath) (T.unpack source)
+  in map mkDiag errs
   where
-    mkDiag :: HV.ErrMsg -> Diagnostic
+    mkDiag :: HV.Diagnostic -> Diagnostic
     mkDiag msg = Diagnostic
       { _range =
-          let HV.Pos line col = HV.errPos msg
-              -- TODO: col needs to be UTF-16 based, which this is not
-              pos = Position (fromIntegral line) (fromIntegral col)
-          in Range pos pos
+          let -- TODO: col needs to be UTF-16 based, which this is not
+              mkPos (HV.Pos line col) = Position (fromIntegral line) (fromIntegral col)
+              HV.Range from to = HV.dRange msg
+          in Range (mkPos from) (mkPos to)
       , _severity = Just DiagnosticSeverity_Error
       , _code = Nothing
       , _codeDescription = Nothing
       , _source = Just "hs-vis"
       , _message = T.pack $ intercalate "\n" $
-          HV.errMsg msg : ["In " ++ entry | entry <- reverse (HV.errStk msg)]
+          HV.dMsg msg : ["In " ++ entry | entry <- reverse (HV.dStk msg)]
       , _tags = Nothing
       , _relatedInformation = Nothing
       , _data_ = Nothing
@@ -49,7 +48,7 @@ publishDiagsForUri fileUri = do
     Just vfile -> do
       let diags = parseFile (toNormalizedUri fileUri)
                             (Rope.toText (vfile ^. L.file_text))
-      liftIO $ appendFile "/home/tom/hsvislsplog.txt" ("  -> publishing diags: " ++ show diags ++ "\n")
+      -- liftIO $ appendFile "/home/tom/hsvislsplog.txt" ("  -> publishing diags: " ++ show diags ++ "\n")
       sendNotification SMethod_TextDocumentPublishDiagnostics PublishDiagnosticsParams
         { _uri = fileUri
         , _version = Just (vfile ^. L.lsp_version)
@@ -61,7 +60,7 @@ handlers =
   mconcat
     [ notificationHandler SMethod_Initialized $ \_notif -> do
         sendNotification SMethod_WindowShowMessage (ShowMessageParams MessageType_Info "initialized!")
-        liftIO $ appendFile "/home/tom/hsvislsplog.txt" "initialized\n"
+        -- liftIO $ appendFile "/home/tom/hsvislsplog.txt" "initialized\n"
         pure ()
     , notificationHandler SMethod_TextDocumentDidOpen $ \notif -> do
         let fileUri = notif ^. L.params . L.textDocument . L.uri
-- 
cgit v1.2.3-70-g09d2