add partial function for compatibility & use decodeFS

Author: kokobd

lsp-types/src/Language/LSP/Types/OsPath/Compat.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 #if MIN_VERSION_filepath(1,4,100)
 #define OS_PATH 1
@@ -35,8 +36,11 @@ import qualified Data.Text.Encoding             as T
 import           System.FilePath
 #endif
 
-import           Control.Monad.Catch            (MonadThrow)
+import           Control.Exception              (try)
+import           Control.Monad.Catch            (MonadThrow, SomeException,
+                                                 throwM)
 import           Data.ByteString.Short          (ShortByteString)
+import           System.IO.Unsafe               (unsafePerformIO)
 
 type OsPathCompat =
 #ifdef OS_PATH
@@ -69,14 +73,24 @@ fromShortByteString = T.unpack . T.decodeUtf8 . BS.fromShort
 
 toFilePath :: MonadThrow m => OsPathCompat -> m FilePath
 #ifdef OS_PATH
-toFilePath = decodeUtf
+toFilePath = unsafePerformIO' . decodeFS
 #else
 toFilePath = pure
 #endif
 
 fromFilePath :: MonadThrow m => FilePath -> m OsPathCompat
 #ifdef OS_PATH
-fromFilePath = encodeUtf
+fromFilePath = unsafePerformIO' . encodeUtf
 #else
 fromFilePath = pure
 #endif
+
+#ifdef OS_PATH
+unsafePerformIO' :: MonadThrow m => IO a -> m a
+unsafePerformIO' action =
+  case fp of
+    Left (e :: SomeException) -> throwM e
+    Right fp'                 -> pure fp'
+  where
+    fp = unsafePerformIO . try $ action
+#endif

lsp-types/src/Language/LSP/Types/Uri.hs

@@ -14,6 +14,7 @@ module Language.LSP.Types.Uri
   , emptyNormalizedUri
   , NormalizedFilePath
   , toNormalizedFilePath
+  , unsafeToNormalizedFilePath
   , fromNormalizedFilePath
   , normalizedFilePathToUri
   , uriToNormalizedFilePath
@@ -37,6 +38,7 @@ import           Data.Maybe                       (fromJust)
 import           Data.Text                        (Text)
 import qualified Data.Text                        as T
 import           GHC.Generics
+import           GHC.Stack                        (HasCallStack)
 import           Language.LSP.Types.OsPath.Compat (OsPathCompat)
 import qualified Language.LSP.Types.OsPath.Compat as OsPath
 import           Network.URI                      hiding (authority)
@@ -216,6 +218,13 @@ toNormalizedFilePath fp = flip NormalizedFilePath (OsPath.toShortByteString nfp)
     nfp = OsPath.normalise fp
     nuri = internalNormalizedFilePathToUri nfp
 
+{-# DEPRECATED unsafeToNormalizedFilePath "use toNormalizedFilePath instead" #-}
+unsafeToNormalizedFilePath :: HasCallStack => OsPathCompat -> NormalizedFilePath
+unsafeToNormalizedFilePath fp =
+  case toNormalizedFilePath fp of
+    Right nfp -> nfp
+    Left exception  -> error $ show exception
+
 fromNormalizedFilePath :: NormalizedFilePath -> OsPathCompat
 fromNormalizedFilePath (NormalizedFilePath _ fp) = OsPath.fromShortByteString fp