Add AFPP support

This is tidied up commit containing the following changes by
https://github.com/hasufell:

* 66b3f48
* 15338c0

Not all changes made their way through. Beyond the stylistic cleanup,
notable reversions include:

* System.File.OsPath and its submodules have been removed as very little
  of directory relies on them. The few remaining portions have been
  inlined into submodules of System.Directory.Internal. For file
  operations, users are expected to use upstream packages at
  https://github.com/hasufell/file-io .

* Renaming of internal modules have been undone to untangle the AFPP
  revamp from unrelated refactors.

* Dependence on bytestring has been removed as it was found to be
  unnecessary after the cleanup.

Closes #136.

System/Directory/Internal/Common.hs

@@ -5,20 +5,32 @@ module System.Directory.Internal.Common
   ) where
 import Prelude ()
 import System.Directory.Internal.Prelude
-import System.FilePath
-  ( addTrailingPathSeparator
+import GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure))
+import GHC.IO.Encoding.UTF16 (mkUTF16le)
+import GHC.IO.Encoding.UTF8 (mkUTF8)
+import System.IO (hSetBinaryMode)
+import System.OsPath
+  ( OsPath
+  , OsString
+  , addTrailingPathSeparator
+  , decodeUtf
+  , decodeWith
+  , encodeUtf
   , hasTrailingPathSeparator
   , isPathSeparator
   , isRelative
   , joinDrive
   , joinPath
   , normalise
+  , pack
   , pathSeparator
   , pathSeparators
   , splitDirectories
   , splitDrive
+  , toChar
+  , unpack
+  , unsafeFromChar
   )
-import System.OsPath (OsPath, OsString, decodeUtf, encodeUtf)
 
 -- | A generator with side-effects.
 newtype ListT m a = ListT { unListT :: m (Maybe (a, ListT m a)) }
@@ -112,46 +124,57 @@ os = rightOrError . encodeUtf
 so :: OsString -> String
 so = rightOrError . decodeUtf
 
+ioeSetOsPath :: IOError -> OsPath -> IOError
+ioeSetOsPath err =
+  ioeSetFileName err .
+  rightOrError .
+  decodeWith
+    (mkUTF8 TransliterateCodingFailure)
+    (mkUTF16le TransliterateCodingFailure)
+
 -- | Given a list of path segments, expand @.@ and @..@.  The path segments
 -- must not contain path separators.
-expandDots :: [FilePath] -> [FilePath]
+expandDots :: [OsPath] -> [OsPath]
 expandDots = reverse . go []
   where
     go ys' xs' =
       case xs' of
         [] -> ys'
