Add unsafeToString methods

This commit is contained in:
Julian Ospald 2018-07-22 18:52:21 +08:00
parent a0510eaec1
commit 809ffc7745
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
2 changed files with 50 additions and 1 deletions

View File

@ -8,6 +8,7 @@ main =
doctest
["-isrc"
, "-XOverloadedStrings"
, "-XScopedTypeVariables"
, "src/HPath.hs"
]

View File

@ -10,12 +10,14 @@
-- Support for well-typed paths.
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms #-}
#endif
{-# LANGUAGE ScopedTypeVariables #-}
module HPath
(
@ -39,6 +41,8 @@ module HPath
,fromAbs
,fromRel
,toFilePath
,unsafeToString
,unsafeToString'
-- * Path Operations
,(</>)
,basename
@ -53,8 +57,10 @@ module HPath
)
where
import Control.Exception (Exception)
import Control.Exception (IOException, Exception, catch)
import Control.Monad ((<$!>))
import Control.Monad.Catch (MonadThrow(..))
import Data.ByteString.Unsafe(unsafeUseAsCStringLen)
#if MIN_VERSION_bytestring(0,10,8)
import Data.ByteString(ByteString, stripPrefix)
#else
@ -65,10 +71,17 @@ import qualified Data.ByteString as BS
import Data.Data
import Data.Maybe
import Data.Word8
import GHC.Foreign(peekCStringLen)
import GHC.IO.Encoding(getLocaleEncoding, TextEncoding)
import HPath.Internal
import System.IO.Unsafe(unsafePerformIO)
import System.Posix.FilePath hiding ((</>))
-- $setup
-- >>> import GHC.IO.Encoding(utf8)
--------------------------------------------------------------------------------
-- Types
@ -232,6 +245,41 @@ fromAbs = toFilePath
fromRel :: RelC r => Path r -> ByteString
fromRel = toFilePath
-- | This converts the underlying bytestring of the path to an unsafe
-- FilePath by assuming the encoding of the current locale setting. This
-- may be utterly wrong, but isn't particularly worse than what the
-- base library does. Blows up on decoding errors.
--
-- >>> unsafeToString (MkPath "/lal/lad")
-- "/lal/lad"
-- >>> unsafeToString (MkPath "/")
-- "/"
-- >>> unsafeToString (MkPath "lad")
-- "lad"
-- >>> catch (Just <$> unsafeToString (MkPath "<22>")) (\(_ :: IOException) -> pure Nothing)
-- Nothing
unsafeToString :: Path b -> IO FilePath
unsafeToString (MkPath p) = do
enc <- getLocaleEncoding
unsafeUseAsCStringLen p (peekCStringLen enc)
-- | Same as @unsafeToString@, except requires the encoding
-- to be passed explicitly. This uses 'unsafePerformIO' and
-- returns 'Nothing' on decoding errors.
--
-- >>> unsafeToString' (MkPath "/lal/lad") utf8
-- Just "/lal/lad"
-- >>> unsafeToString' (MkPath "/") utf8
-- Just "/"
-- >>> unsafeToString' (MkPath "lad") utf8
-- Just "lad"
-- >>> unsafeToString' (MkPath "<22>") utf8
-- Nothing
unsafeToString' :: Path b -> TextEncoding -> Maybe FilePath
unsafeToString' (MkPath !p) enc =
unsafePerformIO $!
catch (Just <$!> unsafeUseAsCStringLen p (peekCStringLen enc))
(\(_ :: IOException) -> pure Nothing)
--------------------------------------------------------------------------------