Add unsafeToString methods

.gitignore

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

README.md

@@ -1,6 +1,6 @@
 # HPath
 
-[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath)
+[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath.svg)](http://packdeps.haskellers.com/feed?needle=hpath)
 
 Support for well-typed paths in Haskell. Also provides ByteString based filepath
 manipulation.

doctests-hpath.hs

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

src/HPath.hs

@@ -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)
 
 
 --------------------------------------------------------------------------------

src/HPath/IO.hs

@@ -337,6 +337,8 @@ data CopyMode = Strict    -- ^ fail if any target exists
 -- Throws in `Strict` CopyMode only:
 --
 --    - `AlreadyExists` if destination already exists
+--
+-- Note: may call `getcwd` (only if destination is a relative path)
 copyDirRecursive :: Path b1  -- ^ source dir
                  -> Path b2  -- ^ destination (parent dirs
                              --   are not automatically created)
@@ -432,7 +434,10 @@ copyDirRecursive fromp destdirp cm rm
 --
 --    - `UnsatisfiedConstraints` if destination file is non-empty directory
 --
--- Note: calls `symlink`
+-- Notes:
+--
+--    - calls `symlink`
+--    - calls `getcwd` in Overwrite mode (if destination is a relative path)
 recreateSymlink :: Path b1   -- ^ the old symlink file
                 -> Path b2   -- ^ destination file
                 -> CopyMode
@@ -486,7 +491,10 @@ recreateSymlink symsource@(MkPath symsourceBS) newsym@(MkPath newsymBS) cm
 --
 --    - `AlreadyExists` if destination already exists
 --
--- Note: calls `sendfile` and possibly `read`/`write` as fallback
+-- Notes:
+--
+--    - calls `sendfile` and possibly `read`/`write` as fallback
+--    - may call `getcwd` in Overwrite mode (if destination is a relative path)
 copyFile :: Path b1   -- ^ source file
          -> Path b2   -- ^ destination file
          -> CopyMode
@@ -571,6 +579,8 @@ _copyFile sflags dflags (MkPath fromBS) to@(MkPath toBS)
 --
 --    * examines filetypes explicitly
 --    * calls `copyDirRecursive` for directories
+--
+-- Note: may call `getcwd` in Overwrite mode (if destination is a relative path)
 easyCopy :: Path b1
          -> Path b2
          -> CopyMode
@@ -751,6 +761,8 @@ createDir fm (MkPath destBS) = createDirectory destBS fm
 --      exist and cannot be written to
 --    - `AlreadyExists` if destination already exists and
 --      is not a directory
+--
+-- Note: calls `getcwd` if the input path is a relative path
 createDirRecursive :: FileMode -> Path b -> IO ()
 createDirRecursive fm p =
   toAbs p >>= go
@@ -846,7 +858,10 @@ renameFile fromf@(MkPath fromfBS) tof@(MkPath tofBS) = do
 --
 --    - `AlreadyExists` if destination already exists
 --
--- Note: calls `rename` (but does not allow to rename over existing files)
+-- Notes:
+--
+--    - calls `rename` (but does not allow to rename over existing files)
+--    - calls `getcwd` in Overwrite mode if destination is a relative path
 moveFile :: Path b1   -- ^ file to move
          -> Path b2   -- ^ destination
          -> CopyMode

stack.yaml

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

test/HPath/IO/AppendFileSpec.hs

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

test/HPath/IO/ReadFileEOFSpec.hs

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

test/HPath/IO/ReadFileSpec.hs

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

test/HPath/IO/WriteFileSpec.hs

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

test/Utils.hs

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