Fix some encoding issues and other stuff

Author: hasufell

System/FilePath/Internal.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE TypeApplications #-}
 
 -- This template expects CPP definitions for:
 --     MODULE_NAME = Posix | Windows
@@ -127,17 +128,25 @@ import Data.List(stripPrefix, isSuffixOf, uncons)
 #define FILEPATH FilePath
 #else
 import Prelude (fromIntegral)
-import System.OsPath.Encoding ( encodeWithTE )
-import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+import Control.Exception ( SomeException, evaluate, try, displayException )
+import Data.Bifunctor (first)
+import Control.DeepSeq (force)
+import GHC.IO (unsafePerformIO)
 import qualified Data.Char as C
 #ifdef WINDOWS
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+import qualified GHC.Foreign as GHC
 import GHC.IO.Encoding.UTF16 ( mkUTF16le )
+import qualified GHC.Foreign as GHC
 import Data.Word ( Word16 )
 import System.OsPath.Data.ByteString.Short.Word16
+import System.OsPath.Data.ByteString.Short ( packCStringLen )
 #define CHAR Word16
 #define STRING ShortByteString
 #define FILEPATH ShortByteString
 #else
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+import qualified GHC.Foreign as GHC
 import GHC.IO.Encoding.UTF8 ( mkUTF8 )
 import Data.Word ( Word8 )
 import System.OsPath.Data.ByteString.Short
@@ -1180,10 +1189,14 @@ snoc str = \c -> str <> [c]
 #else
 #ifdef WINDOWS
 fromString :: P.String -> STRING
-fromString = P.either (P.error . P.show) P.id . encodeWithTE (mkUTF16le ErrorOnCodingFailure)
+fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do
+  r <- try @SomeException $ GHC.withCStringLen (mkUTF16le ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr
+  evaluate $ force $ first displayException r
 #else
 fromString :: P.String -> STRING
-fromString = P.either (P.error . P.show) P.id . encodeWithTE (mkUTF8 ErrorOnCodingFailure)
+fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do
+  r <- try @SomeException $ GHC.withCStringLen (mkUTF8 ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr
+  evaluate $ force $ first displayException r
 #endif
 
 _a, _z, _A, _Z, _period, _quotedbl, _backslash, _slash, _question, _U, _N, _C, _colon, _semicolon, _US, _less, _greater, _bar, _asterisk, _nul, _space, _underscore :: CHAR

System/OsPath.hs

@@ -30,8 +30,7 @@
 --   are often interpreted as UTF8) as per the
 --   <https://pubs.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap03.html#tag_03_170 POSIX specification>
 --   and are passed as @char[]@ to syscalls. 'OsPath' maintains no invariant
---   here. Some functions however, such as 'toOsPathUtf', may expect
---   or produce UTF8.
+--   here.
 --
 -- Apart from encoding, filepaths have additional restrictions per platform:
 --
@@ -50,14 +49,13 @@
 -- It is advised to follow these principles when dealing with filepaths\/filenames:
 --
 -- 1. Avoid interpreting filenames that the OS returns, unless absolutely necessary.
---    For example, the filepath separator is usually a predefined 'Word8', regardless of encoding.
+--    For example, the filepath separator is usually a predefined 'Word8'/'Word16', regardless of encoding.
 --    So even if we need to split filepaths, it might still not be necessary to understand the encoding
 --    of the filename.
 -- 2. When interpreting OS returned filenames consider that these might not be UTF8 on /unix/
---    or at worst don't have an ASCII compatible encoding. Some strategies here involve looking
---    up the current locale and using that for decoding ('fromOsPathFS' does this).
---    Otherwise it can be reasonable to assume UTF8 on unix ('fromOsPathUtf' does that) if your application specifically
---    mentions that it requires a UTF8 compatible system. If you know the encoding, you can just use 'fromOsPathEnc'.
+--    or at worst don't have an ASCII compatible encoding. The are 3 available strategies fer decoding/encoding:
+--    a) pick the best UTF (UTF-8 on unix, UTF-16LE on windows), b) decode with an explicitly defined 'TextEncoding',
+--    c) mimic the behavior of the @base@ library (permissive UTF16 on windows, current filesystem encoding on unix).
 -- 3. Avoid comparing @String@ based filepaths, because filenames of different encodings
 --    may have the same @String@ representation, although they're not the same byte-wise.
 

