Use ByteString for paths instead of String

hpath.cabal

@@ -17,9 +17,8 @@ library
   ghc-options:       -Wall -O2
   exposed-modules:   HPath, HPath.Foreign, HPath.Internal
   build-depends:     base >= 4 && <5
+                   , bytestring
                    , exceptions
-                   , filepath
-                   , template-haskell
                    , deepseq
 
 test-suite test

src/HPath.hs

@@ -9,11 +9,13 @@
 --
 -- Support for well-typed paths.
 
-{-# LANGUAGE TemplateHaskell #-}
+
+
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 module HPath
@@ -23,35 +25,55 @@ module HPath
   ,Path
   ,Rel
   ,Fn
+  ,PathParseException
   -- * PatternSynonyms/ViewPatterns
   ,pattern Path
-   -- * Parsing
+   -- * Path Parsing
-  ,PathParseException
   ,parseAbs
   ,parseFn
   ,parseRel
-  -- * Constructors
+  -- * Path Conversion
-  ,mkAbs
+  ,canonicalizePath
-  ,mkFn
+  ,fromAbs
-  ,mkRel
+  ,fromRel
-  -- * Operations
+  ,normalize
+  ,toFilePath
+  -- * Path Operations
   ,(</>)
   ,basename
   ,dirname
   ,isParentOf
   ,getAllParents
   ,stripDir
-  -- * Conversion
+  -- * ByteString/Word8 constants
-  ,canonicalizePath
+  ,nullByte
-  ,fromAbs
+  ,pathDot
-  ,fromRel
+  ,pathDot'
-  ,normalize
+  ,pathSeparator
-  ,toFilePath
+  ,pathSeparator'
+  -- * ByteString operations
+  ,addTrailingPathSeparator
+  ,combine
+  ,dropFileName
+  ,dropTrailingPathSeparator
+  ,dropWhileEnd
+  ,joinPath
+  ,normalise
+  ,splitDirectories
+  ,splitFileName
+  ,splitPath
+  ,stripPrefix
+  ,takeDirectory
   -- * Queries
   ,hasDot
   ,hasDoublePS
+  ,hasLeadingPathSeparator
   ,hasParentDir
+  ,hasTrailingPathSeparator
+  ,isAbsolute
   ,isFileName
+  ,isRelative
+  ,isValid
   -- * String based functions
   ,realPath
   )
@@ -60,18 +82,18 @@ module HPath
 import           Control.Exception (Exception)
 import           Control.Monad(void)
 import           Control.Monad.Catch (MonadThrow(..))
+import           Data.ByteString(ByteString)
+import qualified Data.ByteString as B
+import           Data.Char(ord)
 import           Data.Data
-import           Data.List
+import qualified Data.List as L
 import           Data.Maybe
+import           Data.Word(Word8)
 import           Foreign.C.Error
 import           Foreign.C.String
-import           GHC.Foreign as GHC
-import           GHC.IO.Encoding (getFileSystemEncoding)
 import           Foreign.Marshal.Alloc(allocaBytes)
-import           Language.Haskell.TH
 import           HPath.Foreign
 import           HPath.Internal
-import qualified System.FilePath as FilePath
 
 --------------------------------------------------------------------------------
 -- Types
@@ -87,10 +109,10 @@ data Fn deriving (Typeable)
 
 -- | Exception when parsing a location.
 data PathParseException
-  = InvalidAbs FilePath
+  = InvalidAbs ByteString
-  | InvalidRel FilePath
+  | InvalidRel ByteString
-  | InvalidFn FilePath
+  | InvalidFn ByteString
-  | Couldn'tStripPrefixTPS FilePath FilePath
+  | Couldn'tStripPrefixTPS ByteString ByteString
   deriving (Show,Typeable)
 instance Exception PathParseException
 
@@ -103,18 +125,18 @@ instance RelC Fn
 pattern Path x <- (MkPath x)
 
 --------------------------------------------------------------------------------
--- Parsers
+-- Path Parsers
 
 -- | Get a location for an absolute path.
 --
 -- Throws: 'PathParseException'
 --
 parseAbs :: MonadThrow m
-         => FilePath -> m (Path Abs)
+         => ByteString -> m (Path Abs)
 parseAbs filepath =
-  if FilePath.isAbsolute filepath &&
+  if isAbsolute filepath &&
-     not (null filepath) &&
+     not (B.null filepath) &&
-     FilePath.isValid filepath
+     isValid filepath
      then return (MkPath filepath)
      else throwM (InvalidAbs filepath)
 
@@ -127,74 +149,44 @@ parseAbs filepath =
 -- Throws: 'PathParseException'
 --
 parseRel :: MonadThrow m
-         => FilePath -> m (Path Rel)
+         => ByteString -> m (Path Rel)
 parseRel filepath =
