refactor: migrate to OsPath #608

cabal.project

@@ -1,4 +1,4 @@
-index-state: 2026-02-13T00:00:00Z
+index-state: 2026-10-09T00:00:00Z
 
 packages:
          ./lsp

lsp-test/bench/SimpleBench.hs

@@ -12,6 +12,7 @@ import Language.LSP.Protocol.Message
 import Language.LSP.Protocol.Types
 import Language.LSP.Server
 import Language.LSP.Test qualified as Test
+import System.Directory.OsPath qualified as OsPath
 import System.Environment
 import System.Process hiding (env)
 import System.Time.Extra
@@ -56,7 +57,9 @@ main = do
 
   i <- newIORef (0 :: Integer)
 
-  Test.runSessionWithHandles hinWrite houtRead Test.defaultConfig Test.fullLatestClientCaps "." $ do
+  rootDir <- OsPath.getCurrentDirectory
+
+  Test.runSessionWithHandles hinWrite houtRead Test.defaultConfig Test.fullLatestClientCaps rootDir $ do
     start <- liftIO offsetTime
     replicateM_ n $ do
       v <- liftIO $ readIORef i

lsp-test/example/Test.hs

@@ -1,14 +1,16 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 
 import Control.Applicative.Combinators
 import Control.Monad.IO.Class
 import Language.LSP.Protocol.Message
 import Language.LSP.Protocol.Types
 import Language.LSP.Test
+import System.OsPath qualified as OsPath
 
 main :: IO ()
-main = runSession "lsp-demo-reactor-server" fullLatestClientCaps "test/data/" $ do
-  doc <- openDoc "Rename.hs" "haskell"
+main = runSession "lsp-demo-reactor-server" fullLatestClientCaps [OsPath.osp|test/data/|] $ do
+  doc <- openDoc [OsPath.osp|Rename.hs|] "haskell"
 
   -- Use your favourite favourite combinators.
   skipManyTill loggingNotification (count 1 publishDiagnosticsNotification)

lsp-test/func-test/FuncTest.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Main where
@@ -22,6 +23,8 @@ import Language.LSP.Protocol.Types
 import Language.LSP.Server
 import Language.LSP.Test qualified as Test
 import System.Exit
+import System.OsPath (OsPath)
+import System.OsPath qualified as OsPath
 import System.Process
 import Test.Hspec
 import UnliftIO
@@ -32,7 +35,7 @@ runSessionWithServer ::
   ServerDefinition config ->
   Test.SessionConfig ->
   ClientCapabilities ->
-  FilePath ->
+  OsPath ->
   Test.Session a ->
   IO a
 runSessionWithServer logger defn testConfig caps root session = do
@@ -85,7 +88,7 @@ spec = do
                 updater $ ProgressAmount (Just 75) (Just "step3")
                 liftIO $ waitBarrier b3
 
-      runSessionWithServer logger definition Test.defaultConfig Test.fullLatestClientCaps "." $ do
+      runSessionWithServer logger definition Test.defaultConfig Test.fullLatestClientCaps [OsPath.osp|.|] $ do
         Test.sendRequest (SMethod_CustomMethod (Proxy @"something")) J.Null
 
         -- Wait until we have seen a begin messsage. This means that the token setup
@@ -146,7 +149,7 @@ spec = do
                 -- Wait around to be cancelled, set the MVar only if we are
                 liftIO $ threadDelay (5 * 1000000) `Control.Exception.catch` (\(e :: ProgressCancelledException) -> modifyMVar_ wasCancelled (\_ -> pure True))
 
-      runSessionWithServer logger definition Test.defaultConfig Test.fullLatestClientCaps "." $ do
+      runSessionWithServer logger definition Test.defaultConfig Test.fullLatestClientCaps [OsPath.osp|.|] $ do
         Test.sendRequest (SMethod_CustomMethod (Proxy @"something")) J.Null
 
         -- Wait until we have created the progress so the updates will be sent individually