System/OsPath/Common.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeApplications #-}
 -- This template expects CPP definitions for:
 --
 --     WINDOWS defined? = no            | yes              | no
@@ -115,17 +116,30 @@ import System.OsString.Windows as PS
     , decodeWith
     , decodeFS
     , pack
-    , pstr
     , encodeUtf
     , encodeWith
     , encodeFS
     , unpack
     )
 import Data.Bifunctor ( bimap )
 import qualified System.OsPath.Windows.Internal as C
+import GHC.IO.Encoding.UTF16 ( mkUTF16le )
+import Language.Haskell.TH.Quote
+    ( QuasiQuoter (..) )
+import Language.Haskell.TH.Syntax
+    ( Lift (..), lift )
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+import Control.Monad ( when )
 
 #elif defined(POSIX)
-
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+import Control.Monad ( when )
+import Language.Haskell.TH.Quote
+    ( QuasiQuoter (..) )
+import Language.Haskell.TH.Syntax
+    ( Lift (..), lift )
+
+import GHC.IO.Encoding.UTF8 ( mkUTF8 )
 import System.OsPath.Types
 import System.OsString.Posix as PS
     ( unsafeFromChar
@@ -134,7 +148,6 @@ import System.OsString.Posix as PS
     , decodeWith
     , decodeFS
     , pack
-    , pstr
     , encodeUtf
     , encodeWith
     , encodeFS
@@ -158,7 +171,7 @@ import System.OsPath.Internal as PS
     )
 import System.OsPath.Types
     ( OsPath )
-import System.OsString
+import System.OsString ( unsafeFromChar, toChar )
 
 #if defined(mingw32_HOST_OS) || defined(__MINGW32__)
 import qualified System.OsPath.Windows as C

System/OsPath/Encoding.hs

@@ -21,8 +21,6 @@ module System.OsPath.Encoding
   , utf16le_b_encode
 
   -- * base encoding
-  , encodeWithTE
-  , decodeWithTE
   , encodeWithBasePosix
   , decodeWithBasePosix
   , encodeWithBaseWindows

System/OsPath/Encoding/Internal.hs

@@ -28,7 +28,7 @@ import Data.Bifunctor (first)
 import Data.Data (Typeable)
 import GHC.Show (Show (show))
 import Numeric (showHex)
-import Foreign.C (CString, CStringLen)
+import Foreign.C (CStringLen)
 import Data.Char (chr)
 import Foreign
 import Prelude (FilePath)
@@ -260,39 +260,19 @@ charsToCWchars = foldr (utf16Char . ord) []
 -- FFI
 --
 
--- | Marshal a Haskell string into a NUL terminated C wide string using
--- temporary storage.
---
--- * the Haskell string may /not/ contain any NUL characters
---
--- * the memory is freed when the subcomputation terminates (either
---   normally or via an exception), so the pointer to the temporary
---   storage must /not/ be used after this.
---
-withCWString :: String -> (Ptr Word16 -> IO a) -> IO a
-withCWString  = withArray0 wNUL . charsToCWchars
+withFilePathWin :: FilePath -> (Int -> Ptr Word16 -> IO a) -> IO a
+withFilePathWin = withArrayLen . charsToCWchars
 
-peekCWString    :: Ptr Word16 -> IO String
-peekCWString cp  = do
-  cs <- peekArray0 wNUL cp
+peekFilePathWin :: (Ptr Word16, Int) -> IO FilePath
+peekFilePathWin (cp, l) = do
+  cs <- peekArray l cp
   return (cWcharsToChars cs)
 
-withFilePathWin :: FilePath -> (Ptr Word16 -> IO a) -> IO a
-withFilePathWin = withCWString
-
-peekFilePathWin :: Ptr Word16 -> IO FilePath
-peekFilePathWin = peekCWString
+withFilePathPosix :: FilePath -> (CStringLen -> IO a) -> IO a
+withFilePathPosix fp f = getFileSystemEncoding >>= \enc -> GHC.withCStringLen enc fp f
 
