Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Improve NormalizedFilePath #453

Merged
merged 4 commits into from
Sep 4, 2022
Merged

Improve NormalizedFilePath #453

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
77a4340
improve NormalizedFilePath
kokobd Aug 31, 2022
9350d8d
add adoption plan
kokobd Sep 3, 2022
3b7c659
try Text
kokobd Sep 3, 2022
9ab88de
finalize
kokobd Sep 3, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .github/workflows/haskell.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,7 @@ jobs:
shell: bash
run: |
if [ ${{ matrix.ospath }} = "true" ]; then
cabal configure --constraint="filepath ^>= 1.4.100.0"
cabal configure --flags="force-ospath"
fi
- name: Build using cabal
run: cabal build all
Expand Down
11 changes: 10 additions & 1 deletion lsp-types/lsp-types.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,11 @@ category: Development
build-type: Simple
extra-source-files: ChangeLog.md, README.md

flag force-ospath
kokobd marked this conversation as resolved.
Show resolved Hide resolved
default: False
manual: False
description: Force a version bound on filepath library, to enable 'OsPath'.

library
exposed-modules: Language.LSP.Types
, Language.LSP.Types.Capabilities
Expand Down Expand Up @@ -79,7 +84,6 @@ library
, deepseq
, Diff >= 0.2
, dlist
, filepath
, hashable
, lens >= 4.15.2
, mtl < 2.4
Expand All @@ -93,6 +97,11 @@ library
, exceptions
, safe
, bytestring
, utf8-string
if flag(force-ospath)
build-depends: filepath ^>= 1.4.100.0
else
build-depends: filepath
hs-source-dirs: src
default-language: Haskell2010
default-extensions: StrictData
Expand Down
28 changes: 11 additions & 17 deletions lsp-types/src/Language/LSP/Types/Uri.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,7 @@ module Language.LSP.Types.Uri
)
where

