Improve some documentation (and LSP types).

src/Futhark/CLI/LSP.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE ExplicitNamespaces #-}
 {-# LANGUAGE OverloadedStrings #-}
 
+-- | @futhark lsp@
 module Futhark.CLI.LSP (main) where
 
 import Control.Concurrent.MVar (newMVar)
@@ -18,6 +19,7 @@ import Language.LSP.Types
   )
 import System.Log.Logger (Priority (DEBUG))
 
+-- | Run @futhark lsp@
 main :: String -> [String] -> IO ()
 main _prog _args = do
   state_mvar <- newMVar emptyState

src/Futhark/IR/Mem/IxFun.hs

@@ -72,13 +72,18 @@ type Indices num = [num]
 
 type Permutation = [Int]
 
+-- | The physical element ordering alongside a dimension, i.e. the
+-- sign of the stride.
 data Monotonicity
-  = Inc
-  | Dec
-  | -- | monotonously increasing, decreasing or unknown
+  = -- | Increasing.
+    Inc
+  | -- | Decreasing.
+    Dec
+  | -- | Unknown.
     Unknown
   deriving (Show, Eq)
 
+-- | A single dimension in an 'LMAD'.
 data LMADDim num = LMADDim
   { ldStride :: num,
     ldRotate :: num,
@@ -1000,7 +1005,9 @@ existentializeExp e = do
   let t = primExpType $ untyped e
   pure $ TPrimExp $ LeafExp (Ext i) t
 
--- We require that there's only one lmad, and that the index function is contiguous, and the base shape has only one dimension
+-- | Try to turn all the leaves of the index function into 'Ext's.  We
+--  require that there's only one LMAD, that the index function is
+--  contiguous, and the base shape has only one dimension.
 existentialize ::
   (IntExp t, Eq v, Pretty v) =>
   IxFun (TPrimExp t v) ->

src/Futhark/LSP/Compile.hs

@@ -1,3 +1,7 @@
+-- | Building blocks for "recompiling" (actually just type-checking)
+-- the Futhark program managed by the language server.  The challenge
+-- here is that if the program becomes type-invalid, we want to keep
+-- the old state around.
 module Futhark.LSP.Compile (tryTakeStateFromMVar, tryReCompile) where
 
 import Control.Concurrent.MVar (MVar, putMVar, takeMVar)

src/Futhark/LSP/Diagnostic.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
+-- | Handling of diagnostics in the language server - things like
+-- warnings and errors.
 module Futhark.LSP.Diagnostic
   ( publishWarningDiagnostics,
     publishErrorDiagnostics,
@@ -14,10 +16,10 @@ import qualified Data.List.NonEmpty as NE
 import Data.Map (assocs, empty, insertWith)
 import qualified Data.Text as T
 import Futhark.Compiler.Program (ProgError (ProgError))
-import Futhark.LSP.Tool (locToUri, rangeFromLoc, rangeFromSrcLoc)
+import Futhark.LSP.Tool (posToUri, rangeFromLoc, rangeFromSrcLoc)
 import Futhark.Util (debug)
-import Futhark.Util.Loc (SrcLoc, locOf)
-import Futhark.Util.Pretty (Doc, pretty)
+import Futhark.Util.Loc (Loc (..), SrcLoc, locOf)
+import Futhark.Util.Pretty (Doc, prettyText)
 import Language.LSP.Diagnostics (partitionBySource)
 import Language.LSP.Server (LspT, getVersionedTextDoc, publishDiagnostics)
 import Language.LSP.Types
@@ -40,32 +42,41 @@ publish uri_diags_map = for_ uri_diags_map $ \(uri, diags) -> do
   debug $ "Publishing diagnostics for " ++ show uri ++ " Verion: " ++ show (doc ^. version)
   publishDiagnostics maxDiagnostic (toNormalizedUri uri) (doc ^. version) (partitionBySource diags)
 
+-- | Send warning diagnostics to the client.
 publishWarningDiagnostics :: [(SrcLoc, Doc)] -> LspT () IO ()
 publishWarningDiagnostics warnings = do
   let diags_map =
         foldr
-          ( \(srcloc, msg) acc -> do
-              let diag = mkDiagnostic (rangeFromSrcLoc srcloc) DsWarning (T.pack $ pretty msg)
-              insertWith (++) (locToUri $ locOf srcloc) [diag] acc
+          ( \(srcloc, msg) acc ->
+              let diag = mkDiagnostic (rangeFromSrcLoc srcloc) DsWarning (prettyText msg)
+               in case locOf srcloc of
+                    NoLoc -> acc
+                    Loc pos _ -> insertWith (++) (posToUri pos) [diag] acc
           )
           empty
           warnings
   publish $ assocs diags_map
 
+-- | Send error diagnostics to the client.
 publishErrorDiagnostics :: NE.NonEmpty ProgError -> LspT () IO ()
 publishErrorDiagnostics errors = do
   let diags_map =
         foldr
-          ( \(ProgError loc msg) acc -> do
-              let diag = mkDiagnostic (rangeFromLoc loc) DsError (T.pack $ pretty msg)
-              insertWith (++) (locToUri loc) [diag] acc
+          ( \(ProgError loc msg) acc ->
+              let diag = mkDiagnostic (rangeFromLoc loc) DsError (prettyText msg)
+               in case loc of
+                    NoLoc -> acc
+                    Loc pos _ -> insertWith (++) (posToUri pos) [diag] acc
           )
           empty
           errors
   publish $ assocs diags_map
 
+-- | The maximum number of diagnostics to report.
 maxDiagnostic :: Int
 maxDiagnostic = 100
 
+-- | The source of the diagnostics.  (That is, the Futhark compiler,
+-- but apparently the client must be told such things...)
 diagnosticSource :: Maybe T.Text
 diagnosticSource = Just "futhark"

src/Futhark/LSP/Handlers.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
+-- | The handlers exposed by the language server.
 module Futhark.LSP.Handlers (handlers) where
 
 import Control.Concurrent.MVar (MVar)
@@ -14,6 +15,9 @@ import Language.LSP.Server (Handlers, LspM, notificationHandler, requestHandler)
 import Language.LSP.Types
 import Language.LSP.Types.Lens (HasUri (uri))
 
+-- | Given an 'MVar' tracking the state, produce a set of handlers.
+-- When we want to add more features to the language server, this is
+-- the thing to change.
 handlers :: MVar State -> Handlers (LspM ())
 handlers state_mvar =
   mconcat

src/Futhark/LSP/State.hs

@@ -1,3 +1,4 @@
+-- | The language server state definition.
 module Futhark.LSP.State
   ( State (..),
     emptyState,
@@ -6,9 +7,12 @@ where
 
 import Futhark.Compiler.Program (LoadedProg)
 
+-- | The state of the language server.
 newtype State = State
-  { stateProgram :: Maybe LoadedProg
+  { -- | The loaded program.
+    stateProgram :: Maybe LoadedProg
   }
 
+-- | Initial state.
 emptyState :: State
 emptyState = State Nothing

src/Futhark/LSP/Tool.hs

@@ -1,11 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 
+-- | Generally useful definition used in various places in the
+-- language server implementation.
 module Futhark.LSP.Tool
   ( getHoverInfoFromState,
     findDefinitionRange,
     rangeFromSrcLoc,
     rangeFromLoc,
-    locToUri,
+    posToUri,
   )
 where
 
@@ -30,6 +32,8 @@ import Language.LSP.Types
     filePathToUri,
   )
 
+-- | Retrieve hover info for the definition referenced at the given
+-- file at the given line and column number (the two 'Int's).
 getHoverInfoFromState :: State -> Maybe FilePath -> Int -> Int -> Maybe T.Text
 getHoverInfoFromState state (Just path) l c = do
   AtName qn (Just def) _loc <- queryAtPos state $ Pos path l c 0
@@ -45,6 +49,8 @@ getHoverInfoFromState state (Just path) l c = do
       | otherwise -> Just $ "Definition: " <> T.pack (locStr (boundLoc bound))
 getHoverInfoFromState _ _ _ _ = Nothing
 
+-- | Find the location of the definition referenced at the given file
+-- at the given line and column number (the two 'Int's).
 findDefinitionRange :: State -> Maybe FilePath -> Int -> Int -> Maybe Location
 findDefinitionRange state (Just path) l c = do
   -- some unnessecary operations inside `queryAtPos` for this function
@@ -63,10 +69,9 @@ queryAtPos state pos =
     Nothing -> Nothing
     Just loaded_prog -> atPos (lpImports loaded_prog) pos
 
-locToUri :: Loc -> Uri
-locToUri loc = do
-  let (Loc (Pos file _ _ _) _) = loc
-  filePathToUri file
+-- | Convert a Futhark 'Pos' to an LSP 'Uri'.
+posToUri :: Pos -> Uri
+posToUri (Pos file _ _ _) = filePathToUri file
 
 -- Futhark's parser has a slightly different notion of locations than
 -- LSP; so we tweak the positions here.
@@ -78,9 +83,11 @@ getEndPos :: Pos -> Position
 getEndPos (Pos _ line col _) =
   Position (toEnum line - 1) (toEnum col)
 
+-- | Create an LSP 'Range' from a Futhark 'Loc'.
 rangeFromLoc :: Loc -> Range
 rangeFromLoc (Loc start end) = Range (getStartPos start) (getEndPos end)
 rangeFromLoc NoLoc = Range (Position 0 0) (Position 0 5) -- only when file not found, throw error after moving to vfs
 
+-- | Create an LSP 'Range' from a Futhark 'SrcLoc'.
 rangeFromSrcLoc :: SrcLoc -> Range
 rangeFromSrcLoc = rangeFromLoc . locOf

src/Futhark/Util.hs

@@ -493,5 +493,6 @@ fixPoint f x =
   let x' = f x
    in if x' == x then x else fixPoint f x'
 
+-- | Issue a debugging statement to the log.
 debug :: MonadIO m => String -> m ()
 debug msg = liftIO $ debugM "futhark" msg