-withFilePathPosix :: FilePath -> (CString -> IO a) -> IO a
-withFilePathPosix fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f
-
-peekFilePathLenPosix :: CStringLen -> IO FilePath
-peekFilePathLenPosix fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp
-
-
--- -----------------------------------------------------------------------------
--- Encoders / decoders
---
+peekFilePathPosix :: CStringLen -> IO FilePath
+peekFilePathPosix fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp
 
 -- | Decode with the given 'TextEncoding'.
 decodeWithTE :: TextEncoding -> BS8.ShortByteString -> Either EncodingException String
@@ -306,21 +286,33 @@ encodeWithTE enc str = unsafePerformIO $ do
   r <- try @SomeException $ GHC.withCStringLen enc str $ \cstr -> BS8.packCStringLen cstr
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 
--- | This mimics the filepath ddecoder base uses on unix.
+-- -----------------------------------------------------------------------------
+-- Encoders / decoders
+--
+
+-- | This mimics the filepath decoder base uses on unix,
+-- with the small distinction that we're not truncating at NUL bytes (because we're not at
+-- the outer FFI layer).
 decodeWithBasePosix :: BS8.ShortByteString -> IO String
-decodeWithBasePosix ba = BS8.useAsCStringLen ba $ \fp -> peekFilePathLenPosix fp
+decodeWithBasePosix ba = BS8.useAsCStringLen ba $ \fp -> peekFilePathPosix fp
 
--- | This mimics the filepath dencoder base uses on unix.
+-- | This mimics the filepath dencoder base uses on unix,
+-- with the small distinction that we're not truncating at NUL bytes (because we're not at
+-- the outer FFI layer).
 encodeWithBasePosix :: String -> IO BS8.ShortByteString
-encodeWithBasePosix str = withFilePathPosix str $ \cstr -> BS8.packCString cstr
-
--- | This mimics the filepath decoder base uses on windows.
-decodeWithBaseWindows :: BS16.ShortByteString -> String
-decodeWithBaseWindows = cWcharsToChars . BS16.unpack
-
--- | This mimics the filepath dencoder base uses on windows.
-encodeWithBaseWindows :: String -> BS8.ShortByteString
-encodeWithBaseWindows = BS16.pack . charsToCWchars
+encodeWithBasePosix str = withFilePathPosix str $ \cstr -> BS8.packCStringLen cstr
+
+-- | This mimics the filepath decoder base uses on windows,
+-- with the small distinction that we're not truncating at NUL bytes (because we're not at
+-- the outer FFI layer).
+decodeWithBaseWindows :: BS16.ShortByteString -> IO String
+decodeWithBaseWindows ba = BS16.useAsCWStringLen ba $ \fp -> peekFilePathWin fp
+
+-- | This mimics the filepath dencoder base uses on windows,
+-- with the small distinction that we're not truncating at NUL bytes (because we're not at
+-- the outer FFI layer).
+encodeWithBaseWindows :: String -> IO BS16.ShortByteString
+encodeWithBaseWindows str = withFilePathWin str $ \l cstr -> BS16.packCWStringLen (cstr, l)
 
 
 -- -----------------------------------------------------------------------------

System/OsPath/Internal.hs