-        x : xs ->
-          case x of
-            "." -> go ys' xs
-            ".." ->
+        x : xs
+          | x == os "." -> go ys' xs
+          | x == os ".." ->
               case ys' of
                 [] -> go (x : ys') xs
-                ".." : _ -> go (x : ys') xs
-                _ : ys -> go ys xs
-            _ -> go (x : ys') xs
+                y : ys
+                  | y == os ".." -> go (x : ys') xs
+                  | otherwise -> go ys xs
+          | otherwise -> go (x : ys') xs
 
 -- | Convert to the right kind of slashes.
-normalisePathSeps :: FilePath -> FilePath
-normalisePathSeps p = (\ c -> if isPathSeparator c then pathSeparator else c) <$> p
+normalisePathSeps :: OsPath -> OsPath
+normalisePathSeps p = pack (normaliseChar <$> unpack p)
+  where normaliseChar c = if isPathSeparator c then pathSeparator else c
 
 -- | Remove redundant trailing slashes and pick the right kind of slash.
-normaliseTrailingSep :: FilePath -> FilePath
+normaliseTrailingSep :: OsPath -> OsPath
 normaliseTrailingSep path = do
-  let path' = reverse path
+  let path' = reverse (unpack path)
   let (sep, path'') = span isPathSeparator path'
   let addSep = if null sep then id else (pathSeparator :)
-  reverse (addSep path'')
+  pack (reverse (addSep path''))
 
 -- | Convert empty paths to the current directory, otherwise leave it
 -- unchanged.
-emptyToCurDir :: FilePath -> FilePath
-emptyToCurDir ""   = "."
-emptyToCurDir path = path
+emptyToCurDir :: OsPath -> OsPath
+emptyToCurDir path
+  | path == mempty = os "."
+  | otherwise      = path
 
 -- | Similar to 'normalise' but empty paths stay empty.
-simplifyPosix :: FilePath -> FilePath
-simplifyPosix ""   = ""
-simplifyPosix path = normalise path
+simplifyPosix :: OsPath -> OsPath
+simplifyPosix path
+  | path == mempty = mempty
+  | otherwise      = normalise path
 
 -- | Similar to 'normalise' but:
 --
@@ -160,12 +183,11 @@ simplifyPosix path = normalise path
 -- * paths starting with @\\\\?\\@ are preserved.
 --
 -- The goal is to preserve the meaning of paths better than 'normalise'.
-simplifyWindows :: FilePath -> FilePath
-simplifyWindows "" = ""
-simplifyWindows path =
-  case drive' of
-    "\\\\?\\" -> drive' <> subpath
-    _ -> simplifiedPath
+simplifyWindows :: OsPath -> OsPath
+simplifyWindows path
+  | path == mempty         = mempty
+  | drive' == os "\\\\?\\" = drive' <> subpath
+  | otherwise              = simplifiedPath
   where
     simplifiedPath = joinDrive drive' subpath'
     (drive, subpath) = splitDrive path
@@ -174,24 +196,29 @@ simplifyWindows path =
                stripPardirs . expandDots . skipSeps .
                splitDirectories $ subpath
 
-    upperDrive d = case d of
-      c : ':' : s | isAlpha c && all isPathSeparator s -> toUpper c : ':' : s
+    upperDrive d = case unpack d of
+      c : k : s
+        | isAlpha (toChar c), toChar k == ':', all isPathSeparator s ->
+          -- unsafeFromChar is safe here since all characters are ASCII.
+          pack (unsafeFromChar (toUpper (toChar c)) : unsafeFromChar ':' : s)
       _ -> d
-    skipSeps = filter (not . (`elem` (pure <$> pathSeparators)))
-    stripPardirs | pathIsAbsolute || subpathIsAbsolute = dropWhile (== "..")
+    skipSeps =
+      (pack <$>) .
+      filter (not . (`elem` (pure <$> pathSeparators))) .
+      (unpack <$>)
+    stripPardirs | pathIsAbsolute || subpathIsAbsolute = dropWhile (== os "..")
                  | otherwise = id
-    prependSep | subpathIsAbsolute = (pathSeparator :)
+    prependSep | subpathIsAbsolute = (pack [pathSeparator] <>)
                | otherwise = id
     avoidEmpty | not pathIsAbsolute
-                 && (null drive || hasTrailingPathSep) -- prefer "C:" over "C:."
+               , drive == mempty || hasTrailingPathSep -- prefer "C:" over "C:."
                  = emptyToCurDir
                | otherwise = id
-    appendSep p | hasTrailingPathSep
-                  && not (pathIsAbsolute && null p)
+    appendSep p | hasTrailingPathSep, not (pathIsAbsolute && p == mempty)
                   = addTrailingPathSeparator p
                 | otherwise = p
     pathIsAbsolute = not (isRelative path)
-    subpathIsAbsolute = any isPathSeparator (take 1 subpath)
+    subpathIsAbsolute = any isPathSeparator (take 1 (unpack subpath))
     hasTrailingPathSep = hasTrailingPathSeparator subpath
 
 data FileType = File
@@ -222,6 +249,14 @@ data Permissions
   , searchable :: Bool
   } deriving (Eq, Ord, Read, Show)
 
+withBinaryHandle :: IO Handle -> (Handle -> IO r) -> IO r
+withBinaryHandle open = bracket openBinary hClose
+  where
+    openBinary = do
+      h <- open
+      hSetBinaryMode h True
+      pure h
+
 -- | Copy data from one handle to another until end of file.
 copyHandleData :: Handle                -- ^ Source handle
                -> Handle                -- ^ Destination handle

System/Directory/Internal/Config.hs

@@ -1,9 +1,10 @@
 {-# LANGUAGE CPP #-}
 module System.Directory.Internal.Config where
 #include <HsDirectoryConfig.h>
+import System.Directory.Internal.Common
 
-exeExtension :: String
-exeExtension = EXE_EXTENSION
+exeExtension :: OsString
+exeExtension = os EXE_EXTENSION
 -- We avoid using #const_str from hsc because it breaks cross-compilation
 -- builds, so we use this ugly workaround where we simply paste the C string
 -- literal directly in here.  This will probably break if the EXE_EXTENSION