-  if not (FilePath.isAbsolute filepath) &&
+  if not (isAbsolute filepath) &&
-     not (null filepath) &&
+     not (B.null filepath) &&
-     FilePath.isValid filepath
+     isValid filepath
      then return (MkPath filepath)
      else throwM (InvalidRel filepath)
 
 parseFn :: MonadThrow m
-        => FilePath -> m (Path Fn)
+        => ByteString -> m (Path Fn)
 parseFn filepath =
-  if not (FilePath.isAbsolute filepath) &&
+  if not (isAbsolute filepath) &&
-     not (null filepath) &&
+     not (B.null filepath) &&
      isFileName filepath &&
-     FilePath.isValid filepath
+     isValid filepath
      then return (MkPath filepath)
      else throwM (InvalidFn filepath)
 
---------------------------------------------------------------------------------
--- Constructors
-
--- | Make a 'Path Abs TPS'.
---
--- Remember: due to the nature of absolute paths this (e.g. @\/home\/foo@)
--- may compile on your platform, but it may not compile on another
--- platform (Windows).
-mkAbs :: FilePath -> Q Exp
-mkAbs s =
-  case parseAbs s of
-    Left err -> error (show err)
-    Right (MkPath str) ->
-      [|MkPath $(return (LitE (StringL str))) :: Path Abs|]
-
--- | Make a 'Path Rel TPS'.
-mkRel :: FilePath -> Q Exp
-mkRel s =
-  case parseRel s of
-    Left err -> error (show err)
-    Right (MkPath str) ->
-      [|MkPath $(return (LitE (StringL str))) :: Path Rel|]
-
--- | Make a 'Path Rel TPS'.
-mkFn :: FilePath -> Q Exp
-mkFn s =
-  case parseFn s of
-    Left err -> error (show err)
-    Right (MkPath str) ->
-      [|MkPath $(return (LitE (StringL str))) :: Path Fn|]
 
 --------------------------------------------------------------------------------
--- Conversion
+-- Path Conversion
 
--- | Convert to a 'FilePath' type.
+-- | Convert to a ByteString type.
 --
 -- All TPS data types have a trailing slash, so if you want no trailing
 -- slash, you can use 'System.FilePath.dropTrailingPathSeparator' from
 -- the filepath package.
-toFilePath :: Path b -> FilePath
+toFilePath :: Path b -> ByteString
 toFilePath (MkPath l) = l
 
-fromAbs :: Path Abs -> FilePath
+fromAbs :: Path Abs -> ByteString
 fromAbs = toFilePath
 
-fromRel :: RelC r => Path r -> FilePath
+fromRel :: RelC r => Path r -> ByteString
 fromRel = toFilePath
 
 normalize :: Path t -> Path t
-normalize (MkPath l) = MkPath $ FilePath.normalise l
+normalize (MkPath l) = MkPath $ normalise l
 
 -- | May fail on `realPath`.
 canonicalizePath :: Path Abs -> IO (Path Abs)
@@ -203,7 +195,7 @@ canonicalizePath (MkPath l) = do
   return $ MkPath nl
 
 --------------------------------------------------------------------------------
--- Operations
+-- Path Operations
 
 -- | Append two paths.
 --
@@ -214,9 +206,9 @@ canonicalizePath (MkPath l) = do
 -- because this library is IO-agnostic and makes no assumptions about
 -- file types.
 (</>) :: RelC r => Path b -> Path r -> Path b