@@ -7,21 +7,34 @@ module System.OsPath.Internal where
 import {-# SOURCE #-} System.OsPath
     ( isValid )
 import System.OsPath.Types
-import System.OsString.Internal hiding ( fromBytes )
 import qualified System.OsString.Internal as OS
 
 import Control.Monad.Catch
     ( MonadThrow )
 import Data.ByteString
     ( ByteString )
-import Language.Haskell.TH
 import Language.Haskell.TH.Quote
     ( QuasiQuoter (..) )
 import Language.Haskell.TH.Syntax
     ( Lift (..), lift )
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+
+import System.OsString.Internal.Types
+#ifdef WINDOWS
+import qualified System.OsPath.Windows as PF
+import System.IO
+    ( TextEncoding, utf16le )
+import GHC.IO.Encoding.UTF16 ( mkUTF16le )
+import qualified System.OsPath.Data.ByteString.Short.Word16 as BS16
+import qualified System.OsPath.Data.ByteString.Short as BS8
+#else
+import qualified System.OsPath.Posix as PF
+import System.OsPath.Encoding
 import System.IO
     ( TextEncoding )
-import System.OsPath.Encoding ( EncodingException(..) )
+import GHC.IO.Encoding.UTF8 ( mkUTF8 )
+import Control.Monad (when)
+#endif
 
 
 
@@ -98,20 +111,37 @@ fromBytes :: MonadThrow m
 fromBytes = OS.fromBytes
 
 
-mkOsPath :: ByteString -> Q Exp
-mkOsPath bs =
-  case fromBytes bs of
-    Just afp' ->
-      if isValid afp'
-      then lift afp'
-      else error "invalid filepath"
-    Nothing -> error "invalid encoding"
 
 -- | QuasiQuote an 'OsPath'. This accepts Unicode characters
--- and encodes as UTF-8 on unix and UTF-16 on windows. Runs 'filepathIsValid'
+-- and encodes as UTF-8 on unix and UTF-16LE on windows. Runs 'isValid'
 -- on the input.
 osp :: QuasiQuoter
-osp = qq mkOsPath
+osp = QuasiQuoter
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+  { quoteExp = \s -> do
+      osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF16le ErrorOnCodingFailure) $ s
+      when (not $ isValid osp') $ fail ("filepath now valid: " <> show osp')
+      lift osp'
+  , quotePat  = \_ ->
+      fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
+  , quoteType = \_ ->
+      fail "illegal QuasiQuote (allowed as expression only, used as a type)"
+  , quoteDec  = \_ ->
+      fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"
+  }
+#else
+  { quoteExp = \s -> do
+      osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF8 ErrorOnCodingFailure) $ s
+      when (not $ isValid osp') $ fail ("filepath now valid: " <> show osp')
+      lift osp'
+  , quotePat  = \_ ->
+      fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
+  , quoteType = \_ ->
+      fail "illegal QuasiQuote (allowed as expression only, used as a type)"
+  , quoteDec  = \_ ->
+      fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"
+  }
+#endif
 
 
 -- | Unpack an 'OsPath' to a list of 'OsChar'.

System/OsPath/Posix.hs

@@ -8,3 +8,20 @@
 #define WORD_NAME PosixChar
 
 #include "Common.hs"
+
+-- | QuasiQuote a 'PosixPath'. This accepts Unicode characters
+-- and encodes as UTF-8. Runs 'isValid' on the input.
+pstr :: QuasiQuoter
+pstr =
+  QuasiQuoter
+  { quoteExp = \s -> do
+      ps <- either (fail . show) pure $ encodeWith (mkUTF8 ErrorOnCodingFailure) $ s
+      when (not $ isValid ps) $ fail ("filepath now valid: " <> show ps)
+      lift ps
+  , quotePat  = \_ ->
+      fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
+  , quoteType = \_ ->
+      fail "illegal QuasiQuote (allowed as expression only, used as a type)"
+  , quoteDec  = \_ ->
+      fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"
+  }

System/OsPath/Windows.hs

@@ -8,3 +8,21 @@
 #define WORD_NAME WindowsChar
 
 #include "Common.hs"
+
+
+-- | QuasiQuote a 'WindowsPath'. This accepts Unicode characters
+-- and encodes as UTF-16LE. Runs 'isValid' on the input.
+pstr :: QuasiQuoter
+pstr =
+  QuasiQuoter
+  { quoteExp = \s -> do
+      ps <- either (fail . show) pure $ encodeWith (mkUTF16le ErrorOnCodingFailure) $ s
+      when (not $ isValid ps) $ fail ("filepath now valid: " <> show ps)
+      lift ps
+  , quotePat  = \_ ->
+      fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
+  , quoteType = \_ ->
+      fail "illegal QuasiQuote (allowed as expression only, used as a type)"
+  , quoteDec  = \_ ->
+      fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"
+  }