newtype over data

datalog-lsp/src/Datalog/LSP/DocChange.hs

@@ -23,13 +23,13 @@ docOpenHandler = notificationHandler SMethod_TextDocumentDidOpen updateState
 docChangeHandler :: Handlers DLogLspM
 docChangeHandler = notificationHandler SMethod_TextDocumentDidChange updateState
 
-updateState :: (HasParams s a1, MonadLsp LSPState (t IO), HasUri a2 Uri, HasTextDocument a1 a2, MonadTrans t) => s -> t IO ()
+updateState :: (MonadIO m, MonadLsp LSPState m, HasParams s a1, HasTextDocument a1 a2, HasUri a2 Uri) => s -> m ()
 updateState req = do
     let uri = currentBufferUri req
 
     parseRef <- parseState <$> getConfig
     bufferText <- currentBufferText req
-    parseResult <- lift . atomically $ do
+    parseResult <- liftIO . atomically $ do
         v <- readTVar parseRef
 
         let parsedBuffer = runParser parseProgram (show uri) bufferText

datalog-lsp/src/Datalog/LSP/Highlight.hs

@@ -17,19 +17,18 @@ tokenHandler :: Handlers DLogLspM
 tokenHandler = requestHandler SMethod_TextDocumentSemanticTokensFull $ \req responder -> do
     LSPState parseRef <- getConfig
     p <- lift . readTVarIO $ parseRef
-    case M.lookup (currentBufferUri req) p of
+    responder $
-        Nothing ->
+        case M.lookup (currentBufferUri req) p of
-            responder (Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Doc not bundle" Nothing)
+            Nothing ->
-        Just (Left _) ->
+                Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Doc not found in bundle" Nothing
-            responder (Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Failed to parse" Nothing)
+            Just (Left _) ->
-        Just (Right prog) -> do
+                Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Failed to parse" Nothing
-            responder
+            Just (Right prog) ->
-                ( Right
+                Right
                     . InL
                     . fromRight (SemanticTokens Nothing [])
                     . makeSemanticTokens defaultSemanticTokensLegend
                     $ highlightProg prog
-                )
 
 highlightProg :: Program' SrcLoc -> [SemanticTokenAbsolute]
 highlightProg (Program _ rs) = rs >>= highlightRule

datalog-lsp/src/Datalog/LSP/Types.hs

@@ -14,6 +14,6 @@ type DLogLspM = LspM LSPState
 
 type UriBundle a = Map J.NormalizedUri a
 
-data LSPState = LSPState
+newtype LSPState = LSPState
     { parseState :: TVar (UriBundle (Either (ParseErrorBundle Text Void) (Program' SrcLoc)))
     }