-(</>) (MkPath a) (MkPath b) = MkPath (a' ++ b)
+(</>) (MkPath a) (MkPath b) = MkPath (a' `B.append` b)
   where
-    a' = FilePath.addTrailingPathSeparator a
+    a' = addTrailingPathSeparator a
 
 -- | Strip directory from path, making it relative to that directory.
 -- Throws 'Couldn'tStripPrefixDir' if directory is not a parent of the path.
@@ -231,7 +223,7 @@ stripDir (MkPath p) (MkPath l) =
     Just "" -> throwM (Couldn'tStripPrefixTPS p' l)
     Just ok -> return (MkPath ok)
   where
-    p' = FilePath.addTrailingPathSeparator p
+    p' = addTrailingPathSeparator p
 
 -- | Is p a parent of the given location? Implemented in terms of
 -- 'stripDir'. The bases must match.
@@ -245,7 +237,7 @@ getAllParents (MkPath p) =
     (MkPath "/") -> []
     _            -> dirname np : getAllParents (dirname np)
   where
-    np = MkPath . FilePath.dropTrailingPathSeparator . FilePath.normalise $ p
+    np = MkPath . dropTrailingPathSeparator . normalise $ p
 
 
 -- | Extract the directory name of a path.
@@ -255,7 +247,7 @@ getAllParents (MkPath p) =
 -- @dirname (p \<\/> a) == dirname p@
 --
 dirname :: Path Abs -> Path Abs
-dirname (MkPath fp) = MkPath (FilePath.takeDirectory $ FilePath.dropTrailingPathSeparator fp)
+dirname (MkPath fp) = MkPath (takeDirectory $ dropTrailingPathSeparator fp)
 
 -- | Extract the file part of a path.
 --
@@ -267,35 +259,206 @@ dirname (MkPath fp) = MkPath (FilePath.takeDirectory $ FilePath.dropTrailingPath
 -- Except when "/" is passed in which case the filename "." is returned.
 basename :: Path b -> Path Fn
 basename (MkPath l)
-  | not (FilePath.isAbsolute rl) = MkPath rl
+  | not (isAbsolute rl) = MkPath rl
   | otherwise                    = MkPath "."
   where
-    rl = last . FilePath.splitPath . FilePath.dropTrailingPathSeparator $ l
+    rl = last . splitPath . dropTrailingPathSeparator $ l
 
 
 --------------------------------------------------------------------------------
--- Query functions
+-- ByteString/Word8 constants
+
+pathSeparator :: Word8
+pathSeparator = fromIntegral (ord '/')
+
+pathSeparator' :: ByteString
+pathSeparator' = "/"
+
+
+pathDot :: Word8
+pathDot = fromIntegral (ord '.')
+
+
+pathDot' :: ByteString
+pathDot' = "."
+
+
+nullByte :: Word8
+nullByte = fromIntegral (ord '\0')
+
+
+--------------------------------------------------------------------------------
+-- ByteString Operations
+
+
+dropWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString
+dropWhileEnd p = B.reverse . B.dropWhile p . B.reverse
+
+
+dropTrailingPathSeparator :: ByteString -> ByteString
+dropTrailingPathSeparator filepath =
+  if hasTrailingPathSeparator filepath
+  then let filepath' = dropWhileEnd (== pathSeparator) filepath
+    in if B.null filepath' then B.singleton . B.last $ filepath else filepath'
+  else filepath
+
+
+addTrailingPathSeparator :: ByteString -> ByteString
+addTrailingPathSeparator filepath
+  | B.null filepath            = filepath
+  | filepath == pathSeparator' = filepath
+  | not (hasTrailingPathSeparator filepath)
+                               = filepath `B.append` pathSeparator'
+  | otherwise                  = filepath
+
+
+normalise :: ByteString -> ByteString
+normalise filepath = result `B.append`
+                     (if addPathSeparator then pathSeparator' else B.empty)
+  where
+    (drv, pth) = splitDrive filepath
+    result = joinDrive' (normaliseDrive drv) (f pth)
+    joinDrive' d p
+      | d == "" && p == "" = B.singleton pathDot
+      | otherwise          = joinDrive d p
+    addPathSeparator = isDirPath pth && not (hasTrailingPathSeparator result)
+    isDirPath xs = hasTrailingPathSeparator xs
+        || not (B.null xs) && B.last xs == pathDot
+           && hasTrailingPathSeparator (B.init xs)
+    normaliseDrive p
+      | p == ""   = ""
+      | otherwise = B.singleton pathSeparator
+    f = joinPath . dropDots . propSep . splitDirectories
+    propSep :: [ByteString] -> [ByteString]
+    propSep (x:xs)
+      | B.all (== pathSeparator) x = pathSeparator' : xs
+      | otherwise = x : xs
+    propSep [] = []
+    dropDots = filter (pathDot' /=)
+
+
+splitPath :: ByteString -> [ByteString]
+splitPath filepath = [drv | drv /= ""] ++ f pth
+  where
+    (drv, pth) = splitDrive filepath
+    f p
+      | p == ""   = []
+      | otherwise = (a `B.append` c) : f d
+        where
+          (a, b) = B.break (== pathSeparator) p
+          (c, d) = splitDrive b
+
+
+joinPath :: [ByteString] -> ByteString
+joinPath = foldr combine ""
+
+
+splitDrive :: ByteString -> (ByteString, ByteString)
+splitDrive = B.span (== pathSeparator)
+
+
+joinDrive :: ByteString -> ByteString -> ByteString
+joinDrive = combineAlways
+
+
+splitDirectories :: ByteString -> [ByteString]
+splitDirectories = map dropTrailingPathSeparator . splitPath
+
+
+combine :: ByteString -> ByteString -> ByteString
+combine d p
+  | hasLeadingPathSeparator p = p
+  | otherwise                 = combineAlways d p
+
+
+combineAlways :: ByteString -> ByteString -> ByteString
+combineAlways d p
+  | B.null d = p
+  | B.null p = d
+  | hasTrailingPathSeparator d = d `B.append` p
+  | otherwise = d `B.append` B.singleton pathSeparator `B.append` p
+
+
+takeDirectory :: ByteString -> ByteString
+takeDirectory = dropTrailingPathSeparator . dropFileName
+
+
+dropFileName :: ByteString -> ByteString
+dropFileName = fst . splitFileName
+
+
+splitFileName :: ByteString -> (ByteString, ByteString)
+splitFileName filepath = (if B.null dir then "./" else dir, name)
+  where
+    (dir, name) = splitFileName_ filepath
+    splitFileName_ p = (drv `B.append` dir', file)
+      where
+        (drv, pth)  = splitDrive p
+        (dir', file) = B.breakEnd (== pathSeparator) pth
+
+
+stripPrefix :: ByteString -> ByteString -> Maybe ByteString
+stripPrefix a b = B.pack `fmap` L.stripPrefix (B.unpack a) (B.unpack b)
+
+
+--------------------------------------------------------------------------------
+-- ByteString Query functions
 
 -- | Helper function: check if the filepath has any parent directories in it.
-hasParentDir :: FilePath -> Bool
+hasParentDir :: ByteString -> Bool
 hasParentDir filepath =
-     ("/.." `isSuffixOf` filepath) ||
+     ("/.."  `B.isSuffixOf` filepath) ||
-     ("/../" `isInfixOf` filepath) ||
+     ("/../" `B.isInfixOf`  filepath) ||
-     ("../" `isPrefixOf` filepath)
+     ("../"  `B.isPrefixOf` filepath)
 
-hasDot :: FilePath -> Bool
+hasDot :: ByteString -> Bool
 hasDot filepath =
-     ("/." `isSuffixOf` filepath) ||
+     ("/."  `B.isSuffixOf` filepath) ||
-     ("/./" `isInfixOf` filepath) ||
+     ("/./" `B.isInfixOf`  filepath) ||
-     ("./" `isPrefixOf` filepath)
+     ("./"  `B.isPrefixOf` filepath)
 
-hasDoublePS :: FilePath -> Bool
+hasDoublePS :: ByteString -> Bool
 hasDoublePS filepath =
-     ("//" `isInfixOf` filepath)
+     ("//" `B.isInfixOf` filepath)
 
-isFileName :: FilePath -> Bool
+
+hasTrailingPathSeparator :: ByteString -> Bool
+hasTrailingPathSeparator filepath
+  | B.null filepath                  = False
+  | B.last filepath == pathSeparator = True
+  | otherwise                        = False
+
+
+hasLeadingPathSeparator :: ByteString -> Bool
+hasLeadingPathSeparator filepath
+  | B.null filepath                  = False
+  | B.head filepath == pathSeparator = True
+  | otherwise                        = False
+
+
+isFileName :: ByteString -> Bool
 isFileName filepath =
-     not ("/" `isInfixOf` filepath)
+     not ("/" `B.isInfixOf` filepath)
+
+
+isAbsolute :: ByteString -> Bool
+isAbsolute filepath
+  | B.null filepath                  = False
+  | B.head filepath == pathSeparator = True
+  | otherwise                        = False
+
+
+isRelative :: ByteString -> Bool
+isRelative = not . isAbsolute
+
+
+isValid :: ByteString -> Bool
+isValid filepath
+  | B.null filepath            = False
+  | filepath ==  ""            = False
+  | nullByte `B.elem` filepath = False
+  | otherwise                  = True
+
 
 
 --------------------------------------------------------------------------------
@@ -307,12 +470,11 @@ foreign import ccall "realpath"
 -- | return the canonicalized absolute pathname
 --
 -- like canonicalizePath, but uses realpath(3)
-realPath :: String -> IO String
+realPath :: ByteString -> IO ByteString
-realPath inp = do
+realPath inp =
-  encoding <- getFileSystemEncoding
   allocaBytes pathMax $ \tmp -> do
-      void $ GHC.withCString encoding inp
+      void $ B.useAsCString inp
            $ \cstr -> throwErrnoIfNull "realpath"
            $ c_realpath cstr tmp
-      GHC.peekCString encoding tmp
+      B.packCString tmp
 

src/HPath/Internal.hs

@@ -8,6 +8,7 @@ module HPath.Internal
   where
 
 import Control.DeepSeq (NFData (..))
+import Data.ByteString (ByteString)
 import Data.Data
 
 -- | Path of some base and type.
@@ -19,7 +20,7 @@ import Data.Data
 --
 -- There are no duplicate
 -- path separators @\/\/@, no @..@, no @.\/@, no @~\/@, etc.
-data Path b = MkPath FilePath
+data Path b = MkPath ByteString
   deriving (Typeable)
 
 -- | String equality.