@@ -192,7 +195,7 @@ spec = do
                   takeMVar killVar
                   Control.Exception.throwIO AsyncCancelled
 
-      runSessionWithServer logger definition Test.defaultConfig Test.fullLatestClientCaps "." $ do
+      runSessionWithServer logger definition Test.defaultConfig Test.fullLatestClientCaps [OsPath.osp|.|] $ do
         -- First make sure that we get a $/progress begin notification
         skipManyTill Test.anyMessage $ do
           x <- Test.message SMethod_Progress
@@ -237,7 +240,7 @@ spec = do
                 updater $ ProgressAmount (Just 75) (Just "step3")
                 liftIO $ waitBarrier b3
 
-      runSessionWithServer logger definition Test.defaultConfig Test.fullLatestClientCaps "." $ do
+      runSessionWithServer logger definition Test.defaultConfig Test.fullLatestClientCaps [OsPath.osp|.|] $ do
         Test.sendRequest SMethod_TextDocumentCodeLens (CodeLensParams (Just $ ProgressToken $ InR "hello") Nothing (TextDocumentIdentifier $ Uri "."))
 
         -- First make sure that we get a $/progress begin notification
@@ -277,9 +280,9 @@ spec = do
     it "keeps track of open workspace folders" $ do
       countVar <- newMVar 0
 
-      let wf0 = WorkspaceFolder (filePathToUri "one") "Starter workspace"
-          wf1 = WorkspaceFolder (filePathToUri "/foo/bar") "My workspace"
-          wf2 = WorkspaceFolder (filePathToUri "/foo/baz") "My other workspace"
+      let wf0 = WorkspaceFolder (filePathToUri [OsPath.osp|one|]) "Starter workspace"
+          wf1 = WorkspaceFolder (filePathToUri [OsPath.osp|/foo/bar|]) "My workspace"
+          wf2 = WorkspaceFolder (filePathToUri [OsPath.osp|/foo/baz|]) "My other workspace"
 
           definition =
             ServerDefinition
@@ -320,7 +323,7 @@ spec = do
                 ps = DidChangeWorkspaceFoldersParams ev
              in Test.sendNotification SMethod_WorkspaceDidChangeWorkspaceFolders ps
 
-      runSessionWithServer logger definition config Test.fullLatestClientCaps "." $ do
+      runSessionWithServer logger definition config Test.fullLatestClientCaps [OsPath.osp|.|] $ do
         changeFolders [wf1] []
         changeFolders [wf2] [wf1]
 

lsp-test/lsp-test.cabal

@@ -51,18 +51,20 @@ library
     , aeson-pretty        ^>=0.8
     , ansi-terminal       >=0.10  && <1.2
     , async               ^>=2.2
-    , base                >=4.10  && <5
+    , base                >=4.18  && <5
     , bytestring          >=0.10  && <0.13
     , co-log-core         ^>=0.3
     , conduit             ^>=1.3
     , conduit-parse       ^>=0.2
     , containers          >=0.6 && < 0.9
     , data-default        >=0.7 && < 0.9
     , Diff                >=0.4   && <1.1
-    , directory           ^>=1.3
+    , directory           ^>=1.3.8
     , exceptions          ^>=0.10
     , extra               >=1.7 && < 1.9
-    , filepath            >=1.4 && < 1.6
+    , file-io             >=0.1   && <0.3
+    , filepath            >=1.4.100.0 && < 1.6
+    , from-text           ^>=0.1
     , Glob                >=0.9   && <0.11
     , lens                >=5.1   && <5.4
     , lens-aeson          ^>=1.2
@@ -128,6 +130,7 @@ test-suite func-test
   build-depends:
     , base
     , aeson
+    , filepath
     , co-log-core
     , extra
     , hspec
@@ -146,6 +149,7 @@ test-suite example
   main-is:            Test.hs
   build-depends:
     , base
+    , filepath
     , lsp-test
     , parser-combinators
 