import qualified Codec.Binary.UTF8.String as UTF8
import Control.DeepSeq
import qualified Data.Aeson as A
import Data.Binary (Binary, Get, get, put)
Expand All @@ -35,10 +36,7 @@ import Data.List (stripPrefix)
import Data.String (IsString (fromString))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Text.Encoding.Error (UnicodeException)
import GHC.Generics
import GHC.Stack (HasCallStack)
import Network.URI hiding (authority)
import Safe (tailMay)
import qualified System.FilePath as FP
Expand Down Expand Up @@ -180,16 +178,16 @@ instance Binary NormalizedFilePath where
put (NormalizedFilePath _ fp) = put fp
get = do
v <- Data.Binary.get :: Get ShortByteString
case decodeFilePath v of
Left e -> fail (show e)
Right v' ->
return (NormalizedFilePath (internalNormalizedFilePathToUri v') v)
let v' = decodeFilePath v
return (NormalizedFilePath (internalNormalizedFilePathToUri v') v)

encodeFilePath :: String -> ShortByteString
encodeFilePath = BS.toShort . T.encodeUtf8 . T.pack
-- | Convert 'FilePath' to a UTF-8 encoded 'ShortByteString'
encodeFilePath :: FilePath -> ShortByteString
encodeFilePath = BS.pack . UTF8.encode
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

My local benchmark results show that this takes more time than BS.toShort . T.encodeUtf8 . T.pack in most cases. Quite surprising. Waiting for benchmark results on CI. haskell/haskell-language-server#3067

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ok, maybe not that surprising given that text is likely much more optimised than utf8-string.

The best option here would be to leverage the fact that text-2.0 is internally isomorphic to a ShortByteString plus a pair of ints for slicing, and encoded in UTF-8. So you could just do:

#if min_version_text(2,0)
import Data.ByteString.Short
import qualified Data.Text as Text
import Data.Text.Array(Array(..))
import Data.Text.Internal (Text(Text))
...

encodeFilePath :: FilePath -> ShortByteString 
encodeFilePath fp = case Text.pack fp of
  Text (ByteArray sbs) _ _ -> SBS sbs

decodeFilePath :: ShortByteString -> FilePath
decodeFilePath (SBS fp) = Text.unpack $ Text (ByteArray fp) 0 (length fp)


decodeFilePath :: ShortByteString -> Either UnicodeException String
decodeFilePath = fmap T.unpack . T.decodeUtf8' . BS.fromShort
-- | Assume the given 'ShortByteString' is UTF-8 encoded, decode it into a 'FilePath'
decodeFilePath :: ShortByteString -> FilePath
decodeFilePath = UTF8.decode . BS.unpack

-- | Internal helper that takes a file path that is assumed to
-- already be normalized to a URI. It is up to the caller
Expand Down Expand Up @@ -219,12 +217,8 @@ toNormalizedFilePath fp = NormalizedFilePath nuri . encodeFilePath $ nfp
nuri = internalNormalizedFilePathToUri nfp

-- | Extracts 'FilePath' from 'NormalizedFilePath'.
-- The function is total. The 'HasCallStack' constraint is added for debugging purpose only.
fromNormalizedFilePath :: HasCallStack => NormalizedFilePath -> FilePath
fromNormalizedFilePath (NormalizedFilePath _ fp) =
case decodeFilePath fp of
Left e -> error $ show e
Right x -> x
fromNormalizedFilePath :: NormalizedFilePath -> FilePath
fromNormalizedFilePath (NormalizedFilePath _ fp) = decodeFilePath fp

normalizedFilePathToUri :: NormalizedFilePath -> NormalizedUri
normalizedFilePathToUri (NormalizedFilePath uri _) = uri
Expand Down
37 changes: 22 additions & 15 deletions lsp-types/src/Language/LSP/Types/Uri/OsPath.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,38 +10,45 @@ module Language.LSP.Types.Uri.OsPath
#ifdef OS_PATH
osPathToNormalizedFilePath
, normalizedFilePathToOsPath
, EncodingException
#endif
) where

#ifdef OS_PATH

import Control.DeepSeq (NFData, force)
import Control.Exception hiding (try)
import Control.Monad.Catch
import GHC.IO.Encoding (getFileSystemEncoding)
import Language.LSP.Types.Uri
import System.IO
import System.IO.Unsafe (unsafePerformIO)
import System.OsPath
import System.OsPath.Encoding (EncodingException)

{-|
Constructs 'NormalizedFilePath' from 'OsPath'. Throws 'IOException' if the conversion fails.
Constructs 'NormalizedFilePath' from 'OsPath'. Throws 'EncodingException' if the conversion fails.

We always store UTF-8 encoded file path in 'NormalizedFilePath'. This function first converts 'OsPath'
to 'FilePath' using current system encoding (see 'decodeFS'), then converts 'FilePath' to an UTF-8
encoded 'ShortByteString'. Due to the encoding conversion, this function can fail. But DO NOTE THAT
encoding mismatch doesn't always mean an exception will be thrown. [Possibly your encoding simply won't
throw exception on failure](https://hackage.haskell.org/package/base-4.17.0.0/docs/src/GHC.IO.Encoding.html#initFileSystemEncoding).
Possibly the conversion function can't find any invalid byte sequence, giving a sucessful but wrong result.
-}
osPathToNormalizedFilePath :: MonadThrow m => OsPath -> m NormalizedFilePath
osPathToNormalizedFilePath = fmap toNormalizedFilePath . unsafePerformIO' . decodeFS
osPathToNormalizedFilePath = fmap toNormalizedFilePath . liftException . decodeWith systemEnc utf16le

{-|
Extracts 'OsPath' from 'NormalizedFilePath'. Throws 'IOException' if the conversion fails.
Extracts 'OsPath' from 'NormalizedFilePath'. Throws 'EncodingException' if the conversion fails.
-}
normalizedFilePathToOsPath :: MonadThrow m => NormalizedFilePath -> m OsPath
normalizedFilePathToOsPath = unsafePerformIO' . encodeFS . fromNormalizedFilePath

unsafePerformIO' :: (MonadThrow m, NFData a) => IO a -> m a
unsafePerformIO' action =
case fp of
Left (e :: SomeException) -> throwM e
Right fp' -> pure fp'
where
fp = unsafePerformIO . try $ do
x <- action
evaluate . force $ x
normalizedFilePathToOsPath = liftException . encodeWith systemEnc utf16le . fromNormalizedFilePath

liftException :: (MonadThrow m, Exception e) => Either e a -> m a
liftException (Right x) = pure x
liftException (Left err) = throwM err

systemEnc :: TextEncoding
systemEnc = unsafePerformIO getFileSystemEncoding

#endif
2 changes: 1 addition & 1 deletion lsp-types/test/URIFilePathSpec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -307,5 +307,5 @@ normalizedFilePathSpec = beforeAll (setFileSystemEncoding utf8) $ do
case OsPath.encodeWith utf16be utf16be "\184921" of
Left err -> throwIO err
Right osPath -> do
osPathToNormalizedFilePath osPath `shouldThrow` \(_ :: IOException) -> True
osPathToNormalizedFilePath osPath `shouldThrow` \(_ :: EncodingException) -> True
#endif