Compare commits

...

4 Commits

Author SHA1 Message Date
Julian Ospald 809ffc7745
Add unsafeToString methods 2018-07-23 10:21:17 +08:00
Julian Ospald a0510eaec1
Add stack.yaml 2018-07-19 13:33:55 +08:00
Julian Ospald cce2c68cab
Update .gitignore 2018-07-19 13:33:55 +08:00
Julian Ospald 3c5f06f41d
Remove redundant imports in tests 2018-07-19 13:33:55 +08:00
9 changed files with 59 additions and 8 deletions

2
.gitignore vendored
View File

@ -10,3 +10,5 @@ tags
.stack-work/ .stack-work/
.cabal-sandbox/ .cabal-sandbox/
cabal.sandbox.config cabal.sandbox.config
dist-newstyle/
.ghc.environment.*

View File

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

View File

@ -10,12 +10,14 @@
-- Support for well-typed paths. -- Support for well-typed paths.
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE EmptyDataDecls #-}
#if __GLASGOW_HASKELL__ >= 708 #if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
#endif #endif
{-# LANGUAGE ScopedTypeVariables #-}
module HPath module HPath
( (
@ -39,6 +41,8 @@ module HPath
,fromAbs ,fromAbs
,fromRel ,fromRel
,toFilePath ,toFilePath
,unsafeToString
,unsafeToString'
-- * Path Operations -- * Path Operations
,(</>) ,(</>)
,basename ,basename
@ -53,8 +57,10 @@ module HPath
) )
where where
import Control.Exception (Exception) import Control.Exception (IOException, Exception, catch)
import Control.Monad ((<$!>))
import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.Catch (MonadThrow(..))
import Data.ByteString.Unsafe(unsafeUseAsCStringLen)
#if MIN_VERSION_bytestring(0,10,8) #if MIN_VERSION_bytestring(0,10,8)
import Data.ByteString(ByteString, stripPrefix) import Data.ByteString(ByteString, stripPrefix)
#else #else
@ -65,10 +71,17 @@ import qualified Data.ByteString as BS
import Data.Data import Data.Data
import Data.Maybe import Data.Maybe
import Data.Word8 import Data.Word8
import GHC.Foreign(peekCStringLen)
import GHC.IO.Encoding(getLocaleEncoding, TextEncoding)
import HPath.Internal import HPath.Internal
import System.IO.Unsafe(unsafePerformIO)
import System.Posix.FilePath hiding ((</>)) import System.Posix.FilePath hiding ((</>))
-- $setup
-- >>> import GHC.IO.Encoding(utf8)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Types -- Types
@ -232,6 +245,41 @@ fromAbs = toFilePath
fromRel :: RelC r => Path r -> ByteString fromRel :: RelC r => Path r -> ByteString
fromRel = toFilePath 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)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------

7
stack.yaml Normal file
View File

@ -0,0 +1,7 @@
resolver: lts-12.1
packages:
- '.'
extra-deps:
- IfElse-0.85

View File

@ -13,7 +13,6 @@ import GHC.IO.Exception
( (
IOErrorType(..) IOErrorType(..)
) )
import System.Process
import Utils import Utils

View File

@ -13,7 +13,6 @@ import GHC.IO.Exception
( (
IOErrorType(..) IOErrorType(..)
) )
import System.Process
import Utils import Utils

View File

@ -13,7 +13,6 @@ import GHC.IO.Exception
( (
IOErrorType(..) IOErrorType(..)
) )
import System.Process
import Utils import Utils

View File

@ -13,7 +13,6 @@ import GHC.IO.Exception
( (
IOErrorType(..) IOErrorType(..)
) )
import System.Process
import Utils import Utils

View File

@ -61,9 +61,6 @@ import System.Posix.Files.ByteString
, unionFileModes , unionFileModes
) )
import qualified "unix" System.Posix.IO.ByteString as SPI
import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
baseTmpDir :: ByteString baseTmpDir :: ByteString