@@ -160,6 +164,7 @@ benchmark simple-bench
   ghc-options:        -Wall -O2 -rtsopts
   build-depends:
     , base
+    , directory
     , extra
     , lsp
     , lsp-test

lsp-test/src/Language/LSP/Test.hs

@@ -170,7 +170,6 @@ import Data.Maybe
 import Data.Set qualified as Set
 import Data.String (fromString)
 import Data.Text qualified as T
-import Data.Text.IO qualified as T
 import Data.Traversable (for)
 import Language.LSP.Protocol.Capabilities qualified as C
 import Language.LSP.Protocol.Lens qualified as L
@@ -179,15 +178,18 @@ import Language.LSP.Protocol.Types
 import Language.LSP.Test.Compat
 import Language.LSP.Test.Decoding
 import Language.LSP.Test.Exceptions
+import Language.LSP.Test.Files (osToText)
 import Language.LSP.Test.Parsing
 import Language.LSP.Test.Server
 import Language.LSP.Test.Session
 import Language.LSP.VFS
-import System.Directory
+import System.Directory.OsPath qualified as OsPath
 import System.Environment
 import System.FilePath
 import System.FilePath.Glob qualified as Glob
 import System.IO
+import System.OsPath (OsPath)
+import System.OsPath qualified as OsPath
 import System.Process (CreateProcess, ProcessHandle)
 
 {- | Starts a new session.
@@ -205,7 +207,7 @@ runSession ::
   -- | The capabilities that the client should declare.
   ClientCapabilities ->
   -- | The filepath to the root directory for the session.
-  FilePath ->
+  OsPath ->
   -- | The session to run.
   Session a ->
   IO a
@@ -220,7 +222,7 @@ runSessionWithConfig ::
   -- | The capabilities that the client should declare.
   ClientCapabilities ->
   -- | The filepath to the root directory for the session.
-  FilePath ->
+  OsPath ->
   -- | The session to run.
   Session a ->
   IO a
@@ -237,7 +239,7 @@ runSessionWithConfigCustomProcess ::
   -- | The capabilities that the client should declare.
   ClientCapabilities ->
   -- | The filepath to the root directory for the session.
-  FilePath ->
+  OsPath ->
   -- | The session to run.
   Session a ->
   IO a
@@ -266,7 +268,7 @@ runSessionWithHandles ::
   -- | The capabilities that the client should declare.
   ClientCapabilities ->
   -- | The filepath to the root directory for the session.
-  FilePath ->
+  OsPath ->
   -- | The session to run.
   Session a ->
   IO a
@@ -282,13 +284,13 @@ runSessionWithHandles' ::
   -- | The capabilities that the client should declare.
   ClientCapabilities ->
   -- | The filepath to the root directory for the session.
-  FilePath ->
+  OsPath ->
   -- | The session to run.
   Session a ->
   IO a
 runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir session = do
   pid <- getCurrentProcessID
-  absRootDir <- canonicalizePath rootDir
+  absRootDir <- OsPath.canonicalizePath rootDir
 
   config <- envOverrideConfig config'
 
@@ -300,15 +302,15 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio
             _processId = InL $ fromIntegral pid
           , _clientInfo = Just lspTestClientInfo
           , _locale = Nothing
-          , _rootPath = Just (InL $ T.pack absRootDir)
+          , _rootPath = Just (InL $ osToText absRootDir)
           , _rootUri = InL $ filePathToUri absRootDir
           , _capabilities = caps
           , -- TODO: make this configurable?
             _initializationOptions = Just $ Object $ lspConfig config'
           , _trace = Just TraceValue_Off
           , _workspaceFolders = InL <$> initialWorkspaceFolders config
           }
-  runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
+  runSession' serverIn serverOut serverProc listenServer config caps absRootDir exitServer $ do
     -- Wrap the session around initialize and shutdown calls
     initReqId <- sendRequest SMethod_Initialize initializeParams
 
