Browse Source

Add unsafeToString methods

Julian Ospald 1 year ago
parent
commit
809ffc7745
No known key found for this signature in database
2 changed files with 50 additions and 1 deletions
  1. 1
    0
      doctests-hpath.hs
  2. 49
    1
      src/HPath.hs

+ 1
- 0
doctests-hpath.hs View File

@@ -8,6 +8,7 @@ main =
8 8
     doctest
9 9
       ["-isrc"
10 10
       , "-XOverloadedStrings"
11
+      , "-XScopedTypeVariables"
11 12
       , "src/HPath.hs"
12 13
       ]
13 14
 

+ 49
- 1
src/HPath.hs View File

@@ -10,12 +10,14 @@
10 10
 -- Support for well-typed paths.
11 11
 
12 12
 
13
+{-# LANGUAGE BangPatterns #-}
13 14
 {-# LANGUAGE CPP #-}
14 15
 {-# LANGUAGE DeriveDataTypeable #-}
15 16
 {-# LANGUAGE EmptyDataDecls #-}
16 17
 #if __GLASGOW_HASKELL__ >= 708
17 18
 {-# LANGUAGE PatternSynonyms #-}
18 19
 #endif
20
+{-# LANGUAGE ScopedTypeVariables #-}
19 21
 
20 22
 module HPath
21 23
   (
@@ -39,6 +41,8 @@ module HPath
39 41
   ,fromAbs
40 42
   ,fromRel
41 43
   ,toFilePath
44
+  ,unsafeToString
45
+  ,unsafeToString'
42 46
   -- * Path Operations
43 47
   ,(</>)
44 48
   ,basename
@@ -53,8 +57,10 @@ module HPath
53 57
   )
54 58
   where
55 59
 
56
-import           Control.Exception (Exception)
60
+import           Control.Exception (IOException, Exception, catch)
61
+import           Control.Monad ((<$!>))
57 62
 import           Control.Monad.Catch (MonadThrow(..))
63
+import           Data.ByteString.Unsafe(unsafeUseAsCStringLen)
58 64
 #if MIN_VERSION_bytestring(0,10,8)
59 65
 import           Data.ByteString(ByteString, stripPrefix)
60 66
 #else
@@ -65,10 +71,17 @@ import qualified Data.ByteString as BS
65 71
 import           Data.Data
66 72
 import           Data.Maybe
67 73
 import           Data.Word8
74
+import           GHC.Foreign(peekCStringLen)
75
+import           GHC.IO.Encoding(getLocaleEncoding, TextEncoding)
68 76
 import           HPath.Internal
77
+import           System.IO.Unsafe(unsafePerformIO)
69 78
 import           System.Posix.FilePath hiding ((</>))
70 79
 
71 80
 
81
+-- $setup
82
+-- >>> import GHC.IO.Encoding(utf8)
83
+
84
+
72 85
 --------------------------------------------------------------------------------
73 86
 -- Types
74 87
 
@@ -232,6 +245,41 @@ fromAbs = toFilePath
232 245
 fromRel :: RelC r => Path r -> ByteString
233 246
 fromRel = toFilePath
234 247
 
248
+-- | This converts the underlying bytestring of the path to an unsafe
249
+-- FilePath by assuming the encoding of the current locale setting. This
250
+-- may be utterly wrong, but isn't particularly worse than what the
251
+-- base library does. Blows up on decoding errors.
252
+--
253
+-- >>> unsafeToString (MkPath "/lal/lad")
254
+-- "/lal/lad"
255
+-- >>> unsafeToString (MkPath "/")
256
+-- "/"
257
+-- >>> unsafeToString (MkPath "lad")
258
+-- "lad"
259
+-- >>> catch (Just <$> unsafeToString (MkPath "�")) (\(_ :: IOException) -> pure Nothing)
260
+-- Nothing
261
+unsafeToString :: Path b -> IO FilePath
262
+unsafeToString (MkPath p) = do
263
+  enc <- getLocaleEncoding
264
+  unsafeUseAsCStringLen p (peekCStringLen enc)
265
+
266
+-- | Same as @unsafeToString@, except requires the encoding
267
+-- to be passed explicitly. This uses 'unsafePerformIO' and
268
+-- returns 'Nothing' on decoding errors.
269
+--
270
+-- >>> unsafeToString' (MkPath "/lal/lad") utf8
271
+-- Just "/lal/lad"
272
+-- >>> unsafeToString' (MkPath "/") utf8
273
+-- Just "/"
274
+-- >>> unsafeToString' (MkPath "lad") utf8
275
+-- Just "lad"
276
+-- >>> unsafeToString' (MkPath "�") utf8
277
+-- Nothing
278
+unsafeToString' :: Path b -> TextEncoding -> Maybe FilePath
279
+unsafeToString' (MkPath !p) enc =
280
+  unsafePerformIO $!
281
+    catch (Just <$!> unsafeUseAsCStringLen p (peekCStringLen enc))
282
+          (\(_ :: IOException) -> pure Nothing)
235 283
 
236 284
 
237 285
 --------------------------------------------------------------------------------