Add unsafeToString methods

Cabal sandboxes were introduced in cabal-install 1.18.

.gitignore

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

.travis.yml

@@ -7,12 +7,18 @@ dist: trusty
 
 matrix:
   include:
+    - env: CABALVER=1.18 GHCVER=7.6.3
+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}}
     - env: CABALVER=1.22 GHCVER=7.8.4
       addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4], sources: [hvr-ghc]}}
     - env: CABALVER=1.24 GHCVER=7.10.2
       addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.2], sources: [hvr-ghc]}}
     - env: CABALVER=1.24 GHCVER=8.0.1
       addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
+    - env: CABALVER=2.0 GHCVER=8.2.2
+      addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}
+    - env: CABALVER=2.2 GHCVER=8.4.1
+      addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.1], sources: [hvr-ghc]}}
     - env: CABALVER=head GHCVER=head
       addons: {apt: {packages: [cabal-install-head,ghc-head],  sources: [hvr-ghc]}}
 

CHANGELOG

@@ -1,3 +1,7 @@
+0.9.2
+	* fix build with ghc-7.6
+	* raise required bytestring version
+	* Tighten base bound to prevent building before GHC 7.6 (by George Wilson)
 0.9.1
 	* fix build with ghc-7.8 and 7.10
 0.9.0

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"
       ]
 

hpath.cabal

@@ -1,5 +1,5 @@
 name:                hpath
-version:             0.9.1
+version:             0.9.2
 synopsis:            Support for well-typed paths
 description:         Support for well-typed paths, utilizing ByteString under the hood.
 license:             BSD3
@@ -35,9 +35,9 @@ library
                      System.Posix.FD,
                      System.Posix.FilePath
   other-modules:     HPath.Internal
-  build-depends:     base >= 4.2 && <5
+  build-depends:     base >= 4.6 && <5
                    , IfElse
-                   , bytestring >= 0.9.2.0
+                   , bytestring >= 0.10.0.0
                    , deepseq
                    , exceptions
                    , hspec
@@ -71,7 +71,7 @@ test-suite doctests-posix
   ghc-options:       -threaded
   main-is:           doctests-posix.hs
   build-depends:     base,
-                     bytestring,
+                     bytestring >= 0.10.0.0,
                      unix,
                      hpath,
                      doctest >= 0.8,
@@ -118,7 +118,7 @@ test-suite spec
   Build-Depends:        base
                       , HUnit
                       , IfElse
-                      , bytestring
+                      , bytestring >= 0.10.0.0
                       , hpath
                       , hspec >= 1.3
                       , process

src/HPath.hs

@@ -10,10 +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
   (
@@ -25,8 +29,10 @@ module HPath
   ,PathParseException
   ,PathException
   ,RelC
+#if __GLASGOW_HASKELL__ >= 708
   -- * PatternSynonyms/ViewPatterns
   ,pattern Path
+#endif
    -- * Path Parsing
   ,parseAbs
   ,parseFn
@@ -35,6 +41,8 @@ module HPath
   ,fromAbs
   ,fromRel
   ,toFilePath
+  ,unsafeToString
+  ,unsafeToString'
   -- * Path Operations
   ,(</>)
   ,basename
@@ -49,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
@@ -61,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
 
@@ -101,7 +118,9 @@ instance RelC Fn
 #if __GLASGOW_HASKELL__ >= 710
 pattern Path :: ByteString -> Path a
 #endif
+#if __GLASGOW_HASKELL__ >= 708
 pattern Path x <- (MkPath x)
+#endif
 
 --------------------------------------------------------------------------------
 -- Path Parsers
@@ -226,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

@@ -33,6 +33,7 @@
 -- For other functions (like `copyFile`), the behavior on these file types is
 -- unreliable/unsafe. Check the documentation of those functions for details.
 
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -107,7 +108,11 @@ import Data.ByteString
   (
     ByteString
   )
+#if MIN_VERSION_bytestring(0,10,2)
 import Data.ByteString.Builder
+#else
+import Data.ByteString.Lazy.Builder
+#endif
   (
     Builder
   , byteString
@@ -332,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)
@@ -427,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
@@ -481,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
@@ -566,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
@@ -746,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
@@ -841,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