@@ -561,7 +563,7 @@ setConfigSection section settings = modifyConfig (\o -> o & at (fromString secti
 -}
 createDoc ::
   -- | The path to the document to open, __relative to the root directory__.
-  FilePath ->
+  OsPath ->
   -- | The text document's language identifier, e.g. @"haskell"@.
   LanguageKind ->
   -- | The content of the text document to create.
@@ -572,7 +574,8 @@ createDoc file languageId contents = do
   dynCaps <- curDynCaps <$> get
   rootDir <- asks rootDir
   caps <- asks sessionCapabilities
-  absFile <- liftIO $ canonicalizePath (rootDir </> file)
+  fileFp <- liftIO $ OsPath.decodeFS file
+  absFile <- liftIO $ OsPath.decodeFS =<< OsPath.canonicalizePath (rootDir OsPath.</> file)
   let pred :: SomeRegistration -> [TRegistration Method_WorkspaceDidChangeWatchedFiles]
       pred (SomeRegistration r@(TRegistration _ SMethod_WorkspaceDidChangeWatchedFiles _)) = [r]
       pred _ = mempty
@@ -589,7 +592,7 @@ createDoc file languageId contents = do
         -- If the pattern is absolute then match against the absolute fp
         relOrAbs
           | isAbsolute pattern = absFile
-          | otherwise = file
+          | otherwise = fileFp
 
       regHits :: TRegistration Method_WorkspaceDidChangeWatchedFiles -> Bool
       regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. L.registerOptions . _Just . L.watchers)
@@ -602,26 +605,30 @@ createDoc file languageId contents = do
   when shouldSend $
     sendNotification SMethod_WorkspaceDidChangeWatchedFiles $
       DidChangeWatchedFilesParams $
-        [FileEvent (filePathToUri (rootDir </> file)) FileChangeType_Created]
+        [FileEvent (filePathToUri (rootDir OsPath.</> file)) FileChangeType_Created]
   openDoc' file languageId contents
 
 {- | Opens a text document that /exists on disk/, and sends a
  textDocument/didOpen notification to the server.
+
+ The file is read as UTF-8 text with native newline handling (CRLF is
+ translated to LF on Windows). Use 'openDoc'' to open a document with
+ verbatim contents.
 -}
-openDoc :: FilePath -> LanguageKind -> Session TextDocumentIdentifier
+openDoc :: OsPath -> LanguageKind -> Session TextDocumentIdentifier
 openDoc file languageId = do
   context <- ask
-  let fp = rootDir context </> file
-  contents <- liftIO $ T.readFile fp
+  let fp = rootDir context OsPath.</> file
+  contents <- liftIO $ readFileUtf8 fp
   openDoc' file languageId contents
 
 {- | This is a variant of `openDoc` that takes the file content as an argument.
  Use this is the file exists /outside/ of the current workspace.
 -}
-openDoc' :: FilePath -> LanguageKind -> T.Text -> Session TextDocumentIdentifier
+openDoc' :: OsPath -> LanguageKind -> T.Text -> Session TextDocumentIdentifier
 openDoc' file languageId contents = do
   context <- ask
-  let fp = rootDir context </> file
+  let fp = rootDir context OsPath.</> file
       uri = filePathToUri fp
       item = TextDocumentItem uri languageId 0 contents
   sendNotification SMethod_TextDocumentDidOpen (DidOpenTextDocumentParams item)
@@ -641,10 +648,10 @@ changeDoc docId changes = do
   sendNotification SMethod_TextDocumentDidChange params
 
 -- | Gets the Uri for the file corrected to the session directory.
-getDocUri :: FilePath -> Session Uri
+getDocUri :: OsPath -> Session Uri
 getDocUri file = do
   context <- ask
-  let fp = rootDir context </> file
+  let fp = rootDir context OsPath.</> file
   return $ filePathToUri fp
 
 -- | Waits for diagnostics to be published and returns them.