.ghci

-:set -fwarn-unused-binds -fwarn-unused-imports -fwarn-orphans
-:set -isrc -itests
-:load System.FilePath System.FilePath.Windows System.FilePath.Posix Generate Test
-import qualified System.FilePath.Windows as W
-import qualified System.FilePath.Posix as P
-
-:def docs_ const $ pure ":!cabal haddock"
-:def docs const $ pure $ unlines [":docs_",":!start dist\\doc\\html\\filepath\\System-FilePath.html"]
-
-:def gen const $ pure "Generate.main"
-:def test \x -> pure $ if null x then "Test.main" else "System.Environment.withArgs [" ++ show x ++ "] Test.main"
-:def go \x -> pure $ unlines [":reload",":gen",":reload",":test " ++ x,":gen",":reload"]
-:def testfull const $ pure $ unlines [":reload","gen",":reload","!cabal test"]

.github/scripts/brew.sh

+#!/bin/sh
+
+set -eux
+
+. .github/scripts/env.sh
+
+if [ -e "$HOME/.brew" ] ; then
+	(
+	cd "$HOME/.brew"
+	git fetch --depth 1
+	git reset --hard origin/master
+	)
+else
+	git clone --depth=1 https://github.com/Homebrew/brew "$HOME/.brew"
+fi
+export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH"
+
+mkdir -p $CI_PROJECT_DIR/.brew_cache
+export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
+mkdir -p $CI_PROJECT_DIR/.brew_logs
+export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
+mkdir -p /private/tmp/.brew_tmp
+export HOMEBREW_TEMP=/private/tmp/.brew_tmp
+
+brew update
+brew install ${1+"$@"}
+
+
+set -eux
+
+. .github/scripts/env.sh
+
+if [ -e "$HOME/.brew" ] ; then
+	(
+	cd "$HOME/.brew"
+	git fetch --depth 1
+	git reset --hard origin/master
+	)
+else
+	git clone --depth=1 https://github.com/Homebrew/brew "$HOME/.brew"
+fi
+export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH"
+
+mkdir -p $CI_PROJECT_DIR/.brew_cache
+export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
+mkdir -p $CI_PROJECT_DIR/.brew_logs
+export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
+mkdir -p /private/tmp/.brew_tmp
+export HOMEBREW_TEMP=/private/tmp/.brew_tmp
+
+brew update
+brew install ${1+"$@"}
+

.github/scripts/env.sh

+#!/bin/sh
+
+if [ "${RUNNER_OS}" = "Windows" ] ; then
+	ext=".exe"
+else
+	ext=''
+fi
+
+export DEBIAN_FRONTEND=noninteractive
+export TZ=Asia/Singapore
+
+export OS="$RUNNER_OS"
+export PATH="$HOME/.local/bin:$PATH"
+
+if [ "${RUNNER_OS}" = "Windows" ] ; then
+	# on windows use pwd to get unix style path
+	CI_PROJECT_DIR="$(pwd)"
+	export CI_PROJECT_DIR
+    export GHCUP_INSTALL_BASE_PREFIX="/c"
+    export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin"
+    export PATH="$GHCUP_BIN:$PATH"
+	export CABAL_DIR="C:\\Users\\runneradmin\\AppData\\Roaming\\cabal"
+else
+	export CI_PROJECT_DIR="${GITHUB_WORKSPACE}"
+    export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
+    export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/.ghcup/bin"
+    export PATH="$GHCUP_BIN:$PATH"
+    export CABAL_DIR="$CI_PROJECT_DIR/cabal"
+    export CABAL_CACHE="$CI_PROJECT_DIR/cabal-cache"
+fi

.github/workflows/test.yaml

@@ -13,71 +13,47 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        os: [ubuntu-latest, macOS-latest, windows-latest]
-        ghc: ['8.0.2', '8.2.2', '8.4.4', '8.6.5', '8.8.4', '8.10.7', '9.0.2', '9.2.1']
-        cabal: ['3.6.2.0']
+        os: [ubuntu-latest]
+        ghc: ['8.6', '8.8', '8.10', '9.0', '9.2', '9.4', '9.6', '9.8']
+        cabal: ['3.8.1.0']
         include:
-          - os: ubuntu-latest
-            ghc: 'HEAD'
-            experimental: true
-          - os: ubuntu-latest
-            ghc: 'recommended'
-            experimental: true
-          - os: ubuntu-latest
-            ghc: 'latest'
-            experimental: true
-        exclude:
           - os: macOS-latest
-            ghc: '8.0.2'
+            ghc: '9.4'
+            cabal: '3.8.1.0'
           - os: macOS-latest
-            ghc: '8.2.2'
-          - os: macOS-latest
-            ghc: '8.4.4'
-          - os: macOS-latest
-            ghc: '8.6.5'
-          - os: macOS-latest
-            ghc: '8.8.4'
-          - os: macOS-latest
-            ghc: '9.0.2'
-          - os: windows-latest
-            ghc: '8.0.2'
-          - os: windows-latest
-            ghc: '8.2.2'
+            ghc: '9.6'
+            cabal: '3.8.1.0'
           - os: windows-latest
-            ghc: '8.4.4'
+            ghc: '9.4'
+            cabal: '3.8.1.0'
           - os: windows-latest
-            ghc: '8.6.5'
-          - os: windows-latest
-            ghc: '8.8.4'
-          - os: windows-latest
-            ghc: '9.0.2'
-
+            ghc: '9.6'
+            cabal: '3.8.1.0'
     steps:
-    - uses: actions/checkout@v2
+    - uses: actions/checkout@v3
+
+    - name: Install dependencies (Ubuntu)
+      if: runner.os == 'Linux'
+      run: |
+        sudo apt-get -y update
+        sudo apt-get -y install libtinfo5 libtinfo6 libncurses5 libncurses6
 
     - name: Install ghc/cabal
       run: |
         set -eux
-        if [ "${{ matrix.ghc }}" == 'HEAD' ] ; then
-          ghcup install ghc -u 'https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-deb10-linux.tar.xz?job=validate-x86_64-linux-deb10-hadrian' head
-          ghcup set ghc head
-        else
-          ghcup install ghc ${{ matrix.ghc }}
-          ghcup set ghc ${{ matrix.ghc }}
-        fi
+        ghcup install ghc --set ${{ matrix.ghc }}
         ghcup install cabal ${{ matrix.cabal }}
       shell: bash
 
     - name: Build
       run: |
         set -eux
-        [ "${{ matrix.ghc }}" == 'HEAD' ] ||
-          [ "${{ matrix.ghc }}" == 'recommended' ] ||
-          [ "${{ matrix.ghc }}" == 'latest' ] ||
-          [ "$(ghc --numeric-version)" = "${{ matrix.ghc }}" ] 
         cabal update
         cabal build --enable-tests --enable-benchmarks
-        cabal test
+        cabal test --test-show-details=direct filepath-tests
+        cabal test --test-show-details=direct --test-options='--quickcheck-tests 50_000' filepath-equivalent-tests
+        cabal test --test-show-details=direct abstract-filepath
+        cabal bench
         cabal haddock
         cabal check
         cabal sdist
@@ -92,43 +68,106 @@ jobs:
         make all
         git diff --exit-code
 
-  emulated:
-    needs: build
+  i386:
     runs-on: ubuntu-latest
+    container:
+      image: i386/ubuntu:bionic
+    steps:
+    - name: Install
+      run: |
+        apt-get update -y
+        apt-get install -y autoconf build-essential zlib1g-dev libgmp-dev curl libncurses5 libtinfo5 libncurses5-dev libtinfo-dev git
+        curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 sh
+    - uses: actions/checkout@v1
+    - name: Test
+      run: |
+        . ~/.ghcup/env
+        cabal update
+        cabal test
+        cabal bench
+
+  # We use github.com/haskell self-hosted runners for ARM testing.
+  # If they become unavailable in future, put ['armv7', 'aarch64']
+  # back to emulation jobs above.
+  arm:
+    runs-on: [self-hosted, Linux, ARM64]
     strategy:
       fail-fast: true
       matrix:
-        arch: ['s390x', 'ppc64le', 'armv7', 'aarch64']
+        arch: [arm32v7, arm64v8]
     steps:
-    - uses: actions/checkout@v2
-    - uses: uraimo/run-on-arch-action@v2.1.1
-      timeout-minutes: 60
-      with:
-        arch: ${{ matrix.arch }}
-        distro: ubuntu20.04
-        githubToken: ${{ github.token }}
-        install: |
-          apt-get update -y
-          apt-get install -y ghc libghc-quickcheck2-dev cpphs git make
+      - uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
+        name: Cleanup
+        with:
+          args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
+
+      - name: Checkout code
+        uses: actions/checkout@v3
+
+      - if: matrix.arch == 'arm32v7'
+        uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
+        name: Run build (arm32v7 linux)
+        with:
+          args: sh -c "cabal update && ghcup install ghc --isolate=/usr --force 9.2.2 && cabal test -w ghc-9.2.2 && cabal bench -w ghc-9.2.2"
+
+      - if: matrix.arch == 'arm64v8'
+        uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
+        name: Run build (arm64v8 linux)
+        with:
+          args: sh -c "cabal update && ghcup install ghc --isolate=/usr --force 9.2.2 && cabal test -w ghc-9.2.2 && cabal bench -w ghc-9.2.2"
+
+  darwin_arm:
+    runs-on: ${{ matrix.os }}
+    env:
+      MACOSX_DEPLOYMENT_TARGET: 10.13
+    strategy:
+      fail-fast: false
+      matrix:
+        include:
+          - os: [self-hosted, macOS, ARM64]
+            ghc: 8.10.7
+          - os: [self-hosted, macOS, ARM64]
+            ghc: 9.2.6
+          - os: [self-hosted, macOS, ARM64]
+            ghc: 9.4.4
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+
+      - name: Run build
         run: |
-          ghc --version
-          ghc --make -o Main tests/Test.hs -itests/ +RTS -s
-          ./Main +RTS -s
+          bash .github/scripts/brew.sh git coreutils llvm@13 autoconf automake
+          export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$HOME/.brew/opt/llvm@13/bin:$PATH"
+          export CC="$HOME/.brew/opt/llvm@13/bin/clang"
+          export CXX="$HOME/.brew/opt/llvm@13/bin/clang++"
+          export LD=ld
+          export AR="$HOME/.brew/opt/llvm@13/bin/llvm-ar"
+          export RANLIB="$HOME/.brew/opt/llvm@13/bin/llvm-ranlib"
+          . .github/scripts/env.sh
+          curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 BOOTSTRAP_HASKELL_GHC_VERSION=${{ matrix.ghc }} BOOTSTRAP_HASKELL_ADJUST_BASHRC=yes sh
+          cabal test
+          cabal bench
+        env:
+          HOMEBREW_CHANGE_ARCH_TO_ARM: 1
 
-  emulated-i386:
-    runs-on: ubuntu-latest
-    container:
-      image: i386/ubuntu:bionic
+  freebsd:
+    runs-on: ${{ matrix.os }}
+    strategy:
+      fail-fast: false
+      matrix:
+        include:
+          - os: [self-hosted, FreeBSD, X64]
+            ghc: 9.4.8
+          - os: [self-hosted, FreeBSD, X64]
+            ghc: 9.6.4
     steps:
-    - name: install
-      run: |
-          apt-get update -y
-          apt-get install -y ghc libghc-quickcheck2-dev cpphs git make
-      shell: bash
-    - uses: actions/checkout@v1
-    - name: test
-      run: |
-          ghc --version
-          ghc --make -o Main tests/Test.hs -itests/ +RTS -s
-          ./Main +RTS -s
-      shell: bash
+      - name: Checkout code
+        uses: actions/checkout@v3
+
+      - name: Run build
+        run: |
+          pkg install -y curl gcc gmp gmake ncurses perl5 libffi libiconv git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
+          . .github/scripts/env.sh
+          curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 BOOTSTRAP_HASKELL_GHC_VERSION=${{ matrix.ghc }} BOOTSTRAP_HASKELL_ADJUST_BASHRC=yes sh
+          cabal test
+          cabal bench

.hlint.yaml

-# HLint configuration file
-# https://github.com/ndmitchell/hlint
-##########################
-
-# Use fmap instead of <$> to make cross-version compatibility easier
-- ignore: {name: "Use <$>"}
-
-# We use [Char] because sometimes we really are talking about a set of Char.
-- ignore: {name: "Use String"}
-
-# We don't use the extra library
-- ignore: {name: "Use drop1"}
-- ignore: {name: "Use upper"}
-- ignore: {name: "Use lower"}
-- ignore: {name: "Use zipFrom"}
+- ignore: {name: "Redundant lambda"}
+- ignore: {name: "Redundant multi-way if"}
+- ignore: {name: "Use if"}
+- ignore: {name: "Use fmap"}
+- ignore: {name: "Use uncurry"}
+- ignore: {name: "Use unless"}

Generate.hs

-{-# LANGUAGE RecordWildCards, ViewPatterns #-}
+{-# LANGUAGE CPP, RecordWildCards, ViewPatterns #-}
 
 module Generate(main) where
 
 import Control.Exception
 import Control.Monad
+import Data.Semigroup
 import Data.Char
 import Data.List
 import System.Directory
@@ -14,13 +15,46 @@ main :: IO ()
 main = do
     src <- readFile "System/FilePath/Internal.hs"
     let tests = map renderTest $ concatMap parseTest $ lines src
-    writeFileBinaryChanged "tests/TestGen.hs" $ unlines $
+    writeFileBinaryChanged "tests/filepath-tests/TestGen.hs" $ unlines $
         ["-- GENERATED CODE: See ../Generate.hs"
+#ifndef GHC_MAKE
+        , "{-# LANGUAGE OverloadedStrings #-}"
+        , "{-# LANGUAGE ViewPatterns #-}"
+#endif
+        , "{-# LANGUAGE CPP #-}"
+        , "{-# OPTIONS_GHC -Wno-name-shadowing #-}"
+        , "{-# OPTIONS_GHC -Wno-orphans #-}"
         ,"module TestGen(tests) where"
         ,"import TestUtil"
+        ,"#if !MIN_VERSION_base(4,11,0)"
+        ,"import Data.Semigroup"
+        ,"#endif"
+        ,"import Prelude as P"
+        ,"import Data.String"
+        ,"import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )"
+        ,"import GHC.IO.Encoding.UTF16 ( mkUTF16le )"
+        ,"import GHC.IO.Encoding.UTF8 ( mkUTF8 )"
+        ,"import System.OsString.Internal.Types"
+        ,"import System.OsString.Encoding.Internal"
+        ,"import qualified Data.Char as C"
+        ,"import qualified System.OsString.Data.ByteString.Short as SBS"
+        ,"import qualified System.OsString.Data.ByteString.Short.Word16 as SBS16"
         ,"import qualified System.FilePath.Windows as W"
         ,"import qualified System.FilePath.Posix as P"
-        ,"{-# ANN module \"HLint: ignore\" #-}"
+#ifdef GHC_MAKE
+        ,"import qualified System.OsPath.Windows.Internal as AFP_W"
+        ,"import qualified System.OsPath.Posix.Internal as AFP_P"
+#else
+        ,"import qualified System.OsPath.Windows as AFP_W"
+        ,"import qualified System.OsPath.Posix as AFP_P"
+#endif
+        ,"instance IsString WindowsString where fromString = WS . either (error . show) id . encodeWithTE (mkUTF16le TransliterateCodingFailure)"
+        ,"instance IsString PosixString where fromString = PS . either (error . show) id . encodeWithTE (mkUTF8 TransliterateCodingFailure)"
+        ,"#if defined(mingw32_HOST_OS) || defined(__MINGW32__)"
+        ,"instance IsString OsString where fromString = OsString . WS . either (error . show) id . encodeWithTE (mkUTF16le TransliterateCodingFailure)"
+        ,"#else"
+        ,"instance IsString OsString where fromString = OsString . PS . either (error . show) id . encodeWithTE (mkUTF8 TransliterateCodingFailure)"
+        ,"#endif"
         ,"tests :: [(String, Property)]"
         ,"tests ="] ++
         ["    " ++ c ++ "(" ++ show t1 ++ ", " ++ t2 ++ ")" | (c,(t1,t2)) <- zip ("[":repeat ",") tests] ++
@@ -28,7 +62,12 @@ main = do
 
 
 
-data PW = P | W deriving Show -- Posix or Windows
+data PW = P      -- legacy posix
+        | W      -- legacy windows
+        | AFP_P  -- abstract-filepath posix
+        | AFP_W  -- abstract-filepath windows
+  deriving Show
+
 data Test = Test
     {testPlatform :: PW
     ,testVars :: [(String,String)]   -- generator constructor, variable
@@ -39,9 +78,9 @@ data Test = Test
 parseTest :: String -> [Test]
 parseTest (stripPrefix "-- > " -> Just x) = platform $ toLexemes x
     where
-        platform ("Windows":":":x) = [valid W x]
-        platform ("Posix"  :":":x) = [valid P x]
-        platform x                 = [valid P x, valid W x]
+        platform ("Windows":":":x) = [valid W x, valid AFP_W x]
+        platform ("Posix"  :":":x) = [valid P x, valid AFP_P x]
+        platform x                 = [valid P x, valid W x, valid AFP_P x, valid AFP_W x]
 
         valid p ("Valid":x) = free p a $ drop 1 b
             where (a,b) = break (== "=>") x
@@ -49,9 +88,12 @@ parseTest (stripPrefix "-- > " -> Just x) = platform $ toLexemes x
 
         free p val x = Test p [(ctor v, v) | v <- vars] x
             where vars = nub $ sort [v | v@[c] <- x, isAlpha c]
-                  ctor v | v < "x" = ""
+                  ctor v | v < "x"  = ""
                          | v `elem` val = "QFilePathValid" ++ show p
-                         | otherwise = "QFilePath"
+                         | otherwise = case p of
+                                         AFP_P -> if v == "z" then "QFilePathsAFP_P" else "QFilePathAFP_P"
+                                         AFP_W -> if v == "z" then "QFilePathsAFP_W" else "QFilePathAFP_W"
+                                         _ -> if v == "z" then "" else "QFilePath"
 parseTest _ = []
 
 
@@ -80,14 +122,67 @@ renderTest Test{..} = (body, code)
         body = fromLexemes $ map (qualify testPlatform) testBody
 
 
+
 qualify :: PW -> String -> String
 qualify pw str
-    | str `elem` fpops || (all isAlpha str && length str > 1 && str `notElem` prelude) = show pw ++ "." ++ str
-    | otherwise = str
+    | str `elem` fpops || (all isAlpha str && length str > 1 && str `notElem` prelude)
+      = if str `elem` bs then qualifyBS str  else show pw ++ "." ++ str
+    | otherwise = encode str
     where
-        prelude = ["elem","uncurry","snd","fst","not","null","if","then","else"
-                  ,"True","False","Just","Nothing","fromJust","concat","isPrefixOf","isSuffixOf","any","foldr"]
+        bs = ["null", "concat", "isPrefixOf", "isSuffixOf", "any"]
+        prelude = ["elem","uncurry","snd","fst","not","if","then","else"
+                  ,"True","False","Just","Nothing","fromJust","foldr"]
         fpops = ["</>","<.>","-<.>"]
+#ifdef GHC_MAKE
+        encode v
+          | isString' v = case pw of
+                            AFP_P -> "(encodeUtf8 " <> v <> ")"
+                            AFP_W -> "(encodeUtf16LE " <> v <> ")"
+                            _ -> v
+          | isChar' v = case pw of
+                            AFP_P -> "(fromIntegral . C.ord $ " <> v <> ")"
+                            AFP_W -> "(fromIntegral . C.ord $ " <> v <> ")"
+                            _ -> v
+          | otherwise = v
+        isString' xs@('"':_:_) = last xs == '"'
+        isString' _ = False
+        isChar' xs@('\'':_:_) = last xs == '\''
+        isChar' _ = False
+        qualifyBS v = case pw of
+                        AFP_P -> "SBS." <> v
+                        AFP_W -> "SBS16." <> v
+                        _ -> v
+#else
+        encode v
+          | isString' v = case pw of
+                            AFP_P -> "(" <> v <> ")"
+                            AFP_W -> "(" <> v <> ")"
+                            _ -> v
+          | isChar' v = case pw of
+                            AFP_P -> "(PW . fromIntegral . C.ord $ " <> v <> ")"
+                            AFP_W -> "(WW . fromIntegral . C.ord $ " <> v <> ")"
+                            _ -> v
+          | otherwise = v
+        isString' xs@('"':_:_) = last xs == '"'
+        isString' _ = False
+        isChar' xs@('\'':_:_) = last xs == '\''
+        isChar' _ = False
+        qualifyBS v = case pw of
+                        AFP_P
+                          | v == "concat" -> "(PS . SBS." <> v <> " . fmap getPosixString)"
+                          | v == "any" -> "(\\f (getPosixString -> x) -> SBS." <> v <> " (f . PW) x)"
+                          | v == "isPrefixOf" -> "(\\(getPosixString -> x) (getPosixString -> y) -> SBS." <> v <> " x y)"
+                          | v == "isSuffixOf" -> "(\\(getPosixString -> x) (getPosixString -> y) -> SBS." <> v <> " x y)"
+                          | otherwise -> "(SBS." <> v <> " . getPosixString)"
+                        AFP_W
+                          | v == "concat" -> "(WS . SBS16." <> v <> " . fmap getWindowsString)"
+                          | v == "any" -> "(\\f (getWindowsString -> x) -> SBS16." <> v <> " (f . WW) x)"
+                          | v == "isPrefixOf" -> "(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16." <> v <> " x y)"
+                          | v == "isSuffixOf" -> "(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16." <> v <> " x y)"
+                          | otherwise -> "(SBS16." <> v <> " . getWindowsString)"
+                        _ -> v
+#endif
+
 
 
 ---------------------------------------------------------------------

HACKING.md

@@ -13,9 +13,7 @@ that must evaluate to `True`. These tests follow a few rules:
 * If `Valid x =>` appears at the start of a doc test, that means the property
   will only be tested with `x` passing the `isValid` predicate.
 
-The tests can be generated by `make gen` in the root of the repo, and will be placed in `tests/TestGen.hs`.
+The tests can be generated by `make gen` in the root of the repo, and will be placed in `tests/filepath-tests/TestGen.hs`.
 The `TestGen.hs` file is checked into the repo, and the CI scripts check that `TestGen.hs` is in sync with
 what would be generated a fresh - if you don't regenerate `TestGen.hs` the CI will fail.
 
-The `.ghci` file is set up to allow you to type `ghci` to open the library, then `:go` will regenerate the
-tests and run them.

Makefile

-all: cpp gen
-
-cpp:
-	cpphs --noline -DIS_WINDOWS=False -DMODULE_NAME=Posix   -OSystem/FilePath/Posix.hs   System/FilePath/Internal.hs
-	cpphs --noline -DIS_WINDOWS=True  -DMODULE_NAME=Windows -OSystem/FilePath/Windows.hs System/FilePath/Internal.hs
+all: gen
 
 gen:
 	runhaskell Generate.hs
 
-.PHONY: all cpp gen
+
+.PHONY: all gen

PULL_REQUEST_TEMPLATE.md

-Thanks for the pull request!
-
-By raising this pull request you confirm you are licensing your contribution under all licenses that apply to this project (see LICENSE) and that you have no patents covering your contribution.
-
-If you care, my PR preferences are at https://github.com/ndmitchell/neil#contributions, but they're all guidelines, and I'm not too fussy - you don't have to read them.

README.md

 # FilePath [![Hackage version](https://img.shields.io/hackage/v/filepath.svg?label=Hackage)](https://hackage.haskell.org/package/filepath)
 
 The `filepath` package provides functionality for manipulating `FilePath` values, and is shipped with [GHC](https://www.haskell.org/ghc/).
-It provides three modules:
+It provides two variants for filepaths:
 
-* [`System.FilePath.Posix`](http://hackage.haskell.org/package/filepath/docs/System-FilePath-Posix.html)
-  manipulates POSIX/Linux style `FilePath` values (with `/` as the path separator).
-* [`System.FilePath.Windows`](http://hackage.haskell.org/package/filepath/docs/System-FilePath-Windows.html)
-  manipulates Windows style `FilePath` values (with either `\` or `/` as the path separator, and deals with drives).
-* [`System.FilePath`](http://hackage.haskell.org/package/filepath/docs/System-FilePath.html)
-  is an alias for the module appropriate to your platform.
+1. legacy filepaths: `type FilePath = String`
+2. operating system abstracted filepaths (`OsPath`): internally unpinned `ShortByteString` (platform-dependent encoding)
+
+It is recommended to use `OsPath` when possible, because it is more correct.
+
+For each variant there are three main modules:
+
+* `System.FilePath.Posix` / `System.OsPath.Posix` manipulates POSIX\/Linux style `FilePath` values (with `/` as the path separator).
+* `System.FilePath.Windows` / `System.OsPath.Windows` manipulates Windows style `FilePath` values (with either `\` or `/` as the path separator, and deals with drives).
+* `System.FilePath` / `System.OsPath` for dealing with current platform-specific filepaths
 
 All three modules provide the same API, and the same documentation (calling out differences in the different variants).
 
+`System.OsString` is like `System.OsPath`, but more general purpose. Refer to the documentation of
+those modules for more information.
+
 ### What is a `FilePath`?
 
-In Haskell, the definition is `type FilePath = String` as of now. A Haskell `String` is a list of Unicode code points.
+In Haskell, the legacy definition (used in `base` and Prelude) is `type FilePath = String`,
+where a Haskell `String` is a list of Unicode code points.
+
+The new definition is (simplified) `newtype OsPath = AFP ShortByteString`, where
+`ShortByteString` is an unpinned byte array and follows syscall conventions, preserving the encoding.
 
 On unix, filenames don't have a predefined encoding as per the
 [POSIX specification](https://pubs.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap03.html#tag_03_170)
 and are passed as `char[]` to syscalls.
 
-On windows (at least the API used by `Win32`) filepaths are UTF-16 strings.
+On windows (at least the API used by `Win32`) filepaths are UTF-16LE strings.
 
-This means that Haskell filepaths have to be converted to C-strings on unix
-(utilizing the current filesystem encoding) and to UTF-16 strings
-on windows.
+You are encouraged to use `OsPath` whenever possible, because it is more correct.
 
-Further, this is a low-level library and it makes no attempt at providing a more
+Also note that this is a low-level library and it makes no attempt at providing a more
 type safe variant for filepaths (e.g. by distinguishing between absolute and relative
 paths) and ensures no invariants (such as filepath validity).
 

System/FilePath/Internal.hs

-#if __GLASGOW_HASKELL__ >= 704
-{-# LANGUAGE Safe #-}
-#endif
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE MultiWayIf #-}
 
 -- This template expects CPP definitions for:
 --     MODULE_NAME = Posix | Windows
@@ -61,16 +60,25 @@
 --
 -- References:
 -- [1] <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx Naming Files, Paths and Namespaces> (Microsoft MSDN)
+#ifndef OS_PATH
 module System.FilePath.MODULE_NAME
+#else
+module System.OsPath.MODULE_NAME.Internal
+#endif
     (
     -- * Separator predicates
+#ifndef OS_PATH
     FilePath,
+#endif
     pathSeparator, pathSeparators, isPathSeparator,
     searchPathSeparator, isSearchPathSeparator,
     extSeparator, isExtSeparator,
 
     -- * @$PATH@ methods
-    splitSearchPath, getSearchPath,
+    splitSearchPath,
+#ifndef OS_PATH
+    getSearchPath,
+#endif
 
     -- * Extension functions
     splitExtension,
@@ -103,11 +111,50 @@ module System.FilePath.MODULE_NAME
     )
     where
 
-import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
-import Data.Maybe(isJust)
-import Data.List(stripPrefix, isSuffixOf)
+{- HLINT ignore "Use fewer imports" -}
+import Prelude (Char, Bool(..), Maybe(..), (.), (&&), (<=), not, fst, maybe, (||), (==), ($), otherwise, fmap, mempty, (>=), (/=), (++), snd)
+import Data.Bifunctor (first)
+import Data.Semigroup ((<>))
+import qualified Prelude as P
+import Data.Maybe(fromMaybe, isJust)
+import qualified Data.List as L
 
+#ifndef OS_PATH
+import Data.String (fromString)
 import System.Environment(getEnv)
+import Prelude (String, map, FilePath, Eq, IO, id, last, init, reverse, dropWhile, null, break, take, all, elem, any, span)
+import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
+import Data.List(stripPrefix, isSuffixOf, uncons, dropWhileEnd)
+#define CHAR Char
+#define STRING String
+#define FILEPATH FilePath
+#else
+import Prelude (fromIntegral)
+import Control.Exception ( SomeException, evaluate, try, displayException )
+import Control.DeepSeq (force)
+import GHC.IO (unsafePerformIO)
+import qualified Data.Char as C
+#ifdef WINDOWS
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+import GHC.IO.Encoding.UTF16 ( mkUTF16le )
+import qualified GHC.Foreign as GHC
+import Data.Word ( Word16 )
+import System.OsString.Data.ByteString.Short.Word16
+import System.OsString.Data.ByteString.Short ( packCStringLen )
+#define CHAR Word16
+#define STRING ShortByteString
+#define FILEPATH ShortByteString
+#else
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+import qualified GHC.Foreign as GHC
+import GHC.IO.Encoding.UTF8 ( mkUTF8 )
+import Data.Word ( Word8 )
+import System.OsString.Data.ByteString.Short
+#define CHAR Word8
+#define STRING ShortByteString
+#define FILEPATH ShortByteString
+#endif
+#endif 
 
 
 infixr 7  <.>, -<.>
@@ -138,51 +185,52 @@ isWindows = IS_WINDOWS
 -- > Windows: pathSeparator == '\\'
 -- > Posix:   pathSeparator ==  '/'
 -- > isPathSeparator pathSeparator
-pathSeparator :: Char
-pathSeparator = if isWindows then '\\' else '/'
+pathSeparator :: CHAR
+pathSeparator = if isWindows then _backslash else _slash
 
 -- | The list of all possible separators.
 --
 -- > Windows: pathSeparators == ['\\', '/']
 -- > Posix:   pathSeparators == ['/']
 -- > pathSeparator `elem` pathSeparators
-pathSeparators :: [Char]
-pathSeparators = if isWindows then "\\/" else "/"
+pathSeparators :: [CHAR]
+pathSeparators = if isWindows then [_backslash, _slash] else [_slash]
 
 -- | Rather than using @(== 'pathSeparator')@, use this. Test if something
 --   is a path separator.
 --
 -- > isPathSeparator a == (a `elem` pathSeparators)
-isPathSeparator :: Char -> Bool
-isPathSeparator '/' = True
-isPathSeparator '\\' = isWindows
-isPathSeparator _ = False
+isPathSeparator :: CHAR -> Bool
+isPathSeparator c
+  | c == _slash = True
+  | c == _backslash = isWindows
+  | otherwise = False
 
 
 -- | The character that is used to separate the entries in the $PATH environment variable.
 --
 -- > Windows: searchPathSeparator == ';'
 -- > Posix:   searchPathSeparator == ':'
-searchPathSeparator :: Char
-searchPathSeparator = if isWindows then ';' else ':'
+searchPathSeparator :: CHAR
+searchPathSeparator = if isWindows then _semicolon else _colon
 
 -- | Is the character a file separator?
 --
 -- > isSearchPathSeparator a == (a == searchPathSeparator)
-isSearchPathSeparator :: Char -> Bool
+isSearchPathSeparator :: CHAR -> Bool
 isSearchPathSeparator = (== searchPathSeparator)
 
 
 -- | File extension character
 --
 -- > extSeparator == '.'
-extSeparator :: Char
-extSeparator = '.'
+extSeparator :: CHAR
+extSeparator = _period
 
 -- | Is the character an extension character?
 --
 -- > isExtSeparator a == (a == extSeparator)
-isExtSeparator :: Char -> Bool
+isExtSeparator :: CHAR -> Bool
 isExtSeparator = (== extSeparator)
 
 
@@ -201,21 +249,31 @@ isExtSeparator = (== extSeparator)
 -- > Windows: splitSearchPath "File1;File2;File3"  == ["File1","File2","File3"]
 -- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]
 -- > Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"]
-splitSearchPath :: String -> [FilePath]
+splitSearchPath :: STRING -> [FILEPATH]
 splitSearchPath = f
     where
-    f xs = case break isSearchPathSeparator xs of
-           (pre, []    ) -> g pre
-           (pre, _:post) -> g pre ++ f post
-
-    g "" = ["." | isPosix]
-    g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x]
-    g x = [x]
-
-
--- | Get a list of 'FilePath's in the $PATH variable.
-getSearchPath :: IO [FilePath]
+    f xs = let (pre, post) = break isSearchPathSeparator xs
+           in case uncons post of
+             Nothing     -> g pre
+             Just (_, t) -> g pre ++ f t
+
+    g x = case uncons x of
+      Nothing -> [singleton _period | isPosix]
+      Just (h, t)
+        | h == _quotedbl
+        , (Just _) <- uncons t -- >= 2
+        , isWindows
+        , (Just (i, l)) <- unsnoc t
+        , l == _quotedbl -> [i]
+        | otherwise -> [x]
+
+
+-- TODO for AFPP
+#ifndef OS_PATH
+-- | Get a list of 'FILEPATH's in the $PATH variable.
+getSearchPath :: IO [FILEPATH]
 getSearchPath = fmap splitSearchPath (getEnv "PATH")
+#endif
 
 
 ---------------------------------------------------------------------
@@ -224,7 +282,7 @@ getSearchPath = fmap splitSearchPath (getEnv "PATH")
 -- | Split on the extension. 'addExtension' is the inverse.
 --
 -- > splitExtension "/directory/path.ext" == ("/directory/path",".ext")
--- > uncurry (++) (splitExtension x) == x
+-- > uncurry (<>) (splitExtension x) == x
 -- > Valid x => uncurry addExtension (splitExtension x) == x
 -- > splitExtension "file.txt" == ("file",".txt")
 -- > splitExtension "file" == ("file","")
@@ -233,13 +291,24 @@ getSearchPath = fmap splitSearchPath (getEnv "PATH")
 -- > splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")
 -- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")
 -- > splitExtension "file/path.txt/" == ("file/path.txt/","")
-splitExtension :: FilePath -> (String, String)
-splitExtension x = case nameDot of
-                       "" -> (x,"")
-                       _ -> (dir ++ init nameDot, extSeparator : ext)
-    where
-        (dir,file) = splitFileName_ x
-        (nameDot,ext) = breakEnd isExtSeparator file
+
+-- A naive implementation would be to use @splitFileName_@ first,
+-- then break filename into basename and extension, then recombine dir and basename.
+-- This is way too expensive, see @splitFileName_@ comment for discussion.
+--
+-- Instead we speculatively split on the extension separator first, then check
+-- whether results are well-formed.
+splitExtension :: FILEPATH -> (STRING, STRING)
+splitExtension x
+  -- Imagine x = "no-dots", then nameDot = ""
+  | null nameDot = (x, mempty)
+  -- Imagine x = "\\shared.with.dots\no-dots"
+  | isWindows && null (dropDrive nameDot) = (x, mempty)
+  -- Imagine x = "dir.with.dots/no-dots"
+  | any isPathSeparator ext = (x, mempty)
+  | otherwise = (init nameDot, extSeparator `cons` ext)
+  where
+    (nameDot, ext) = breakEnd isExtSeparator x
 
 -- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
 --
@@ -247,7 +316,7 @@ splitExtension x = case nameDot of
 -- > takeExtension x == snd (splitExtension x)
 -- > Valid x => takeExtension (addExtension x "ext") == ".ext"
 -- > Valid x => takeExtension (replaceExtension x "ext") == ".ext"
-takeExtension :: FilePath -> String
+takeExtension :: FILEPATH -> STRING
 takeExtension = snd . splitExtension
 
 -- | Remove the current extension and add another, equivalent to 'replaceExtension'.
@@ -255,7 +324,7 @@ takeExtension = snd . splitExtension
 -- > "/directory/path.txt" -<.> "ext" == "/directory/path.ext"
 -- > "/directory/path.txt" -<.> ".ext" == "/directory/path.ext"
 -- > "foo.o" -<.> "c" == "foo.c"
-(-<.>) :: FilePath -> String -> FilePath
+(-<.>) :: FILEPATH -> STRING -> FILEPATH
 (-<.>) = replaceExtension
 
 -- | Set the extension of a file, overwriting one if already present, equivalent to '-<.>'.
@@ -268,21 +337,21 @@ takeExtension = snd . splitExtension
 -- > replaceExtension "file.txt" "" == "file"
 -- > replaceExtension "file.fred.bob" "txt" == "file.fred.txt"
 -- > replaceExtension x y == addExtension (dropExtension x) y
-replaceExtension :: FilePath -> String -> FilePath
+replaceExtension :: FILEPATH -> STRING -> FILEPATH
 replaceExtension x y = dropExtension x <.> y
 
 -- | Add an extension, even if there is already one there, equivalent to 'addExtension'.
 --
 -- > "/directory/path" <.> "ext" == "/directory/path.ext"
 -- > "/directory/path" <.> ".ext" == "/directory/path.ext"
-(<.>) :: FilePath -> String -> FilePath
+(<.>) :: FILEPATH -> STRING -> FILEPATH
 (<.>) = addExtension
 
 -- | Remove last extension, and the \".\" preceding it.
 --
 -- > dropExtension "/directory/path.ext" == "/directory/path"
 -- > dropExtension x == fst (splitExtension x)
-dropExtension :: FilePath -> FilePath
+dropExtension :: FILEPATH -> FILEPATH
 dropExtension = fst . splitExtension
 
 -- | Add an extension, even if there is already one there, equivalent to '<.>'.
@@ -295,12 +364,13 @@ dropExtension = fst . splitExtension
 -- > addExtension x "" == x
 -- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"
 -- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"
-addExtension :: FilePath -> String -> FilePath
-addExtension file "" = file
-addExtension file xs@(x:_) = joinDrive a res
+addExtension :: FILEPATH -> STRING -> FILEPATH
+addExtension file xs = case uncons xs of
+  Nothing -> file
+  Just (x, _) -> joinDrive a res
     where
-        res = if isExtSeparator x then b ++ xs
-              else b ++ [extSeparator] ++ xs
+        res = if isExtSeparator x then b <> xs
+              else b <> (extSeparator `cons` xs)
 
         (a,b) = splitDrive file
 
@@ -309,7 +379,7 @@ addExtension file xs@(x:_) = joinDrive a res
 -- > hasExtension "/directory/path.ext" == True
 -- > hasExtension "/directory/path" == False
 -- > null (takeExtension x) == not (hasExtension x)
-hasExtension :: FilePath -> Bool
+hasExtension :: FILEPATH -> Bool
 hasExtension = any isExtSeparator . takeFileName
 
 
@@ -321,12 +391,14 @@ hasExtension = any isExtSeparator . takeFileName
 -- > "ar.gz" `isExtensionOf` "bar/foo.tar.gz" == False
 -- > "png" `isExtensionOf` "/directory/file.png.jpg" == False
 -- > "csv/table.csv" `isExtensionOf` "/data/csv/table.csv" == False
-isExtensionOf :: String -> FilePath -> Bool
-isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions
-isExtensionOf ext         = isSuffixOf ('.':ext) . takeExtensions
-
--- | Drop the given extension from a FilePath, and the @\".\"@ preceding it.
---   Returns 'Nothing' if the FilePath does not have the given extension, or
+isExtensionOf :: STRING -> FILEPATH -> Bool
+isExtensionOf ext = \fp -> case uncons ext of
+  Just (x, _)
+    | x == _period -> isSuffixOf ext . takeExtensions $ fp
+  _ -> isSuffixOf (_period `cons` ext) . takeExtensions $ fp
+
+-- | Drop the given extension from a FILEPATH, and the @\".\"@ preceding it.
+--   Returns 'Nothing' if the FILEPATH does not have the given extension, or
 --   'Just' and the part before the extension if it does.
 --
 --   This function can be more predictable than 'dropExtensions', especially if the filename
@@ -341,21 +413,21 @@ isExtensionOf ext         = isSuffixOf ('.':ext) . takeExtensions
 -- > stripExtension "baz"  "foo.bar"  == Nothing
 -- > stripExtension "bar"  "foobar"   == Nothing
 -- > stripExtension ""     x          == Just x
-stripExtension :: String -> FilePath -> Maybe FilePath
-stripExtension []        path = Just path
-stripExtension ext@(x:_) path = stripSuffix dotExt path
-    where dotExt = if isExtSeparator x then ext else '.':ext
+stripExtension :: STRING -> FILEPATH -> Maybe FILEPATH
+stripExtension ext path = case uncons ext of
+  Just (x, _) -> let dotExt = if isExtSeparator x then ext else _period `cons` ext
+                 in stripSuffix dotExt path
+  Nothing -> Just path
 
 
 -- | Split on all extensions.
 --
 -- > splitExtensions "/directory/path.ext" == ("/directory/path",".ext")
 -- > splitExtensions "file.tar.gz" == ("file",".tar.gz")
--- > uncurry (++) (splitExtensions x) == x
+-- > uncurry (<>) (splitExtensions x) == x
 -- > Valid x => uncurry addExtension (splitExtensions x) == x
--- > splitExtensions "file.tar.gz" == ("file",".tar.gz")
-splitExtensions :: FilePath -> (FilePath, String)
-splitExtensions x = (a ++ c, d)
+splitExtensions :: FILEPATH -> (FILEPATH, STRING)
+splitExtensions x = (a <> c, d)
     where
         (a,b) = splitFileName_ x
         (c,d) = break isExtSeparator b
@@ -366,14 +438,14 @@ splitExtensions x = (a ++ c, d)
 -- > dropExtensions "file.tar.gz" == "file"
 -- > not $ hasExtension $ dropExtensions x
 -- > not $ any isExtSeparator $ takeFileName $ dropExtensions x
-dropExtensions :: FilePath -> FilePath
+dropExtensions :: FILEPATH -> FILEPATH
 dropExtensions = fst . splitExtensions
 
 -- | Get all extensions.
 --
 -- > takeExtensions "/directory/path.ext" == ".ext"
 -- > takeExtensions "file.tar.gz" == ".tar.gz"
-takeExtensions :: FilePath -> String
+takeExtensions :: FILEPATH -> STRING
 takeExtensions = snd . splitExtensions
 
 
@@ -384,7 +456,7 @@ takeExtensions = snd . splitExtensions
 --
 -- > replaceExtensions "file.fred.bob" "txt" == "file.txt"
 -- > replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz"
-replaceExtensions :: FilePath -> String -> FilePath
+replaceExtensions :: FILEPATH -> STRING -> FILEPATH
 replaceExtensions x y = dropExtensions x <.> y
 
 
@@ -394,14 +466,14 @@ replaceExtensions x y = dropExtensions x <.> y
 
 -- | Is the given character a valid drive letter?
 -- only a-z and A-Z are letters, not isAlpha which is more unicodey
-isLetter :: Char -> Bool
+isLetter :: CHAR -> Bool
 isLetter x = isAsciiLower x || isAsciiUpper x
 
 
 -- | Split a path into a drive and a path.
 --   On Posix, \/ is a Drive.
 --
--- > uncurry (++) (splitDrive x) == x
+-- > uncurry (<>) (splitDrive x) == x
 -- > Windows: splitDrive "file" == ("","file")
 -- > Windows: splitDrive "c:/file" == ("c:/","file")
 -- > Windows: splitDrive "c:\\file" == ("c:\\","file")
@@ -415,47 +487,56 @@ isLetter x = isAsciiLower x || isAsciiUpper x
 -- > Posix:   splitDrive "//test" == ("//","test")
 -- > Posix:   splitDrive "test/file" == ("","test/file")
 -- > Posix:   splitDrive "file" == ("","file")
-splitDrive :: FilePath -> (FilePath, FilePath)
-splitDrive x | isPosix = span (== '/') x
+splitDrive :: FILEPATH -> (FILEPATH, FILEPATH)
+splitDrive x | isPosix = span (== _slash) x
 splitDrive x | Just y <- readDriveLetter x = y
 splitDrive x | Just y <- readDriveUNC x = y
 splitDrive x | Just y <- readDriveShare x = y
-splitDrive x = ("",x)
+splitDrive x = (mempty, x)
 
-addSlash :: FilePath -> FilePath -> (FilePath, FilePath)
-addSlash a xs = (a++c,d)
-    where (c,d) = span isPathSeparator xs
+addSlash :: FILEPATH -> FILEPATH -> (FILEPATH, FILEPATH)
+addSlash a xs = (a <> c, d)
+    where (c, d) = span isPathSeparator xs
 
 -- See [1].
 -- "\\?\D:\<path>" or "\\?\UNC\<server>\<share>"
-readDriveUNC :: FilePath -> Maybe (FilePath, FilePath)
-readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] =
-    case map toUpper xs of
-        ('U':'N':'C':s4:_) | isPathSeparator s4 ->
-            let (a,b) = readDriveShareName (drop 4 xs)
-            in Just (s1:s2:'?':s3:take 4 xs ++ a, b)
-        _ -> case readDriveLetter xs of
-                 -- Extended-length path.
-                 Just (a,b) -> Just (s1:s2:'?':s3:a,b)
-                 Nothing -> Nothing
-readDriveUNC _ = Nothing
+readDriveUNC :: FILEPATH -> Maybe (FILEPATH, FILEPATH)
+readDriveUNC bs = case unpack bs of
+  (s1:s2:q:s3:xs)
+    | q == _question && L.all isPathSeparator [s1,s2,s3] ->
+      case L.map toUpper xs of
+          (u:n:c:s4:_)
+            | u == _U && n == _N && c == _C && isPathSeparator s4 ->
+              let (a,b) = readDriveShareName (pack (L.drop 4 xs))
+              in Just (pack (s1:s2:_question:s3:L.take 4 xs) <> a, b)
+          _ -> case readDriveLetter (pack xs) of
+                   -- Extended-length path.
+                   Just (a,b) -> Just (pack [s1,s2,_question,s3] <> a, b)
+                   Nothing -> Nothing
+  _ -> Nothing
 
 {- c:\ -}
-readDriveLetter :: String -> Maybe (FilePath, FilePath)
-readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs)
-readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs)
-readDriveLetter _ = Nothing
+readDriveLetter :: STRING -> Maybe (FILEPATH, FILEPATH)
+readDriveLetter bs = case uncons2 bs of
+  Nothing -> Nothing
+  Just (x, c, ys)
+    | isLetter x, c == _colon -> Just $ case uncons ys of
+      Just (y, _)
+        | isPathSeparator y -> addSlash (pack [x,_colon]) ys
+      _ -> (pack [x,_colon], ys)
+    | otherwise -> Nothing
 
 {- \\sharename\ -}
-readDriveShare :: String -> Maybe (FilePath, FilePath)
-readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 =
-        Just (s1:s2:a,b)
-    where (a,b) = readDriveShareName xs
-readDriveShare _ = Nothing
+readDriveShare :: STRING -> Maybe (FILEPATH, FILEPATH)
+readDriveShare bs = case unpack bs of
+  (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 -> 
+    let (a, b) = readDriveShareName (pack xs)
+    in Just (s1 `cons` (s2 `cons` a), b)
+  _ -> Nothing
 
 {- assume you have already seen \\ -}
 {- share\bob -> "share\", "bob" -}
-readDriveShareName :: String -> (FilePath, FilePath)
+readDriveShareName :: STRING -> (FILEPATH, FILEPATH)
 readDriveShareName name = addSlash a b
     where (a,b) = break isPathSeparator name
 
@@ -468,19 +549,19 @@ readDriveShareName name = addSlash a b
 -- > Windows: joinDrive "C:\\" "bar" == "C:\\bar"
 -- > Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo"
 -- > Windows: joinDrive "/:" "foo" == "/:\\foo"
-joinDrive :: FilePath -> FilePath -> FilePath
+joinDrive :: FILEPATH -> FILEPATH -> FILEPATH
 joinDrive = combineAlways
 
 -- | Get the drive from a filepath.
 --
 -- > takeDrive x == fst (splitDrive x)
-takeDrive :: FilePath -> FilePath
+takeDrive :: FILEPATH -> FILEPATH
 takeDrive = fst . splitDrive
 
 -- | Delete the drive, if it exists.
 --
 -- > dropDrive x == snd (splitDrive x)
-dropDrive :: FilePath -> FilePath
+dropDrive :: FILEPATH -> FILEPATH
 dropDrive = snd . splitDrive
 
 -- | Does a path have a drive.
@@ -491,7 +572,7 @@ dropDrive = snd . splitDrive
 -- > Windows: hasDrive "C:foo" == True
 -- >          hasDrive "foo" == False
 -- >          hasDrive "" == False
-hasDrive :: FilePath -> Bool
+hasDrive :: FILEPATH -> Bool
 hasDrive = not . null . takeDrive
 
 
@@ -502,7 +583,7 @@ hasDrive = not . null . takeDrive
 -- > Windows: isDrive "C:\\" == True
 -- > Windows: isDrive "C:\\foo" == False
 -- >          isDrive "" == False
-isDrive :: FilePath -> Bool
+isDrive :: FILEPATH -> Bool
 isDrive x = not (null x) && null (dropDrive x)
 
 
@@ -520,28 +601,93 @@ isDrive x = not (null x) && null (dropDrive x)
 -- > splitFileName "bob" == ("./", "bob")
 -- > Posix:   splitFileName "/" == ("/","")
 -- > Windows: splitFileName "c:" == ("c:","")
-splitFileName :: FilePath -> (String, String)
-splitFileName x = (if null dir then "./" else dir, name)
-    where
-        (dir, name) = splitFileName_ x
-
--- version of splitFileName where, if the FilePath has no directory
+-- > Windows: splitFileName "\\\\?\\A:\\fred" == ("\\\\?\\A:\\","fred")
+-- > Windows: splitFileName "\\\\?\\A:" == ("\\\\?\\A:","")
+splitFileName :: FILEPATH -> (STRING, STRING)
+splitFileName x = if null path
+    then (dotSlash, file)
+    else (path, file)
+  where
+    (path, file) = splitFileName_ x
+    dotSlash = _period `cons` singleton _slash
+
+-- version of splitFileName where, if the FILEPATH has no directory
 -- component, the returned directory is "" rather than "./".  This
 -- is used in cases where we are going to combine the returned
--- directory to make a valid FilePath, and having a "./" appear would
+-- directory to make a valid FILEPATH, and having a "./" appear would
 -- look strange and upset simple equality properties.  See
 -- e.g. replaceFileName.
-splitFileName_ :: FilePath -> (String, String)
-splitFileName_ x = (drv ++ dir, file)
-    where
-        (drv,pth) = splitDrive x
-        (dir,file) = breakEnd isPathSeparator pth
+--
+-- A naive implementation is
+--
+-- splitFileName_ fp = (drv <> dir, file)
+--   where
+--     (drv, pth) = splitDrive fp
+--     (dir, file) = breakEnd isPathSeparator pth
+--
+-- but it is undesirable for two reasons:
+-- * splitDrive is very slow on Windows,
+-- * we unconditionally allocate 5 FilePath objects where only 2 would normally suffice.
+--
+-- In the implementation below we first speculatively split the input by the last path
+-- separator. In the vast majority of cases this is already the answer, except
+-- two exceptional cases explained below.
+--
+splitFileName_ :: FILEPATH -> (STRING, STRING)
+splitFileName_ fp
+  -- If dirSlash is empty, @fp@ is either a genuine filename without any dir,
+  -- or just a Windows drive name without slash like "c:".
+  -- Run readDriveLetter to figure out.
+  | isWindows
+  , null dirSlash
+  = fromMaybe (mempty, fp) (readDriveLetter fp)
+  -- Another Windows quirk is that @fp@ could have been a shared drive "\\share"
+  -- or UNC location "\\?\UNC\foo", where path separator is a part of the drive name.
+  -- We can test this by trying dropDrive and falling back to splitDrive.
+  | isWindows
+  = case uncons2 dirSlash of
+    Just (s1, s2, bs')
+      | isPathSeparator s1
+      -- If bs' is empty, then s2 as the last character of dirSlash must be a path separator,
+      -- so we are in the middle of shared drive.
+      -- Otherwise, since s1 is a path separator, we might be in the middle of UNC path.
+      , null bs' || maybe False isIncompleteUNC (readDriveUNC dirSlash)
+      -> (fp, mempty)
+      -- This handles inputs like "//?/A:" and "//?/A:foo"
+      | isPathSeparator s1
+      , isPathSeparator s2
+      , Just (s3, s4, bs'') <- uncons2 bs'
+      , s3 == _question
+      , isPathSeparator s4
+      , null bs''
+      , Just (drive, rest) <- readDriveLetter file
+      -> (dirSlash <> drive, rest)
+    _ -> (dirSlash, file)
+  | otherwise
+    = (dirSlash, file)
+  where
+    (dirSlash, file) = breakEnd isPathSeparator fp
+    dropExcessTrailingPathSeparators x
+      | hasTrailingPathSeparator x
+      , let x' = dropWhileEnd isPathSeparator x
+      , otherwise = if | null x' -> singleton (last x)
+                       | otherwise -> addTrailingPathSeparator x'
+      | otherwise = x
+
+    -- an "incomplete" UNC is one without a path (but potentially a drive)
+    isIncompleteUNC (pref, suff) = null suff && not (hasPenultimateColon pref)
+
+    -- e.g. @//?/a:/@ or @//?/a://@, but not @//?/a:@
+    hasPenultimateColon pref
+      | hasTrailingPathSeparator pref
+      = maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc . dropExcessTrailingPathSeparators $ pref
+      | otherwise = False
 
 -- | Set the filename.
 --
 -- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext"
 -- > Valid x => replaceFileName x (takeFileName x) == x
-replaceFileName :: FilePath -> String -> FilePath
+replaceFileName :: FILEPATH -> STRING -> FILEPATH
 replaceFileName x y = a </> y where (a,_) = splitFileName_ x
 
 -- | Drop the filename. Unlike 'takeDirectory', this function will leave
@@ -549,7 +695,8 @@ replaceFileName x y = a </> y where (a,_) = splitFileName_ x
 --
 -- > dropFileName "/directory/file.ext" == "/directory/"
 -- > dropFileName x == fst (splitFileName x)
-dropFileName :: FilePath -> FilePath
+-- > isPrefixOf (takeDrive x) (dropFileName x)
+dropFileName :: FILEPATH -> FILEPATH
 dropFileName = fst . splitFileName
 
 
@@ -557,12 +704,12 @@ dropFileName = fst . splitFileName
 --
 -- > takeFileName "/directory/file.ext" == "file.ext"
 -- > takeFileName "test/" == ""
--- > takeFileName x `isSuffixOf` x
+-- > isSuffixOf (takeFileName x) x
 -- > takeFileName x == snd (splitFileName x)
 -- > Valid x => takeFileName (replaceFileName x "fred") == "fred"
 -- > Valid x => takeFileName (x </> "fred") == "fred"
 -- > Valid x => isRelative (takeFileName x)
-takeFileName :: FilePath -> FilePath
+takeFileName :: FILEPATH -> FILEPATH
 takeFileName = snd . splitFileName
 
 -- | Get the base name, without an extension or path.
@@ -574,7 +721,7 @@ takeFileName = snd . splitFileName
 -- > takeBaseName "test" == "test"
 -- > takeBaseName (addTrailingPathSeparator x) == ""
 -- > takeBaseName "file/file.tar.gz" == "file.tar"
-takeBaseName :: FilePath -> String
+takeBaseName :: FILEPATH -> STRING
 takeBaseName = dropExtension . takeFileName
 
 -- | Set the base name.
@@ -584,7 +731,7 @@ takeBaseName = dropExtension . takeFileName
 -- > replaceBaseName "fred" "bill" == "bill"
 -- > replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar"
 -- > Valid x => replaceBaseName x (takeBaseName x) == x
-replaceBaseName :: FilePath -> String -> FilePath
+replaceBaseName :: FILEPATH -> STRING -> FILEPATH
 replaceBaseName pth nam = combineAlways a (nam <.> ext)
     where
         (a,b) = splitFileName_ pth
@@ -594,14 +741,14 @@ replaceBaseName pth nam = combineAlways a (nam <.> ext)
 --
 -- > hasTrailingPathSeparator "test" == False
 -- > hasTrailingPathSeparator "test/" == True
-hasTrailingPathSeparator :: FilePath -> Bool
-hasTrailingPathSeparator "" = False
-hasTrailingPathSeparator x = isPathSeparator (last x)
+hasTrailingPathSeparator :: FILEPATH -> Bool
+hasTrailingPathSeparator x
+  | null x = False
+  | otherwise = isPathSeparator $ last x
 
 
-hasLeadingPathSeparator :: FilePath -> Bool
-hasLeadingPathSeparator "" = False
-hasLeadingPathSeparator x = isPathSeparator (head x)
+hasLeadingPathSeparator :: FILEPATH -> Bool
+hasLeadingPathSeparator = maybe False (isPathSeparator . fst) . uncons
 
 
 -- | Add a trailing file path separator if one is not already present.
@@ -609,8 +756,8 @@ hasLeadingPathSeparator x = isPathSeparator (head x)
 -- > hasTrailingPathSeparator (addTrailingPathSeparator x)
 -- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x
 -- > Posix:    addTrailingPathSeparator "test/rest" == "test/rest/"
-addTrailingPathSeparator :: FilePath -> FilePath
-addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator]
+addTrailingPathSeparator :: FILEPATH -> FILEPATH
+addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x <> singleton pathSeparator
 
 
 -- | Remove any trailing path separators
@@ -619,18 +766,18 @@ addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pat
 -- >           dropTrailingPathSeparator "/" == "/"
 -- > Windows:  dropTrailingPathSeparator "\\" == "\\"
 -- > Posix:    not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
-dropTrailingPathSeparator :: FilePath -> FilePath
+dropTrailingPathSeparator :: FILEPATH -> FILEPATH
 dropTrailingPathSeparator x =
     if hasTrailingPathSeparator x && not (isDrive x)
     then let x' = dropWhileEnd isPathSeparator x
-         in if null x' then [last x] else x'
+         in if null x' then singleton (last x) else x'
     else x
 
 
 -- | Get the directory name, move up one level.
 --
 -- >           takeDirectory "/directory/other.ext" == "/directory"
--- >           takeDirectory x `isPrefixOf` x || takeDirectory x == "."
+-- >           isPrefixOf (takeDirectory x) x || takeDirectory x == "."
 -- >           takeDirectory "foo" == "."
 -- >           takeDirectory "/" == "/"
 -- >           takeDirectory "/foo" == "/"
@@ -640,30 +787,32 @@ dropTrailingPathSeparator x =
 -- > Windows:  takeDirectory "foo\\bar" == "foo"
 -- > Windows:  takeDirectory "foo\\bar\\\\" == "foo\\bar"
 -- > Windows:  takeDirectory "C:\\" == "C:\\"
-takeDirectory :: FilePath -> FilePath
+takeDirectory :: FILEPATH -> FILEPATH
 takeDirectory = dropTrailingPathSeparator . dropFileName
 
 -- | Set the directory, keeping the filename the same.
 --
 -- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext"
 -- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x
-replaceDirectory :: FilePath -> String -> FilePath
+replaceDirectory :: FILEPATH -> STRING -> FILEPATH
 replaceDirectory x dir = combineAlways dir (takeFileName x)
 
 
 -- | An alias for '</>'.
-combine :: FilePath -> FilePath -> FilePath
+combine :: FILEPATH -> FILEPATH -> FILEPATH
 combine a b | hasLeadingPathSeparator b || hasDrive b = b
             | otherwise = combineAlways a b
 
 -- | Combine two paths, assuming rhs is NOT absolute.
-combineAlways :: FilePath -> FilePath -> FilePath
+combineAlways :: FILEPATH -> FILEPATH -> FILEPATH
 combineAlways a b | null a = b
                   | null b = a
-                  | hasTrailingPathSeparator a = a ++ b
-                  | otherwise = case a of
-                      [a1,':'] | isWindows && isLetter a1 -> a ++ b
-                      _ -> a ++ [pathSeparator] ++ b
+                  | hasTrailingPathSeparator a = a <> b
+                  | otherwise = case unpack a of
+                      [a1, a2] | isWindows
+                               , isLetter a1
+                               , a2 == _colon -> a <> b
+                      _ -> a <> (pathSeparator `cons` b)
 
 
 -- | Combine two paths with a path separator.
@@ -707,7 +856,7 @@ combineAlways a b | null a = b
 --
 -- > Windows: "D:\\foo" </> "C:bar" == "C:bar"
 -- > Windows: "C:\\foo" </> "C:bar" == "C:bar"
-(</>) :: FilePath -> FilePath -> FilePath
+(</>) :: FILEPATH -> FILEPATH -> FILEPATH
 (</>) = combine
 
 
@@ -720,13 +869,14 @@ combineAlways a b | null a = b
 -- > splitPath "" == []
 -- > Windows: splitPath "c:\\test\\path" == ["c:\\","test\\","path"]
 -- > Posix:   splitPath "/file/test" == ["/","file/","test"]
-splitPath :: FilePath -> [FilePath]
-splitPath x = [drive | drive /= ""] ++ f path
+splitPath :: FILEPATH -> [FILEPATH]
+splitPath x = [drive | not (null drive)] ++ f path
     where
-        (drive,path) = splitDrive x
+        (drive, path) = splitDrive x
 
-        f "" = []
-        f y = (a++c) : f d
+        f y
+          | null y = []
+          | otherwise = (a <> c) : f d
             where
                 (a,b) = break isPathSeparator y
                 (c,d) = span  isPathSeparator b
@@ -741,20 +891,20 @@ splitPath x = [drive | drive /= ""] ++ f path
 -- >          splitDirectories "" == []
 -- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"]
 -- >          splitDirectories "/test///file" == ["/","test","file"]
-splitDirectories :: FilePath -> [FilePath]
-splitDirectories = map dropTrailingPathSeparator . splitPath
+splitDirectories :: FILEPATH -> [FILEPATH]
+splitDirectories = L.map dropTrailingPathSeparator . splitPath
 
 
 -- | Join path elements back together.
 --
--- > joinPath a == foldr (</>) "" a
+-- > joinPath z == foldr (</>) "" z
 -- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext"
 -- > Valid x => joinPath (splitPath x) == x
 -- > joinPath [] == ""
 -- > Posix: joinPath ["test","file","path"] == "test/file/path"
-joinPath :: [FilePath] -> FilePath
+joinPath :: [FILEPATH] -> FILEPATH
 -- Note that this definition on c:\\c:\\, join then split will give c:\\.
-joinPath = foldr combine ""
+joinPath = P.foldr combine mempty
 
 
 
@@ -764,7 +914,7 @@ joinPath = foldr combine ""
 ---------------------------------------------------------------------
 -- File name manipulators
 
--- | Equality of two 'FilePath's.
+-- | Equality of two 'FILEPATH's.
 --   If you call @System.Directory.canonicalizePath@
 --   first this has a much better chance of working.
 --   Note that this doesn't follow symlinks or DOSNAM~1s.
@@ -779,7 +929,7 @@ joinPath = foldr combine ""
 -- > Posix:   not (equalFilePath "foo" "FOO")
 -- > Windows: equalFilePath "foo" "FOO"
 -- > Windows: not (equalFilePath "C:" "C:/")
-equalFilePath :: FilePath -> FilePath -> Bool
+equalFilePath :: FILEPATH -> FILEPATH -> Bool
 equalFilePath a b = f a == f b
     where
         f x | isWindows = dropTrailingPathSeparator $ map toLower $ normalise x
@@ -810,26 +960,36 @@ equalFilePath a b = f a == f b
 -- > Posix:   makeRelative "/file/test" "/file/test/fred" == "fred"
 -- > Posix:   makeRelative "/file/test" "/file/test/fred/" == "fred/"
 -- > Posix:   makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
-makeRelative :: FilePath -> FilePath -> FilePath
+makeRelative :: FILEPATH -> FILEPATH -> FILEPATH
 makeRelative root path
- | equalFilePath root path = "."
- | takeAbs root /= takeAbs path = path
- | otherwise = f (dropAbs root) (dropAbs path)
-    where
-        f "" y = dropWhile isPathSeparator y
-        f x y = let (x1,x2) = g x
-                    (y1,y2) = g y
-                in if equalFilePath x1 y1 then f x2 y2 else path
-
-        g x = (dropWhile isPathSeparator a, dropWhile isPathSeparator b)
-            where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x
-
-        -- on windows, need to drop '/' which is kind of absolute, but not a drive
-        dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = tail x
-        dropAbs x = dropDrive x
-
-        takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator]
-        takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x
+  | equalFilePath root path = singleton _period
+  | takeAbs root /= takeAbs path = path
+  | otherwise = f (dropAbs root) (dropAbs path)
+  where
+    f x y
+      | null x = dropWhile isPathSeparator y
+      | otherwise = let (x1,x2) = g x
+                        (y1,y2) = g y
+                    in if equalFilePath x1 y1 then f x2 y2 else path
+    g x = (dropWhile isPathSeparator a, dropWhile isPathSeparator b)
+      where (a, b) = break isPathSeparator $ dropWhile isPathSeparator x
+
+    -- on windows, need to drop '/' which is kind of absolute, but not a drive
+    dropAbs x
+      | Just (hd, tl) <- uncons x
+      , isPathSeparator hd
+      , not (hasDrive x)
+      = tl
+      | otherwise
+      = dropDrive x
+
+    takeAbs x
+      | Just (hd, _) <- uncons x
+      , isPathSeparator hd
+      , not (hasDrive x)
+      = singleton pathSeparator
+      | otherwise
+      = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x
 
 -- | Normalise a file
 --
@@ -849,6 +1009,7 @@ makeRelative root path
 -- > Posix:   normalise "./bob/fred/" == "bob/fred/"
 -- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\"
 -- > Windows: normalise "c:\\" == "C:\\"
+-- > Windows: normalise "c:\\\\\\\\" == "C:\\"
 -- > Windows: normalise "C:.\\" == "C:"
 -- > Windows: normalise "\\\\server\\test" == "\\\\server\\test"
 -- > Windows: normalise "//server/test" == "\\\\server\\test"
@@ -863,53 +1024,74 @@ makeRelative root path
 -- > Posix:   normalise "/" == "/"
 -- > Posix:   normalise "bob/fred/." == "bob/fred/"
 -- > Posix:   normalise "//home" == "/home"
-normalise :: FilePath -> FilePath
-normalise path = result ++ [pathSeparator | addPathSeparator]
-    where
-        (drv,pth) = splitDrive path
-        result = joinDrive' (normaliseDrive drv) (f pth)
-
-        joinDrive' "" "" = "."
-        joinDrive' d p = joinDrive d p
-
-        addPathSeparator = isDirPath pth
-            && not (hasTrailingPathSeparator result)
-            && not (isRelativeDrive drv)
-
-        isDirPath xs = hasTrailingPathSeparator xs
-            || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs)
-
-        f = joinPath . dropDots . propSep . splitDirectories
-
-        propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs
-                       | otherwise = x : xs
-        propSep [] = []
-
-        dropDots = filter ("." /=)
-
-normaliseDrive :: FilePath -> FilePath
-normaliseDrive "" = ""
-normaliseDrive _ | isPosix = [pathSeparator]
-normaliseDrive drive = if isJust $ readDriveLetter x2
-                       then map toUpper x2
-                       else x2
+normalise :: FILEPATH -> FILEPATH
+normalise filepath =
+  result <>
+  (if addPathSeparator
+       then singleton pathSeparator
+       else mempty)
+  where
+    (drv,pth) = splitDrive filepath
+
+    result = joinDrive' (normaliseDrive drv) (f pth)
+
+    joinDrive' d p
+      = if null d && null p
+           then singleton _period
+           else joinDrive d p
+
+    addPathSeparator = isDirPath pth
+      && not (hasTrailingPathSeparator result)
+      && not (isRelativeDrive drv)
+
+    isDirPath xs = hasTrailingPathSeparator xs
+        || not (null xs) && last xs == _period
+           && hasTrailingPathSeparator (init xs)
+
+    f = joinPath . dropDots . propSep . splitDirectories
+
+    propSep (x:xs)
+      | all isPathSeparator x = singleton pathSeparator : xs
+      | otherwise                   = x : xs
+    propSep [] = []
+
+    dropDots = L.filter (singleton _period /=)
+
+normaliseDrive :: FILEPATH -> FILEPATH
+normaliseDrive bs
+  | null bs = mempty
+  | isPosix = pack [pathSeparator]
+  | Just (drv, _) <- readDriveLetter x2
+                  = case unpack drv of
+                      (x:_:[]) -> pack [toUpper x, _colon]
+                      (x:_) -> pack [toUpper x, _colon, pathSeparator]
+                      _ -> P.error "impossible"
+  | otherwise = x2
     where
-        x2 = map repSlash drive
-
+        x2 = map repSlash bs
         repSlash x = if isPathSeparator x then pathSeparator else x
 
 -- Information for validity functions on Windows. See [1].
-isBadCharacter :: Char -> Bool
-isBadCharacter x = x >= '\0' && x <= '\31' || x `elem` ":*?><|\""
-
-badElements :: [FilePath]
-badElements =
+isBadCHARacter :: CHAR -> Bool
+isBadCHARacter x = x >= _nul && x <= _US
+  || x `L.elem`
+      [ _less
+      , _greater
+      , _colon
+      , _quotedbl
+      , _bar
+      , _question
+      , _asterisk
+      ]
+
+badElements :: [FILEPATH]
+badElements = fmap fromString
     ["CON","PRN","AUX","NUL","CLOCK$"
     ,"COM1","COM2","COM3","COM4","COM5","COM6","COM7","COM8","COM9"
     ,"LPT1","LPT2","LPT3","LPT4","LPT5","LPT6","LPT7","LPT8","LPT9"]
 
 
--- | Is a FilePath valid, i.e. could you create a file like it? This function checks for invalid names,
+-- | Is a FILEPATH valid, i.e. could you create a file like it? This function checks for invalid names,
 --   and invalid characters, but does not check if length limits are exceeded, as these are typically
 --   filesystem dependent.
 --
@@ -929,21 +1111,22 @@ badElements =
 -- > Windows: isValid "foo\tbar" == False
 -- > Windows: isValid "nul .txt" == False
 -- > Windows: isValid " nul.txt" == True
-isValid :: FilePath -> Bool
-isValid "" = False
-isValid x | '\0' `elem` x = False
-isValid _ | isPosix = True
-isValid path =
-        not (any isBadCharacter x2) &&
-        not (any f $ splitDirectories x2) &&
-        not (isJust (readDriveShare x1) && all isPathSeparator x1) &&
-        not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1))
+isValid :: FILEPATH -> Bool
+isValid path
+  | null path = False
+  | _nul `elem` path = False
+  | isPosix = True
+  | otherwise =
+      not (any isBadCHARacter x2) &&
+      not (L.any f $ splitDirectories x2) &&
+      not (isJust (readDriveShare x1) && all isPathSeparator x1) &&
+      not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1))
     where
-        (x1,x2) = splitDrive path
-        f x = map toUpper (dropWhileEnd (== ' ') $ dropExtensions x) `elem` badElements
+      (x1,x2) = splitDrive path
+      f x = map toUpper (dropWhileEnd (== _space) $ dropExtensions x) `L.elem` badElements
 
 
--- | Take a FilePath and make it valid; does not change already valid FilePaths.
+-- | Take a FILEPATH and make it valid; does not change already valid FILEPATHs.
 --
 -- > isValid (makeValid x)
 -- > isValid x ==> makeValid x == x
@@ -959,25 +1142,26 @@ isValid path =
 -- > Windows: makeValid "\\\\\\foo" == "\\\\drive"
 -- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file"
 -- > Windows: makeValid "nul .txt" == "nul _.txt"
-makeValid :: FilePath -> FilePath
-makeValid "" = "_"
+makeValid :: FILEPATH -> FILEPATH
 makeValid path
-        | isPosix = map (\x -> if x == '\0' then '_' else x) path
-        | isJust (readDriveShare drv) && all isPathSeparator drv = take 2 drv ++ "drive"
-        | isJust (readDriveUNC drv) && not (hasTrailingPathSeparator drv) =
-            makeValid (drv ++ [pathSeparator] ++ pth)
-        | otherwise = joinDrive drv $ validElements $ validChars pth
-    where
-        (drv,pth) = splitDrive path
+  | null path = singleton _underscore
+  | isPosix = map (\x -> if x == _nul then _underscore else x) path
+  | isJust (readDriveShare drv) && all isPathSeparator drv = take 2 drv <> fromString "drive"
+  | isJust (readDriveUNC drv) && not (hasTrailingPathSeparator drv) =
+      makeValid (drv <> (pathSeparator `cons` pth))
+  | otherwise = joinDrive drv $ validElements $ validCHARs pth
 
-        validChars = map f
-        f x = if isBadCharacter x then '_' else x
+  where
+    (drv,pth) = splitDrive path
 
-        validElements x = joinPath $ map g $ splitPath x
-        g x = h a ++ b
-            where (a,b) = break isPathSeparator x
-        h x = if map toUpper (dropWhileEnd (== ' ') a) `elem` badElements then a ++ "_" <.> b else x
-            where (a,b) = splitExtensions x
+    validCHARs = map f
+    f x = if isBadCHARacter x then _underscore else x
+
+    validElements = joinPath . fmap g . splitPath
+    g x = h a <> b
+        where (a,b) = break isPathSeparator x
+    h x = if map toUpper (dropWhileEnd (== _space) a) `L.elem` badElements then snoc a _underscore  <.> b else x
+        where (a,b) = splitExtensions x
 
 
 -- | Is a path relative, or is it fixed to the root?
@@ -1002,7 +1186,7 @@ makeValid path
 -- * "A UNC name of any format [is never relative]."
 --
 -- * "You cannot use the "\\?\" prefix with a relative path."
-isRelative :: FilePath -> Bool
+isRelative :: FILEPATH -> Bool
 isRelative x = null drive || isRelativeDrive drive
     where drive = takeDrive x
 
@@ -1011,7 +1195,7 @@ isRelative x = null drive || isRelativeDrive drive
 -- From [1]: "If a file name begins with only a disk designator but not the
 -- backslash after the colon, it is interpreted as a relative path to the
 -- current directory on the drive with the specified letter."
-isRelativeDrive :: String -> Bool
+isRelativeDrive :: STRING -> Bool
 isRelativeDrive x =
     maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x)
 
@@ -1019,23 +1203,15 @@ isRelativeDrive x =
 -- | @not . 'isRelative'@
 --
 -- > isAbsolute x == not (isRelative x)
-isAbsolute :: FilePath -> Bool
+isAbsolute :: FILEPATH -> Bool
 isAbsolute = not . isRelative
 
+#ifndef OS_PATH
 
 -----------------------------------------------------------------------------
--- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2])
--- Note that Data.List.dropWhileEnd is only available in base >= 4.5.
-dropWhileEnd :: (a -> Bool) -> [a] -> [a]
-dropWhileEnd p = reverse . dropWhile p . reverse
-
--- takeWhileEnd (>2) [1,2,3,4,1,2,3,4] == [3,4])
-takeWhileEnd :: (a -> Bool) -> [a] -> [a]
-takeWhileEnd p = reverse . takeWhile p . reverse
-
 -- spanEnd (>2) [1,2,3,4,1,2,3,4] = ([1,2,3,4,1,2], [3,4])
 spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
-spanEnd p xs = (dropWhileEnd p xs, takeWhileEnd p xs)
+spanEnd p = L.foldr (\x (pref, suff) -> if null pref && p x then (pref, x : suff) else (x : pref, suff)) ([], [])
 
 -- breakEnd (< 2) [1,2,3,4,1,2,3,4] == ([1,2,3,4,1],[2,3,4])
 breakEnd :: (a -> Bool) -> [a] -> ([a], [a])
@@ -1045,4 +1221,114 @@ breakEnd p = spanEnd (not . p)
 -- Nothing if the list did not end with the suffix given, or Just the list
 -- before the suffix, if it does.
 stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
-stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys)
+stripSuffix xs ys = reverse P.<$> stripPrefix (reverse xs) (reverse ys)
+
+cons :: a -> [a] -> [a]
+cons = (:)
+
+unsnoc :: [a] -> Maybe ([a], a)
+unsnoc = L.foldr (\x -> Just . maybe ([], x) (first (x :))) Nothing
+
+uncons2 :: [a] -> Maybe (a, a, [a])
+uncons2 [] = Nothing
+uncons2 [_] = Nothing
+uncons2 (x : y : zs) = Just (x, y, zs)
+
+_period, _quotedbl, _backslash, _slash, _question, _U, _N, _C, _colon, _semicolon, _US, _less, _greater, _bar, _asterisk, _nul, _space, _underscore :: Char
+_period = '.'
+_quotedbl = '"'
+_slash = '/'
+_backslash = '\\'
+_question = '?'
+_colon = ':'
+_semicolon = ';'
+_U = 'U'
+_N = 'N'
+_C = 'C'
+_US = '\US'
+_less = '<'
+_greater = '>'
+_bar = '|'
+_asterisk = '*'
+_nul = '\NUL'
+_space = ' '
+_underscore = '_'
+
+singleton :: Char -> String
+singleton c = [c]
+
+pack :: String -> String
+pack = id
+
+
+unpack :: String -> String
+unpack = id
+
+
+snoc :: String -> Char -> String
+{- HLINT ignore "Redundant lambda" -}
+snoc str = \c -> str <> [c]
+
+#else
+#ifdef WINDOWS
+fromString :: P.String -> STRING
+fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do
+  r <- try @SomeException $ GHC.withCStringLen (mkUTF16le ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr
+  evaluate $ force $ first displayException r
+#else
+fromString :: P.String -> STRING
+fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do
+  r <- try @SomeException $ GHC.withCStringLen (mkUTF8 ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr
+  evaluate $ force $ first displayException r
+#endif
+
+_a, _z, _A, _Z, _period, _quotedbl, _backslash, _slash, _question, _U, _N, _C, _colon, _semicolon, _US, _less, _greater, _bar, _asterisk, _nul, _space, _underscore :: CHAR
+_a = 0x61
+_z = 0x7a
+_A = 0x41
+_Z = 0x5a
+_period = 0x2e
+_quotedbl = 0x22
+_slash = 0x2f
+_backslash = 0x5c
+_question = 0x3f
+_colon = 0x3a
+_semicolon = 0x3b
+_U = 0x55
+_N = 0x4e
+_C = 0x43
+_US = 0x1f
+_less = 0x3c
+_greater = 0x3e
+_bar = 0x7c
+_asterisk = 0x2a
+_nul = 0x00
+_space = 0x20
+_underscore = 0x5f
+
+isAsciiUpper :: CHAR -> Bool
+isAsciiUpper w = _A <= w && w <= _Z
+
+isAsciiLower :: CHAR -> Bool
+isAsciiLower w = _a <= w && w <= _z
+
+----------------------------------------------------------------
+
+toUpper :: CHAR -> CHAR
+-- charToWord16 should be safe here, since C.toUpper doesn't go beyond Word16 maxbound
+toUpper = charToWord . C.toUpper . wordToChar
+
+toLower :: CHAR -> CHAR
+-- charToWord16 should be safe here, since C.toLower doesn't go beyond Word16 maxbound
+toLower = charToWord . C.toLower . wordToChar
+
+
+-- | Total conversion to char.
+wordToChar :: CHAR -> Char
+wordToChar = C.chr . fromIntegral
+
+-- | This is unsafe and clamps at Word16 maxbound.
+charToWord :: Char -> CHAR
+charToWord = fromIntegral . C.ord
+
+#endif

System/FilePath/Posix.hs

+{-# LANGUAGE CPP #-}
 
+#undef WINDOWS
+#define IS_WINDOWS False
+#define MODULE_NAME Posix
 
-
-{-# LANGUAGE PatternGuards #-}
-
--- This template expects CPP definitions for:
---     MODULE_NAME = Posix | Windows
---     IS_WINDOWS  = False | True
-
--- |
--- Module      :  System.FilePath.MODULE_NAME
--- Copyright   :  (c) Neil Mitchell 2005-2014
--- License     :  BSD3
---
--- Maintainer  :  ndmitchell@gmail.com
--- Stability   :  stable
--- Portability :  portable
---
--- A library for 'FilePath' manipulations, using MODULE_NAME style paths on
--- all platforms. Importing "System.FilePath" is usually better.
---
--- Given the example 'FilePath': @\/directory\/file.ext@
---
--- We can use the following functions to extract pieces.
---
--- * 'takeFileName' gives @\"file.ext\"@
---
--- * 'takeDirectory' gives @\"\/directory\"@
---
--- * 'takeExtension' gives @\".ext\"@
---
--- * 'dropExtension' gives @\"\/directory\/file\"@
---
--- * 'takeBaseName' gives @\"file\"@
---
--- And we could have built an equivalent path with the following expressions:
---
--- * @\"\/directory\" '</>' \"file.ext\"@.
---
--- * @\"\/directory\/file" '<.>' \"ext\"@.
---
--- * @\"\/directory\/file.txt" '-<.>' \"ext\"@.
---
--- Each function in this module is documented with several examples,
--- which are also used as tests.
---
--- Here are a few examples of using the @filepath@ functions together:
---
--- /Example 1:/ Find the possible locations of a Haskell module @Test@ imported from module @Main@:
---
--- @['replaceFileName' path_to_main \"Test\" '<.>' ext | ext <- [\"hs\",\"lhs\"] ]@
---
--- /Example 2:/ Download a file from @url@ and save it to disk:
---
--- @do let file = 'makeValid' url
---   System.Directory.createDirectoryIfMissing True ('takeDirectory' file)@
---
--- /Example 3:/ Compile a Haskell file, putting the @.hi@ file under @interface@:
---
--- @'takeDirectory' file '</>' \"interface\" '</>' ('takeFileName' file '-<.>' \"hi\")@
---
--- References:
--- [1] <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx Naming Files, Paths and Namespaces> (Microsoft MSDN)
-module System.FilePath.Posix
-    (
-    -- * Separator predicates
-    FilePath,
-    pathSeparator, pathSeparators, isPathSeparator,
-    searchPathSeparator, isSearchPathSeparator,
-    extSeparator, isExtSeparator,
-
-    -- * @$PATH@ methods
-    splitSearchPath, getSearchPath,
-
-    -- * Extension functions
-    splitExtension,
-    takeExtension, replaceExtension, (-<.>), dropExtension, addExtension, hasExtension, (<.>),
-    splitExtensions, dropExtensions, takeExtensions, replaceExtensions, isExtensionOf,
-    stripExtension,
-
-    -- * Filename\/directory functions
-    splitFileName,
-    takeFileName, replaceFileName, dropFileName,
-    takeBaseName, replaceBaseName,
-    takeDirectory, replaceDirectory,
-    combine, (</>),
-    splitPath, joinPath, splitDirectories,
-
-    -- * Drive functions
-    splitDrive, joinDrive,
-    takeDrive, hasDrive, dropDrive, isDrive,
-
-    -- * Trailing slash functions
-    hasTrailingPathSeparator,
-    addTrailingPathSeparator,
-    dropTrailingPathSeparator,
-
-    -- * File name manipulations
-    normalise, equalFilePath,
-    makeRelative,
-    isRelative, isAbsolute,
-    isValid, makeValid
-    )
-    where
-
-import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
-import Data.Maybe(isJust)
-import Data.List(stripPrefix, isSuffixOf)
-
-import System.Environment(getEnv)
-
-
-infixr 7  <.>, -<.>
-infixr 5  </>
-
-
-
-
-
----------------------------------------------------------------------
--- Platform Abstraction Methods (private)
-
--- | Is the operating system Unix or Linux like
-isPosix :: Bool
-isPosix = not isWindows
-
--- | Is the operating system Windows like
-isWindows :: Bool
-isWindows = False
-
-
----------------------------------------------------------------------
--- The basic functions
-
--- | The character that separates directories. In the case where more than
---   one character is possible, 'pathSeparator' is the \'ideal\' one.
---
--- > Windows: pathSeparator == '\\'
--- > Posix:   pathSeparator ==  '/'
--- > isPathSeparator pathSeparator
-pathSeparator :: Char
-pathSeparator = if isWindows then '\\' else '/'
-
--- | The list of all possible separators.
---
--- > Windows: pathSeparators == ['\\', '/']
--- > Posix:   pathSeparators == ['/']
--- > pathSeparator `elem` pathSeparators
-pathSeparators :: [Char]
-pathSeparators = if isWindows then "\\/" else "/"
-
--- | Rather than using @(== 'pathSeparator')@, use this. Test if something
---   is a path separator.
---
--- > isPathSeparator a == (a `elem` pathSeparators)
-isPathSeparator :: Char -> Bool
-isPathSeparator '/' = True
-isPathSeparator '\\' = isWindows
-isPathSeparator _ = False
-
-
--- | The character that is used to separate the entries in the $PATH environment variable.
---
--- > Windows: searchPathSeparator == ';'
--- > Posix:   searchPathSeparator == ':'
-searchPathSeparator :: Char
-searchPathSeparator = if isWindows then ';' else ':'
-
--- | Is the character a file separator?
---
--- > isSearchPathSeparator a == (a == searchPathSeparator)
-isSearchPathSeparator :: Char -> Bool
-isSearchPathSeparator = (== searchPathSeparator)
-
-
--- | File extension character
---
--- > extSeparator == '.'
-extSeparator :: Char
-extSeparator = '.'
-
--- | Is the character an extension character?
---
--- > isExtSeparator a == (a == extSeparator)
-isExtSeparator :: Char -> Bool
-isExtSeparator = (== extSeparator)
-
-
----------------------------------------------------------------------
--- Path methods (environment $PATH)
-
--- | Take a string, split it on the 'searchPathSeparator' character.
---   Blank items are ignored on Windows, and converted to @.@ on Posix.
---   On Windows path elements are stripped of quotes.
---
---   Follows the recommendations in
---   <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>
---
--- > Posix:   splitSearchPath "File1:File2:File3"  == ["File1","File2","File3"]
--- > Posix:   splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]
--- > Windows: splitSearchPath "File1;File2;File3"  == ["File1","File2","File3"]
--- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]
--- > Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"]
-splitSearchPath :: String -> [FilePath]
-splitSearchPath = f
-    where
-    f xs = case break isSearchPathSeparator xs of
-           (pre, []    ) -> g pre
-           (pre, _:post) -> g pre ++ f post
-
-    g "" = ["." | isPosix]
-    g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x]
-    g x = [x]
-
-
--- | Get a list of 'FilePath's in the $PATH variable.
-getSearchPath :: IO [FilePath]
-getSearchPath = fmap splitSearchPath (getEnv "PATH")
-
-
----------------------------------------------------------------------
--- Extension methods
-
--- | Split on the extension. 'addExtension' is the inverse.
---
--- > splitExtension "/directory/path.ext" == ("/directory/path",".ext")
--- > uncurry (++) (splitExtension x) == x
--- > Valid x => uncurry addExtension (splitExtension x) == x
--- > splitExtension "file.txt" == ("file",".txt")
--- > splitExtension "file" == ("file","")
--- > splitExtension "file/file.txt" == ("file/file",".txt")
--- > splitExtension "file.txt/boris" == ("file.txt/boris","")
--- > splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")
--- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")
--- > splitExtension "file/path.txt/" == ("file/path.txt/","")
-splitExtension :: FilePath -> (String, String)
-splitExtension x = case nameDot of
-                       "" -> (x,"")
-                       _ -> (dir ++ init nameDot, extSeparator : ext)
-    where
-        (dir,file) = splitFileName_ x
-        (nameDot,ext) = breakEnd isExtSeparator file
-
--- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
---
--- > takeExtension "/directory/path.ext" == ".ext"
--- > takeExtension x == snd (splitExtension x)
--- > Valid x => takeExtension (addExtension x "ext") == ".ext"
--- > Valid x => takeExtension (replaceExtension x "ext") == ".ext"
-takeExtension :: FilePath -> String
-takeExtension = snd . splitExtension
-
--- | Remove the current extension and add another, equivalent to 'replaceExtension'.
---
--- > "/directory/path.txt" -<.> "ext" == "/directory/path.ext"
--- > "/directory/path.txt" -<.> ".ext" == "/directory/path.ext"
--- > "foo.o" -<.> "c" == "foo.c"
-(-<.>) :: FilePath -> String -> FilePath
-(-<.>) = replaceExtension
-
--- | Set the extension of a file, overwriting one if already present, equivalent to '-<.>'.
---
--- > replaceExtension "/directory/path.txt" "ext" == "/directory/path.ext"
--- > replaceExtension "/directory/path.txt" ".ext" == "/directory/path.ext"
--- > replaceExtension "file.txt" ".bob" == "file.bob"
--- > replaceExtension "file.txt" "bob" == "file.bob"
--- > replaceExtension "file" ".bob" == "file.bob"
--- > replaceExtension "file.txt" "" == "file"
--- > replaceExtension "file.fred.bob" "txt" == "file.fred.txt"
--- > replaceExtension x y == addExtension (dropExtension x) y
-replaceExtension :: FilePath -> String -> FilePath
-replaceExtension x y = dropExtension x <.> y
-
--- | Add an extension, even if there is already one there, equivalent to 'addExtension'.
---
--- > "/directory/path" <.> "ext" == "/directory/path.ext"
--- > "/directory/path" <.> ".ext" == "/directory/path.ext"
-(<.>) :: FilePath -> String -> FilePath
-(<.>) = addExtension
-
--- | Remove last extension, and the \".\" preceding it.
---
--- > dropExtension "/directory/path.ext" == "/directory/path"
--- > dropExtension x == fst (splitExtension x)
-dropExtension :: FilePath -> FilePath
-dropExtension = fst . splitExtension
-
--- | Add an extension, even if there is already one there, equivalent to '<.>'.
---
--- > addExtension "/directory/path" "ext" == "/directory/path.ext"
--- > addExtension "file.txt" "bib" == "file.txt.bib"
--- > addExtension "file." ".bib" == "file..bib"
--- > addExtension "file" ".bib" == "file.bib"
--- > addExtension "/" "x" == "/.x"
--- > addExtension x "" == x
--- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"
--- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"
-addExtension :: FilePath -> String -> FilePath
-addExtension file "" = file
-addExtension file xs@(x:_) = joinDrive a res
-    where
-        res = if isExtSeparator x then b ++ xs
-              else b ++ [extSeparator] ++ xs
-
-        (a,b) = splitDrive file
-
--- | Does the given filename have an extension?
---
--- > hasExtension "/directory/path.ext" == True
--- > hasExtension "/directory/path" == False
--- > null (takeExtension x) == not (hasExtension x)
-hasExtension :: FilePath -> Bool
-hasExtension = any isExtSeparator . takeFileName
-
-
--- | Does the given filename have the specified extension?
---
--- > "png" `isExtensionOf` "/directory/file.png" == True
--- > ".png" `isExtensionOf` "/directory/file.png" == True
--- > ".tar.gz" `isExtensionOf` "bar/foo.tar.gz" == True
--- > "ar.gz" `isExtensionOf` "bar/foo.tar.gz" == False
--- > "png" `isExtensionOf` "/directory/file.png.jpg" == False
--- > "csv/table.csv" `isExtensionOf` "/data/csv/table.csv" == False
-isExtensionOf :: String -> FilePath -> Bool
-isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions
-isExtensionOf ext         = isSuffixOf ('.':ext) . takeExtensions
-
--- | Drop the given extension from a FilePath, and the @\".\"@ preceding it.
---   Returns 'Nothing' if the FilePath does not have the given extension, or
---   'Just' and the part before the extension if it does.
---
---   This function can be more predictable than 'dropExtensions', especially if the filename
---   might itself contain @.@ characters.
---
--- > stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x"
--- > stripExtension "hi.o" "foo.x.hs.o" == Nothing
--- > dropExtension x == fromJust (stripExtension (takeExtension x) x)
--- > dropExtensions x == fromJust (stripExtension (takeExtensions x) x)
--- > stripExtension ".c.d" "a.b.c.d"  == Just "a.b"
--- > stripExtension ".c.d" "a.b..c.d" == Just "a.b."
--- > stripExtension "baz"  "foo.bar"  == Nothing
--- > stripExtension "bar"  "foobar"   == Nothing
--- > stripExtension ""     x          == Just x
-stripExtension :: String -> FilePath -> Maybe FilePath
-stripExtension []        path = Just path
-stripExtension ext@(x:_) path = stripSuffix dotExt path
-    where dotExt = if isExtSeparator x then ext else '.':ext
-
-
--- | Split on all extensions.
---
--- > splitExtensions "/directory/path.ext" == ("/directory/path",".ext")
--- > splitExtensions "file.tar.gz" == ("file",".tar.gz")
--- > uncurry (++) (splitExtensions x) == x
--- > Valid x => uncurry addExtension (splitExtensions x) == x
--- > splitExtensions "file.tar.gz" == ("file",".tar.gz")
-splitExtensions :: FilePath -> (FilePath, String)
-splitExtensions x = (a ++ c, d)
-    where
-        (a,b) = splitFileName_ x
-        (c,d) = break isExtSeparator b
-
--- | Drop all extensions.
---
--- > dropExtensions "/directory/path.ext" == "/directory/path"
--- > dropExtensions "file.tar.gz" == "file"
--- > not $ hasExtension $ dropExtensions x
--- > not $ any isExtSeparator $ takeFileName $ dropExtensions x
-dropExtensions :: FilePath -> FilePath
-dropExtensions = fst . splitExtensions
-
--- | Get all extensions.
---
--- > takeExtensions "/directory/path.ext" == ".ext"
--- > takeExtensions "file.tar.gz" == ".tar.gz"
-takeExtensions :: FilePath -> String
-takeExtensions = snd . splitExtensions
-
-
--- | Replace all extensions of a file with a new extension. Note
---   that 'replaceExtension' and 'addExtension' both work for adding
---   multiple extensions, so only required when you need to drop
---   all extensions first.
---
--- > replaceExtensions "file.fred.bob" "txt" == "file.txt"
--- > replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz"
-replaceExtensions :: FilePath -> String -> FilePath
-replaceExtensions x y = dropExtensions x <.> y
-
-
-
----------------------------------------------------------------------
--- Drive methods
-
--- | Is the given character a valid drive letter?
--- only a-z and A-Z are letters, not isAlpha which is more unicodey
-isLetter :: Char -> Bool
-isLetter x = isAsciiLower x || isAsciiUpper x
-
-
--- | Split a path into a drive and a path.
---   On Posix, \/ is a Drive.
---
--- > uncurry (++) (splitDrive x) == x
--- > Windows: splitDrive "file" == ("","file")
--- > Windows: splitDrive "c:/file" == ("c:/","file")
--- > Windows: splitDrive "c:\\file" == ("c:\\","file")
--- > Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test")
--- > Windows: splitDrive "\\\\shared" == ("\\\\shared","")
--- > Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file")
--- > Windows: splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file")
--- > Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file")
--- > Windows: splitDrive "/d" == ("","/d")
--- > Posix:   splitDrive "/test" == ("/","test")
--- > Posix:   splitDrive "//test" == ("//","test")
--- > Posix:   splitDrive "test/file" == ("","test/file")
--- > Posix:   splitDrive "file" == ("","file")
-splitDrive :: FilePath -> (FilePath, FilePath)
-splitDrive x | isPosix = span (== '/') x
-splitDrive x | Just y <- readDriveLetter x = y
-splitDrive x | Just y <- readDriveUNC x = y
-splitDrive x | Just y <- readDriveShare x = y
-splitDrive x = ("",x)
-
-addSlash :: FilePath -> FilePath -> (FilePath, FilePath)
-addSlash a xs = (a++c,d)
-    where (c,d) = span isPathSeparator xs
-
--- See [1].
--- "\\?\D:\<path>" or "\\?\UNC\<server>\<share>"
-readDriveUNC :: FilePath -> Maybe (FilePath, FilePath)
-readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] =
-    case map toUpper xs of
-        ('U':'N':'C':s4:_) | isPathSeparator s4 ->
-            let (a,b) = readDriveShareName (drop 4 xs)
-            in Just (s1:s2:'?':s3:take 4 xs ++ a, b)
-        _ -> case readDriveLetter xs of
-                 -- Extended-length path.
-                 Just (a,b) -> Just (s1:s2:'?':s3:a,b)
-                 Nothing -> Nothing
-readDriveUNC _ = Nothing
-
-{- c:\ -}
-readDriveLetter :: String -> Maybe (FilePath, FilePath)
-readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs)
-readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs)
-readDriveLetter _ = Nothing
-
-{- \\sharename\ -}
-readDriveShare :: String -> Maybe (FilePath, FilePath)
-readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 =
-        Just (s1:s2:a,b)
-    where (a,b) = readDriveShareName xs
-readDriveShare _ = Nothing
-
-{- assume you have already seen \\ -}
-{- share\bob -> "share\", "bob" -}
-readDriveShareName :: String -> (FilePath, FilePath)
-readDriveShareName name = addSlash a b
-    where (a,b) = break isPathSeparator name
-
-
-
--- | Join a drive and the rest of the path.
---
--- > Valid x => uncurry joinDrive (splitDrive x) == x
--- > Windows: joinDrive "C:" "foo" == "C:foo"
--- > Windows: joinDrive "C:\\" "bar" == "C:\\bar"
--- > Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo"
--- > Windows: joinDrive "/:" "foo" == "/:\\foo"
-joinDrive :: FilePath -> FilePath -> FilePath
-joinDrive = combineAlways
-
--- | Get the drive from a filepath.
---
--- > takeDrive x == fst (splitDrive x)
-takeDrive :: FilePath -> FilePath
-takeDrive = fst . splitDrive
-
--- | Delete the drive, if it exists.
---
--- > dropDrive x == snd (splitDrive x)
-dropDrive :: FilePath -> FilePath
-dropDrive = snd . splitDrive
-
--- | Does a path have a drive.
---
--- > not (hasDrive x) == null (takeDrive x)
--- > Posix:   hasDrive "/foo" == True
--- > Windows: hasDrive "C:\\foo" == True
--- > Windows: hasDrive "C:foo" == True
--- >          hasDrive "foo" == False
--- >          hasDrive "" == False
-hasDrive :: FilePath -> Bool
-hasDrive = not . null . takeDrive
-
-
--- | Is an element a drive
---
--- > Posix:   isDrive "/" == True
--- > Posix:   isDrive "/foo" == False
--- > Windows: isDrive "C:\\" == True
--- > Windows: isDrive "C:\\foo" == False
--- >          isDrive "" == False
-isDrive :: FilePath -> Bool
-isDrive x = not (null x) && null (dropDrive x)
-
-
----------------------------------------------------------------------
--- Operations on a filepath, as a list of directories
-
--- | Split a filename into directory and file. '</>' is the inverse.
---   The first component will often end with a trailing slash.
---
--- > splitFileName "/directory/file.ext" == ("/directory/","file.ext")
--- > Valid x => uncurry (</>) (splitFileName x) == x || fst (splitFileName x) == "./"
--- > Valid x => isValid (fst (splitFileName x))
--- > splitFileName "file/bob.txt" == ("file/", "bob.txt")
--- > splitFileName "file/" == ("file/", "")
--- > splitFileName "bob" == ("./", "bob")
--- > Posix:   splitFileName "/" == ("/","")
--- > Windows: splitFileName "c:" == ("c:","")
-splitFileName :: FilePath -> (String, String)
-splitFileName x = (if null dir then "./" else dir, name)
-    where
-        (dir, name) = splitFileName_ x
-
--- version of splitFileName where, if the FilePath has no directory
--- component, the returned directory is "" rather than "./".  This
--- is used in cases where we are going to combine the returned
--- directory to make a valid FilePath, and having a "./" appear would
--- look strange and upset simple equality properties.  See
--- e.g. replaceFileName.
-splitFileName_ :: FilePath -> (String, String)
-splitFileName_ x = (drv ++ dir, file)
-    where
-        (drv,pth) = splitDrive x
-        (dir,file) = breakEnd isPathSeparator pth
-
--- | Set the filename.
---
--- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext"
--- > Valid x => replaceFileName x (takeFileName x) == x
-replaceFileName :: FilePath -> String -> FilePath
-replaceFileName x y = a </> y where (a,_) = splitFileName_ x
-
--- | Drop the filename. Unlike 'takeDirectory', this function will leave
---   a trailing path separator on the directory.
---
--- > dropFileName "/directory/file.ext" == "/directory/"
--- > dropFileName x == fst (splitFileName x)
-dropFileName :: FilePath -> FilePath
-dropFileName = fst . splitFileName
-
-
--- | Get the file name.
---
--- > takeFileName "/directory/file.ext" == "file.ext"
--- > takeFileName "test/" == ""
--- > takeFileName x `isSuffixOf` x
--- > takeFileName x == snd (splitFileName x)
--- > Valid x => takeFileName (replaceFileName x "fred") == "fred"
--- > Valid x => takeFileName (x </> "fred") == "fred"
--- > Valid x => isRelative (takeFileName x)
-takeFileName :: FilePath -> FilePath
-takeFileName = snd . splitFileName
-
--- | Get the base name, without an extension or path.
---
--- > takeBaseName "/directory/file.ext" == "file"
--- > takeBaseName "file/test.txt" == "test"
--- > takeBaseName "dave.ext" == "dave"
--- > takeBaseName "" == ""
--- > takeBaseName "test" == "test"
--- > takeBaseName (addTrailingPathSeparator x) == ""
--- > takeBaseName "file/file.tar.gz" == "file.tar"
-takeBaseName :: FilePath -> String
-takeBaseName = dropExtension . takeFileName
-
--- | Set the base name.
---
--- > replaceBaseName "/directory/other.ext" "file" == "/directory/file.ext"
--- > replaceBaseName "file/test.txt" "bob" == "file/bob.txt"
--- > replaceBaseName "fred" "bill" == "bill"
--- > replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar"
--- > Valid x => replaceBaseName x (takeBaseName x) == x
-replaceBaseName :: FilePath -> String -> FilePath
-replaceBaseName pth nam = combineAlways a (nam <.> ext)
-    where
-        (a,b) = splitFileName_ pth
-        ext = takeExtension b
-
--- | Is an item either a directory or the last character a path separator?
---
--- > hasTrailingPathSeparator "test" == False
--- > hasTrailingPathSeparator "test/" == True
-hasTrailingPathSeparator :: FilePath -> Bool
-hasTrailingPathSeparator "" = False
-hasTrailingPathSeparator x = isPathSeparator (last x)
-
-
-hasLeadingPathSeparator :: FilePath -> Bool
-hasLeadingPathSeparator "" = False
-hasLeadingPathSeparator x = isPathSeparator (head x)
-
-
--- | Add a trailing file path separator if one is not already present.
---
--- > hasTrailingPathSeparator (addTrailingPathSeparator x)
--- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x
--- > Posix:    addTrailingPathSeparator "test/rest" == "test/rest/"
-addTrailingPathSeparator :: FilePath -> FilePath
-addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator]
-
-
--- | Remove any trailing path separators
---
--- > dropTrailingPathSeparator "file/test/" == "file/test"
--- >           dropTrailingPathSeparator "/" == "/"
--- > Windows:  dropTrailingPathSeparator "\\" == "\\"
--- > Posix:    not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
-dropTrailingPathSeparator :: FilePath -> FilePath
-dropTrailingPathSeparator x =
-    if hasTrailingPathSeparator x && not (isDrive x)
-    then let x' = dropWhileEnd isPathSeparator x
-         in if null x' then [last x] else x'
-    else x
-
-
--- | Get the directory name, move up one level.
---
--- >           takeDirectory "/directory/other.ext" == "/directory"
--- >           takeDirectory x `isPrefixOf` x || takeDirectory x == "."
--- >           takeDirectory "foo" == "."
--- >           takeDirectory "/" == "/"
--- >           takeDirectory "/foo" == "/"
--- >           takeDirectory "/foo/bar/baz" == "/foo/bar"
--- >           takeDirectory "/foo/bar/baz/" == "/foo/bar/baz"
--- >           takeDirectory "foo/bar/baz" == "foo/bar"
--- > Windows:  takeDirectory "foo\\bar" == "foo"
--- > Windows:  takeDirectory "foo\\bar\\\\" == "foo\\bar"
--- > Windows:  takeDirectory "C:\\" == "C:\\"
-takeDirectory :: FilePath -> FilePath
-takeDirectory = dropTrailingPathSeparator . dropFileName
-
--- | Set the directory, keeping the filename the same.
---
--- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext"
--- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x
-replaceDirectory :: FilePath -> String -> FilePath
-replaceDirectory x dir = combineAlways dir (takeFileName x)
-
-
--- | An alias for '</>'.
-combine :: FilePath -> FilePath -> FilePath
-combine a b | hasLeadingPathSeparator b || hasDrive b = b
-            | otherwise = combineAlways a b
-
--- | Combine two paths, assuming rhs is NOT absolute.
-combineAlways :: FilePath -> FilePath -> FilePath
-combineAlways a b | null a = b
-                  | null b = a
-                  | hasTrailingPathSeparator a = a ++ b
-                  | otherwise = case a of
-                      [a1,':'] | isWindows && isLetter a1 -> a ++ b
-                      _ -> a ++ [pathSeparator] ++ b
-
-
--- | Combine two paths with a path separator.
---   If the second path starts with a path separator or a drive letter, then it returns the second.
---   The intention is that @readFile (dir '</>' file)@ will access the same file as
---   @setCurrentDirectory dir; readFile file@.
---
--- > Posix:   "/directory" </> "file.ext" == "/directory/file.ext"
--- > Windows: "/directory" </> "file.ext" == "/directory\\file.ext"
--- >          "directory" </> "/file.ext" == "/file.ext"
--- > Valid x => (takeDirectory x </> takeFileName x) `equalFilePath` x
---
---   Combined:
---
--- > Posix:   "/" </> "test" == "/test"
--- > Posix:   "home" </> "bob" == "home/bob"
--- > Posix:   "x:" </> "foo" == "x:/foo"
--- > Windows: "C:\\foo" </> "bar" == "C:\\foo\\bar"
--- > Windows: "home" </> "bob" == "home\\bob"
---
---   Not combined:
---
--- > Posix:   "home" </> "/bob" == "/bob"
--- > Windows: "home" </> "C:\\bob" == "C:\\bob"
---
---   Not combined (tricky):
---
---   On Windows, if a filepath starts with a single slash, it is relative to the
---   root of the current drive. In [1], this is (confusingly) referred to as an
---   absolute path.
---   The current behavior of '</>' is to never combine these forms.
---
--- > Windows: "home" </> "/bob" == "/bob"
--- > Windows: "home" </> "\\bob" == "\\bob"
--- > Windows: "C:\\home" </> "\\bob" == "\\bob"
---
---   On Windows, from [1]: "If a file name begins with only a disk designator
---   but not the backslash after the colon, it is interpreted as a relative path
---   to the current directory on the drive with the specified letter."
---   The current behavior of '</>' is to never combine these forms.
---
--- > Windows: "D:\\foo" </> "C:bar" == "C:bar"
--- > Windows: "C:\\foo" </> "C:bar" == "C:bar"
-(</>) :: FilePath -> FilePath -> FilePath
-(</>) = combine
-
-
--- | Split a path by the directory separator.
---
--- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"]
--- > concat (splitPath x) == x
--- > splitPath "test//item/" == ["test//","item/"]
--- > splitPath "test/item/file" == ["test/","item/","file"]
--- > splitPath "" == []
--- > Windows: splitPath "c:\\test\\path" == ["c:\\","test\\","path"]
--- > Posix:   splitPath "/file/test" == ["/","file/","test"]
-splitPath :: FilePath -> [FilePath]
-splitPath x = [drive | drive /= ""] ++ f path
-    where
-        (drive,path) = splitDrive x
-
-        f "" = []
-        f y = (a++c) : f d
-            where
-                (a,b) = break isPathSeparator y
-                (c,d) = span  isPathSeparator b
-
--- | Just as 'splitPath', but don't add the trailing slashes to each element.
---
--- >          splitDirectories "/directory/file.ext" == ["/","directory","file.ext"]
--- >          splitDirectories "test/file" == ["test","file"]
--- >          splitDirectories "/test/file" == ["/","test","file"]
--- > Windows: splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"]
--- >          Valid x => joinPath (splitDirectories x) `equalFilePath` x
--- >          splitDirectories "" == []
--- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"]
--- >          splitDirectories "/test///file" == ["/","test","file"]
-splitDirectories :: FilePath -> [FilePath]
-splitDirectories = map dropTrailingPathSeparator . splitPath
-
-
--- | Join path elements back together.
---
--- > joinPath a == foldr (</>) "" a
--- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext"
--- > Valid x => joinPath (splitPath x) == x
--- > joinPath [] == ""
--- > Posix: joinPath ["test","file","path"] == "test/file/path"
-joinPath :: [FilePath] -> FilePath
--- Note that this definition on c:\\c:\\, join then split will give c:\\.
-joinPath = foldr combine ""
-
-
-
-
-
-
----------------------------------------------------------------------
--- File name manipulators
-
--- | Equality of two 'FilePath's.
---   If you call @System.Directory.canonicalizePath@
---   first this has a much better chance of working.
---   Note that this doesn't follow symlinks or DOSNAM~1s.
---
--- Similar to 'normalise', this does not expand @".."@, because of symlinks.
---
--- >          x == y ==> equalFilePath x y
--- >          normalise x == normalise y ==> equalFilePath x y
--- >          equalFilePath "foo" "foo/"
--- >          not (equalFilePath "/a/../c" "/c")
--- >          not (equalFilePath "foo" "/foo")
--- > Posix:   not (equalFilePath "foo" "FOO")
--- > Windows: equalFilePath "foo" "FOO"
--- > Windows: not (equalFilePath "C:" "C:/")
-equalFilePath :: FilePath -> FilePath -> Bool
-equalFilePath a b = f a == f b
-    where
-        f x | isWindows = dropTrailingPathSeparator $ map toLower $ normalise x
-            | otherwise = dropTrailingPathSeparator $ normalise x
-
-
--- | Contract a filename, based on a relative path. Note that the resulting path
---   will never introduce @..@ paths, as the presence of symlinks means @..\/b@
---   may not reach @a\/b@ if it starts from @a\/c@. For a worked example see
---   <http://neilmitchell.blogspot.co.uk/2015/10/filepaths-are-subtle-symlinks-are-hard.html this blog post>.
---
---   The corresponding @makeAbsolute@ function can be found in
---   @System.Directory@.
---
--- >          makeRelative "/directory" "/directory/file.ext" == "file.ext"
--- >          Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x
--- >          makeRelative x x == "."
--- >          Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x
--- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob"
--- > Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob"
--- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob"
--- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob"
--- > Windows: makeRelative "/Home" "/home/bob" == "bob"
--- > Windows: makeRelative "/" "//" == "//"
--- > Posix:   makeRelative "/Home" "/home/bob" == "/home/bob"
--- > Posix:   makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"
--- > Posix:   makeRelative "/fred" "bob" == "bob"
--- > Posix:   makeRelative "/file/test" "/file/test/fred" == "fred"
--- > Posix:   makeRelative "/file/test" "/file/test/fred/" == "fred/"
--- > Posix:   makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
-makeRelative :: FilePath -> FilePath -> FilePath
-makeRelative root path
- | equalFilePath root path = "."
- | takeAbs root /= takeAbs path = path
- | otherwise = f (dropAbs root) (dropAbs path)
-    where
-        f "" y = dropWhile isPathSeparator y
-        f x y = let (x1,x2) = g x
-                    (y1,y2) = g y
-                in if equalFilePath x1 y1 then f x2 y2 else path
-
-        g x = (dropWhile isPathSeparator a, dropWhile isPathSeparator b)
-            where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x
-
-        -- on windows, need to drop '/' which is kind of absolute, but not a drive
-        dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = tail x
-        dropAbs x = dropDrive x
-
-        takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator]
-        takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x
-
--- | Normalise a file
---
--- * \/\/ outside of the drive can be made blank
---
--- * \/ -> 'pathSeparator'
---
--- * .\/ -> \"\"
---
--- Does not remove @".."@, because of symlinks.
---
--- > Posix:   normalise "/file/\\test////" == "/file/\\test/"
--- > Posix:   normalise "/file/./test" == "/file/test"
--- > Posix:   normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/"
--- > Posix:   normalise "../bob/fred/" == "../bob/fred/"
--- > Posix:   normalise "/a/../c" == "/a/../c"
--- > Posix:   normalise "./bob/fred/" == "bob/fred/"
--- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\"
--- > Windows: normalise "c:\\" == "C:\\"
--- > Windows: normalise "C:.\\" == "C:"
--- > Windows: normalise "\\\\server\\test" == "\\\\server\\test"
--- > Windows: normalise "//server/test" == "\\\\server\\test"
--- > Windows: normalise "c:/file" == "C:\\file"
--- > Windows: normalise "/file" == "\\file"
--- > Windows: normalise "\\" == "\\"
--- > Windows: normalise "/./" == "\\"
--- >          normalise "." == "."
--- > Posix:   normalise "./" == "./"
--- > Posix:   normalise "./." == "./"
--- > Posix:   normalise "/./" == "/"
--- > Posix:   normalise "/" == "/"
--- > Posix:   normalise "bob/fred/." == "bob/fred/"
--- > Posix:   normalise "//home" == "/home"
-normalise :: FilePath -> FilePath
-normalise path = result ++ [pathSeparator | addPathSeparator]
-    where
-        (drv,pth) = splitDrive path
-        result = joinDrive' (normaliseDrive drv) (f pth)
-
-        joinDrive' "" "" = "."
-        joinDrive' d p = joinDrive d p
-
-        addPathSeparator = isDirPath pth
-            && not (hasTrailingPathSeparator result)
-            && not (isRelativeDrive drv)
-
-        isDirPath xs = hasTrailingPathSeparator xs
-            || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs)
-
-        f = joinPath . dropDots . propSep . splitDirectories
-
-        propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs
-                       | otherwise = x : xs
-        propSep [] = []
-
-        dropDots = filter ("." /=)
-
-normaliseDrive :: FilePath -> FilePath
-normaliseDrive "" = ""
-normaliseDrive _ | isPosix = [pathSeparator]
-normaliseDrive drive = if isJust $ readDriveLetter x2
-                       then map toUpper x2
-                       else x2
-    where
-        x2 = map repSlash drive
-
-        repSlash x = if isPathSeparator x then pathSeparator else x
-
--- Information for validity functions on Windows. See [1].
-isBadCharacter :: Char -> Bool
-isBadCharacter x = x >= '\0' && x <= '\31' || x `elem` ":*?><|\""
-
-badElements :: [FilePath]
-badElements =
-    ["CON","PRN","AUX","NUL","CLOCK$"
-    ,"COM1","COM2","COM3","COM4","COM5","COM6","COM7","COM8","COM9"
-    ,"LPT1","LPT2","LPT3","LPT4","LPT5","LPT6","LPT7","LPT8","LPT9"]
-
-
--- | Is a FilePath valid, i.e. could you create a file like it? This function checks for invalid names,
---   and invalid characters, but does not check if length limits are exceeded, as these are typically
---   filesystem dependent.
---
--- >          isValid "" == False
--- >          isValid "\0" == False
--- > Posix:   isValid "/random_ path:*" == True
--- > Posix:   isValid x == not (null x)
--- > Windows: isValid "c:\\test" == True
--- > Windows: isValid "c:\\test:of_test" == False
--- > Windows: isValid "test*" == False
--- > Windows: isValid "c:\\test\\nul" == False
--- > Windows: isValid "c:\\test\\prn.txt" == False
--- > Windows: isValid "c:\\nul\\file" == False
--- > Windows: isValid "\\\\" == False
--- > Windows: isValid "\\\\\\foo" == False
--- > Windows: isValid "\\\\?\\D:file" == False
--- > Windows: isValid "foo\tbar" == False
--- > Windows: isValid "nul .txt" == False
--- > Windows: isValid " nul.txt" == True
-isValid :: FilePath -> Bool
-isValid "" = False
-isValid x | '\0' `elem` x = False
-isValid _ | isPosix = True
-isValid path =
-        not (any isBadCharacter x2) &&
-        not (any f $ splitDirectories x2) &&
-        not (isJust (readDriveShare x1) && all isPathSeparator x1) &&
-        not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1))
-    where
-        (x1,x2) = splitDrive path
-        f x = map toUpper (dropWhileEnd (== ' ') $ dropExtensions x) `elem` badElements
-
-
--- | Take a FilePath and make it valid; does not change already valid FilePaths.
---
--- > isValid (makeValid x)
--- > isValid x ==> makeValid x == x
--- > makeValid "" == "_"
--- > makeValid "file\0name" == "file_name"
--- > Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid"
--- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test"
--- > Windows: makeValid "test*" == "test_"
--- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_"
--- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt"
--- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"
--- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file"
--- > Windows: makeValid "\\\\\\foo" == "\\\\drive"
--- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file"
--- > Windows: makeValid "nul .txt" == "nul _.txt"
-makeValid :: FilePath -> FilePath
-makeValid "" = "_"
-makeValid path
-        | isPosix = map (\x -> if x == '\0' then '_' else x) path
-        | isJust (readDriveShare drv) && all isPathSeparator drv = take 2 drv ++ "drive"
-        | isJust (readDriveUNC drv) && not (hasTrailingPathSeparator drv) =
-            makeValid (drv ++ [pathSeparator] ++ pth)
-        | otherwise = joinDrive drv $ validElements $ validChars pth
-    where
-        (drv,pth) = splitDrive path
-
-        validChars = map f
-        f x = if isBadCharacter x then '_' else x
-
-        validElements x = joinPath $ map g $ splitPath x
-        g x = h a ++ b
-            where (a,b) = break isPathSeparator x
-        h x = if map toUpper (dropWhileEnd (== ' ') a) `elem` badElements then a ++ "_" <.> b else x
-            where (a,b) = splitExtensions x
-
-
--- | Is a path relative, or is it fixed to the root?
---
--- > Windows: isRelative "path\\test" == True
--- > Windows: isRelative "c:\\test" == False
--- > Windows: isRelative "c:test" == True
--- > Windows: isRelative "c:\\" == False
--- > Windows: isRelative "c:/" == False
--- > Windows: isRelative "c:" == True
--- > Windows: isRelative "\\\\foo" == False
--- > Windows: isRelative "\\\\?\\foo" == False
--- > Windows: isRelative "\\\\?\\UNC\\foo" == False
--- > Windows: isRelative "/foo" == True
--- > Windows: isRelative "\\foo" == True
--- > Posix:   isRelative "test/path" == True
--- > Posix:   isRelative "/test" == False
--- > Posix:   isRelative "/" == False
---
--- According to [1]:
---
--- * "A UNC name of any format [is never relative]."
---
--- * "You cannot use the "\\?\" prefix with a relative path."
-isRelative :: FilePath -> Bool
-isRelative x = null drive || isRelativeDrive drive
-    where drive = takeDrive x
-
-
-{- c:foo -}
--- From [1]: "If a file name begins with only a disk designator but not the
--- backslash after the colon, it is interpreted as a relative path to the
--- current directory on the drive with the specified letter."
-isRelativeDrive :: String -> Bool
-isRelativeDrive x =
-    maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x)
-
-
--- | @not . 'isRelative'@
---
--- > isAbsolute x == not (isRelative x)
-isAbsolute :: FilePath -> Bool
-isAbsolute = not . isRelative
-
-
------------------------------------------------------------------------------
--- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2])
--- Note that Data.List.dropWhileEnd is only available in base >= 4.5.
-dropWhileEnd :: (a -> Bool) -> [a] -> [a]
-dropWhileEnd p = reverse . dropWhile p . reverse
-
--- takeWhileEnd (>2) [1,2,3,4,1,2,3,4] == [3,4])
-takeWhileEnd :: (a -> Bool) -> [a] -> [a]
-takeWhileEnd p = reverse . takeWhile p . reverse
-
--- spanEnd (>2) [1,2,3,4,1,2,3,4] = ([1,2,3,4,1,2], [3,4])
-spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
-spanEnd p xs = (dropWhileEnd p xs, takeWhileEnd p xs)
-
--- breakEnd (< 2) [1,2,3,4,1,2,3,4] == ([1,2,3,4,1],[2,3,4])
-breakEnd :: (a -> Bool) -> [a] -> ([a], [a])
-breakEnd p = spanEnd (not . p)
-
--- | The stripSuffix function drops the given suffix from a list. It returns
--- Nothing if the list did not end with the suffix given, or Just the list
--- before the suffix, if it does.
-stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
-stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys)
+#include "Internal.hs"

System/FilePath/Windows.hs

+{-# LANGUAGE CPP #-}
 
+#undef POSIX
+#define WINDOWS
+#define IS_WINDOWS True
+#define MODULE_NAME Windows
 
-
-{-# LANGUAGE PatternGuards #-}
-
--- This template expects CPP definitions for:
---     MODULE_NAME = Posix | Windows
---     IS_WINDOWS  = False | True
-
--- |
--- Module      :  System.FilePath.MODULE_NAME
--- Copyright   :  (c) Neil Mitchell 2005-2014
--- License     :  BSD3
---
--- Maintainer  :  ndmitchell@gmail.com
--- Stability   :  stable
--- Portability :  portable
---
--- A library for 'FilePath' manipulations, using MODULE_NAME style paths on
--- all platforms. Importing "System.FilePath" is usually better.
---
--- Given the example 'FilePath': @\/directory\/file.ext@
---
--- We can use the following functions to extract pieces.
---
--- * 'takeFileName' gives @\"file.ext\"@
---
--- * 'takeDirectory' gives @\"\/directory\"@
---
--- * 'takeExtension' gives @\".ext\"@
---
--- * 'dropExtension' gives @\"\/directory\/file\"@
---
--- * 'takeBaseName' gives @\"file\"@
---
--- And we could have built an equivalent path with the following expressions:
---
--- * @\"\/directory\" '</>' \"file.ext\"@.
---
--- * @\"\/directory\/file" '<.>' \"ext\"@.
---
--- * @\"\/directory\/file.txt" '-<.>' \"ext\"@.
---
--- Each function in this module is documented with several examples,
--- which are also used as tests.
---
--- Here are a few examples of using the @filepath@ functions together:
---
--- /Example 1:/ Find the possible locations of a Haskell module @Test@ imported from module @Main@:
---
--- @['replaceFileName' path_to_main \"Test\" '<.>' ext | ext <- [\"hs\",\"lhs\"] ]@
---
--- /Example 2:/ Download a file from @url@ and save it to disk:
---
--- @do let file = 'makeValid' url
---   System.Directory.createDirectoryIfMissing True ('takeDirectory' file)@
---
--- /Example 3:/ Compile a Haskell file, putting the @.hi@ file under @interface@:
---
--- @'takeDirectory' file '</>' \"interface\" '</>' ('takeFileName' file '-<.>' \"hi\")@
---
--- References:
--- [1] <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx Naming Files, Paths and Namespaces> (Microsoft MSDN)
-module System.FilePath.Windows
-    (
-    -- * Separator predicates
-    FilePath,
-    pathSeparator, pathSeparators, isPathSeparator,
-    searchPathSeparator, isSearchPathSeparator,
-    extSeparator, isExtSeparator,
-
-    -- * @$PATH@ methods
-    splitSearchPath, getSearchPath,
-
-    -- * Extension functions
-    splitExtension,
-    takeExtension, replaceExtension, (-<.>), dropExtension, addExtension, hasExtension, (<.>),
-    splitExtensions, dropExtensions, takeExtensions, replaceExtensions, isExtensionOf,
-    stripExtension,
-
-    -- * Filename\/directory functions
-    splitFileName,
-    takeFileName, replaceFileName, dropFileName,
-    takeBaseName, replaceBaseName,
-    takeDirectory, replaceDirectory,
-    combine, (</>),
-    splitPath, joinPath, splitDirectories,
-
-    -- * Drive functions
-    splitDrive, joinDrive,
-    takeDrive, hasDrive, dropDrive, isDrive,
-
-    -- * Trailing slash functions
-    hasTrailingPathSeparator,
-    addTrailingPathSeparator,
-    dropTrailingPathSeparator,
-
-    -- * File name manipulations
-    normalise, equalFilePath,
-    makeRelative,
-    isRelative, isAbsolute,
-    isValid, makeValid
-    )
-    where
-
-import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
-import Data.Maybe(isJust)
-import Data.List(stripPrefix, isSuffixOf)
-
-import System.Environment(getEnv)
-
-
-infixr 7  <.>, -<.>
-infixr 5  </>
-
-
-
-
-
----------------------------------------------------------------------
--- Platform Abstraction Methods (private)
-
--- | Is the operating system Unix or Linux like
-isPosix :: Bool
-isPosix = not isWindows
-
--- | Is the operating system Windows like
-isWindows :: Bool
-isWindows = True
-
-
----------------------------------------------------------------------
--- The basic functions
-
--- | The character that separates directories. In the case where more than
---   one character is possible, 'pathSeparator' is the \'ideal\' one.
---
--- > Windows: pathSeparator == '\\'
--- > Posix:   pathSeparator ==  '/'
--- > isPathSeparator pathSeparator
-pathSeparator :: Char
-pathSeparator = if isWindows then '\\' else '/'
-
--- | The list of all possible separators.
---
--- > Windows: pathSeparators == ['\\', '/']
--- > Posix:   pathSeparators == ['/']
--- > pathSeparator `elem` pathSeparators
-pathSeparators :: [Char]
-pathSeparators = if isWindows then "\\/" else "/"
-
--- | Rather than using @(== 'pathSeparator')@, use this. Test if something
---   is a path separator.
---
--- > isPathSeparator a == (a `elem` pathSeparators)
-isPathSeparator :: Char -> Bool
-isPathSeparator '/' = True
-isPathSeparator '\\' = isWindows
-isPathSeparator _ = False
-
-
--- | The character that is used to separate the entries in the $PATH environment variable.
---
--- > Windows: searchPathSeparator == ';'
--- > Posix:   searchPathSeparator == ':'
-searchPathSeparator :: Char
-searchPathSeparator = if isWindows then ';' else ':'
-
--- | Is the character a file separator?
---
--- > isSearchPathSeparator a == (a == searchPathSeparator)
-isSearchPathSeparator :: Char -> Bool
-isSearchPathSeparator = (== searchPathSeparator)
-
-
--- | File extension character
---
--- > extSeparator == '.'
-extSeparator :: Char
-extSeparator = '.'
-
--- | Is the character an extension character?
---
--- > isExtSeparator a == (a == extSeparator)
-isExtSeparator :: Char -> Bool
-isExtSeparator = (== extSeparator)
-
-
----------------------------------------------------------------------
--- Path methods (environment $PATH)
-
--- | Take a string, split it on the 'searchPathSeparator' character.
---   Blank items are ignored on Windows, and converted to @.@ on Posix.
---   On Windows path elements are stripped of quotes.
---
---   Follows the recommendations in
---   <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>
---
--- > Posix:   splitSearchPath "File1:File2:File3"  == ["File1","File2","File3"]
--- > Posix:   splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]
--- > Windows: splitSearchPath "File1;File2;File3"  == ["File1","File2","File3"]
--- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]
--- > Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"]
-splitSearchPath :: String -> [FilePath]
-splitSearchPath = f
-    where
-    f xs = case break isSearchPathSeparator xs of
-           (pre, []    ) -> g pre
-           (pre, _:post) -> g pre ++ f post
-
-    g "" = ["." | isPosix]
-    g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x]
-    g x = [x]
-
-
--- | Get a list of 'FilePath's in the $PATH variable.
-getSearchPath :: IO [FilePath]
-getSearchPath = fmap splitSearchPath (getEnv "PATH")
-
-
----------------------------------------------------------------------
--- Extension methods
-
--- | Split on the extension. 'addExtension' is the inverse.
---
--- > splitExtension "/directory/path.ext" == ("/directory/path",".ext")
--- > uncurry (++) (splitExtension x) == x
--- > Valid x => uncurry addExtension (splitExtension x) == x
--- > splitExtension "file.txt" == ("file",".txt")
--- > splitExtension "file" == ("file","")
--- > splitExtension "file/file.txt" == ("file/file",".txt")
--- > splitExtension "file.txt/boris" == ("file.txt/boris","")
--- > splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")
--- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")
--- > splitExtension "file/path.txt/" == ("file/path.txt/","")
-splitExtension :: FilePath -> (String, String)
-splitExtension x = case nameDot of
-                       "" -> (x,"")
-                       _ -> (dir ++ init nameDot, extSeparator : ext)
-    where
-        (dir,file) = splitFileName_ x
-        (nameDot,ext) = breakEnd isExtSeparator file
-
--- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
---
--- > takeExtension "/directory/path.ext" == ".ext"
--- > takeExtension x == snd (splitExtension x)
--- > Valid x => takeExtension (addExtension x "ext") == ".ext"
--- > Valid x => takeExtension (replaceExtension x "ext") == ".ext"
-takeExtension :: FilePath -> String
-takeExtension = snd . splitExtension
-
--- | Remove the current extension and add another, equivalent to 'replaceExtension'.
---
--- > "/directory/path.txt" -<.> "ext" == "/directory/path.ext"
--- > "/directory/path.txt" -<.> ".ext" == "/directory/path.ext"
--- > "foo.o" -<.> "c" == "foo.c"
-(-<.>) :: FilePath -> String -> FilePath
-(-<.>) = replaceExtension
-
--- | Set the extension of a file, overwriting one if already present, equivalent to '-<.>'.
---
--- > replaceExtension "/directory/path.txt" "ext" == "/directory/path.ext"
--- > replaceExtension "/directory/path.txt" ".ext" == "/directory/path.ext"
--- > replaceExtension "file.txt" ".bob" == "file.bob"
--- > replaceExtension "file.txt" "bob" == "file.bob"
--- > replaceExtension "file" ".bob" == "file.bob"
--- > replaceExtension "file.txt" "" == "file"
--- > replaceExtension "file.fred.bob" "txt" == "file.fred.txt"
--- > replaceExtension x y == addExtension (dropExtension x) y
-replaceExtension :: FilePath -> String -> FilePath
-replaceExtension x y = dropExtension x <.> y
-
--- | Add an extension, even if there is already one there, equivalent to 'addExtension'.
---
--- > "/directory/path" <.> "ext" == "/directory/path.ext"
--- > "/directory/path" <.> ".ext" == "/directory/path.ext"
-(<.>) :: FilePath -> String -> FilePath
-(<.>) = addExtension
-
--- | Remove last extension, and the \".\" preceding it.
---
--- > dropExtension "/directory/path.ext" == "/directory/path"
--- > dropExtension x == fst (splitExtension x)
-dropExtension :: FilePath -> FilePath
-dropExtension = fst . splitExtension
-
--- | Add an extension, even if there is already one there, equivalent to '<.>'.
---
--- > addExtension "/directory/path" "ext" == "/directory/path.ext"
--- > addExtension "file.txt" "bib" == "file.txt.bib"
--- > addExtension "file." ".bib" == "file..bib"
--- > addExtension "file" ".bib" == "file.bib"
--- > addExtension "/" "x" == "/.x"
--- > addExtension x "" == x
--- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"
--- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"
-addExtension :: FilePath -> String -> FilePath
-addExtension file "" = file
-addExtension file xs@(x:_) = joinDrive a res
-    where
-        res = if isExtSeparator x then b ++ xs
-              else b ++ [extSeparator] ++ xs
-
-        (a,b) = splitDrive file
-
--- | Does the given filename have an extension?
---
--- > hasExtension "/directory/path.ext" == True
--- > hasExtension "/directory/path" == False
--- > null (takeExtension x) == not (hasExtension x)
-hasExtension :: FilePath -> Bool
-hasExtension = any isExtSeparator . takeFileName
-
-
--- | Does the given filename have the specified extension?
---
--- > "png" `isExtensionOf` "/directory/file.png" == True
--- > ".png" `isExtensionOf` "/directory/file.png" == True
--- > ".tar.gz" `isExtensionOf` "bar/foo.tar.gz" == True
--- > "ar.gz" `isExtensionOf` "bar/foo.tar.gz" == False
--- > "png" `isExtensionOf` "/directory/file.png.jpg" == False
--- > "csv/table.csv" `isExtensionOf` "/data/csv/table.csv" == False
-isExtensionOf :: String -> FilePath -> Bool
-isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions
-isExtensionOf ext         = isSuffixOf ('.':ext) . takeExtensions
-
--- | Drop the given extension from a FilePath, and the @\".\"@ preceding it.
---   Returns 'Nothing' if the FilePath does not have the given extension, or
---   'Just' and the part before the extension if it does.
---
---   This function can be more predictable than 'dropExtensions', especially if the filename
---   might itself contain @.@ characters.
---
--- > stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x"
--- > stripExtension "hi.o" "foo.x.hs.o" == Nothing
--- > dropExtension x == fromJust (stripExtension (takeExtension x) x)
--- > dropExtensions x == fromJust (stripExtension (takeExtensions x) x)
--- > stripExtension ".c.d" "a.b.c.d"  == Just "a.b"
--- > stripExtension ".c.d" "a.b..c.d" == Just "a.b."
--- > stripExtension "baz"  "foo.bar"  == Nothing
--- > stripExtension "bar"  "foobar"   == Nothing
--- > stripExtension ""     x          == Just x
-stripExtension :: String -> FilePath -> Maybe FilePath
-stripExtension []        path = Just path
-stripExtension ext@(x:_) path = stripSuffix dotExt path
-    where dotExt = if isExtSeparator x then ext else '.':ext
-
-
--- | Split on all extensions.
---
--- > splitExtensions "/directory/path.ext" == ("/directory/path",".ext")
--- > splitExtensions "file.tar.gz" == ("file",".tar.gz")
--- > uncurry (++) (splitExtensions x) == x
--- > Valid x => uncurry addExtension (splitExtensions x) == x
--- > splitExtensions "file.tar.gz" == ("file",".tar.gz")
-splitExtensions :: FilePath -> (FilePath, String)
-splitExtensions x = (a ++ c, d)
-    where
-        (a,b) = splitFileName_ x
-        (c,d) = break isExtSeparator b
-
--- | Drop all extensions.
---
--- > dropExtensions "/directory/path.ext" == "/directory/path"
--- > dropExtensions "file.tar.gz" == "file"
--- > not $ hasExtension $ dropExtensions x
--- > not $ any isExtSeparator $ takeFileName $ dropExtensions x
-dropExtensions :: FilePath -> FilePath
-dropExtensions = fst . splitExtensions
-
--- | Get all extensions.
---
--- > takeExtensions "/directory/path.ext" == ".ext"
--- > takeExtensions "file.tar.gz" == ".tar.gz"
-takeExtensions :: FilePath -> String
-takeExtensions = snd . splitExtensions
-
-
--- | Replace all extensions of a file with a new extension. Note
---   that 'replaceExtension' and 'addExtension' both work for adding
---   multiple extensions, so only required when you need to drop
---   all extensions first.
---
--- > replaceExtensions "file.fred.bob" "txt" == "file.txt"
--- > replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz"
-replaceExtensions :: FilePath -> String -> FilePath
-replaceExtensions x y = dropExtensions x <.> y
-
-
-
----------------------------------------------------------------------
--- Drive methods
-
--- | Is the given character a valid drive letter?
--- only a-z and A-Z are letters, not isAlpha which is more unicodey
-isLetter :: Char -> Bool
-isLetter x = isAsciiLower x || isAsciiUpper x
-
-
--- | Split a path into a drive and a path.
---   On Posix, \/ is a Drive.
---
--- > uncurry (++) (splitDrive x) == x
--- > Windows: splitDrive "file" == ("","file")
--- > Windows: splitDrive "c:/file" == ("c:/","file")
--- > Windows: splitDrive "c:\\file" == ("c:\\","file")
--- > Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test")
--- > Windows: splitDrive "\\\\shared" == ("\\\\shared","")
--- > Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file")
--- > Windows: splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file")
--- > Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file")
--- > Windows: splitDrive "/d" == ("","/d")
--- > Posix:   splitDrive "/test" == ("/","test")
--- > Posix:   splitDrive "//test" == ("//","test")
--- > Posix:   splitDrive "test/file" == ("","test/file")
--- > Posix:   splitDrive "file" == ("","file")
-splitDrive :: FilePath -> (FilePath, FilePath)
-splitDrive x | isPosix = span (== '/') x
-splitDrive x | Just y <- readDriveLetter x = y
-splitDrive x | Just y <- readDriveUNC x = y
-splitDrive x | Just y <- readDriveShare x = y
-splitDrive x = ("",x)
-
-addSlash :: FilePath -> FilePath -> (FilePath, FilePath)
-addSlash a xs = (a++c,d)
-    where (c,d) = span isPathSeparator xs
-
--- See [1].
--- "\\?\D:\<path>" or "\\?\UNC\<server>\<share>"
-readDriveUNC :: FilePath -> Maybe (FilePath, FilePath)
-readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] =
-    case map toUpper xs of
-        ('U':'N':'C':s4:_) | isPathSeparator s4 ->
-            let (a,b) = readDriveShareName (drop 4 xs)
-            in Just (s1:s2:'?':s3:take 4 xs ++ a, b)
-        _ -> case readDriveLetter xs of
-                 -- Extended-length path.
-                 Just (a,b) -> Just (s1:s2:'?':s3:a,b)
-                 Nothing -> Nothing
-readDriveUNC _ = Nothing
-
-{- c:\ -}
-readDriveLetter :: String -> Maybe (FilePath, FilePath)
-readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs)
-readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs)
-readDriveLetter _ = Nothing
-
-{- \\sharename\ -}
-readDriveShare :: String -> Maybe (FilePath, FilePath)
-readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 =
-        Just (s1:s2:a,b)
-    where (a,b) = readDriveShareName xs
-readDriveShare _ = Nothing
-
-{- assume you have already seen \\ -}
-{- share\bob -> "share\", "bob" -}
-readDriveShareName :: String -> (FilePath, FilePath)
-readDriveShareName name = addSlash a b
-    where (a,b) = break isPathSeparator name
-
-
-
--- | Join a drive and the rest of the path.
---
--- > Valid x => uncurry joinDrive (splitDrive x) == x
--- > Windows: joinDrive "C:" "foo" == "C:foo"
--- > Windows: joinDrive "C:\\" "bar" == "C:\\bar"
--- > Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo"
--- > Windows: joinDrive "/:" "foo" == "/:\\foo"
-joinDrive :: FilePath -> FilePath -> FilePath
-joinDrive = combineAlways
-
--- | Get the drive from a filepath.
---
--- > takeDrive x == fst (splitDrive x)
-takeDrive :: FilePath -> FilePath
-takeDrive = fst . splitDrive
-
--- | Delete the drive, if it exists.
---
--- > dropDrive x == snd (splitDrive x)
-dropDrive :: FilePath -> FilePath
-dropDrive = snd . splitDrive
-
--- | Does a path have a drive.
---
--- > not (hasDrive x) == null (takeDrive x)
--- > Posix:   hasDrive "/foo" == True
--- > Windows: hasDrive "C:\\foo" == True
--- > Windows: hasDrive "C:foo" == True
--- >          hasDrive "foo" == False
--- >          hasDrive "" == False
-hasDrive :: FilePath -> Bool
-hasDrive = not . null . takeDrive
-
-
--- | Is an element a drive
---
--- > Posix:   isDrive "/" == True
--- > Posix:   isDrive "/foo" == False
--- > Windows: isDrive "C:\\" == True
--- > Windows: isDrive "C:\\foo" == False
--- >          isDrive "" == False
-isDrive :: FilePath -> Bool
-isDrive x = not (null x) && null (dropDrive x)
-
-
----------------------------------------------------------------------
--- Operations on a filepath, as a list of directories
-
--- | Split a filename into directory and file. '</>' is the inverse.
---   The first component will often end with a trailing slash.
---
--- > splitFileName "/directory/file.ext" == ("/directory/","file.ext")
--- > Valid x => uncurry (</>) (splitFileName x) == x || fst (splitFileName x) == "./"
--- > Valid x => isValid (fst (splitFileName x))
--- > splitFileName "file/bob.txt" == ("file/", "bob.txt")
--- > splitFileName "file/" == ("file/", "")
--- > splitFileName "bob" == ("./", "bob")
--- > Posix:   splitFileName "/" == ("/","")
--- > Windows: splitFileName "c:" == ("c:","")
-splitFileName :: FilePath -> (String, String)
-splitFileName x = (if null dir then "./" else dir, name)
-    where
-        (dir, name) = splitFileName_ x
-
--- version of splitFileName where, if the FilePath has no directory
--- component, the returned directory is "" rather than "./".  This
--- is used in cases where we are going to combine the returned
--- directory to make a valid FilePath, and having a "./" appear would
--- look strange and upset simple equality properties.  See
--- e.g. replaceFileName.
-splitFileName_ :: FilePath -> (String, String)
-splitFileName_ x = (drv ++ dir, file)
-    where
-        (drv,pth) = splitDrive x
-        (dir,file) = breakEnd isPathSeparator pth
-
--- | Set the filename.
---
--- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext"
--- > Valid x => replaceFileName x (takeFileName x) == x
-replaceFileName :: FilePath -> String -> FilePath
-replaceFileName x y = a </> y where (a,_) = splitFileName_ x
-
--- | Drop the filename. Unlike 'takeDirectory', this function will leave
---   a trailing path separator on the directory.
---
--- > dropFileName "/directory/file.ext" == "/directory/"
--- > dropFileName x == fst (splitFileName x)
-dropFileName :: FilePath -> FilePath
-dropFileName = fst . splitFileName
-
-
--- | Get the file name.
---
--- > takeFileName "/directory/file.ext" == "file.ext"
--- > takeFileName "test/" == ""
--- > takeFileName x `isSuffixOf` x
--- > takeFileName x == snd (splitFileName x)
--- > Valid x => takeFileName (replaceFileName x "fred") == "fred"
--- > Valid x => takeFileName (x </> "fred") == "fred"
--- > Valid x => isRelative (takeFileName x)
-takeFileName :: FilePath -> FilePath
-takeFileName = snd . splitFileName
-
--- | Get the base name, without an extension or path.
---
--- > takeBaseName "/directory/file.ext" == "file"
--- > takeBaseName "file/test.txt" == "test"
--- > takeBaseName "dave.ext" == "dave"
--- > takeBaseName "" == ""
--- > takeBaseName "test" == "test"
--- > takeBaseName (addTrailingPathSeparator x) == ""
--- > takeBaseName "file/file.tar.gz" == "file.tar"
-takeBaseName :: FilePath -> String
-takeBaseName = dropExtension . takeFileName
-
--- | Set the base name.
---
--- > replaceBaseName "/directory/other.ext" "file" == "/directory/file.ext"
--- > replaceBaseName "file/test.txt" "bob" == "file/bob.txt"
--- > replaceBaseName "fred" "bill" == "bill"
--- > replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar"
--- > Valid x => replaceBaseName x (takeBaseName x) == x
-replaceBaseName :: FilePath -> String -> FilePath
-replaceBaseName pth nam = combineAlways a (nam <.> ext)
-    where
-        (a,b) = splitFileName_ pth
-        ext = takeExtension b
-
--- | Is an item either a directory or the last character a path separator?
---
--- > hasTrailingPathSeparator "test" == False
--- > hasTrailingPathSeparator "test/" == True
-hasTrailingPathSeparator :: FilePath -> Bool
-hasTrailingPathSeparator "" = False
-hasTrailingPathSeparator x = isPathSeparator (last x)
-
-
-hasLeadingPathSeparator :: FilePath -> Bool
-hasLeadingPathSeparator "" = False
-hasLeadingPathSeparator x = isPathSeparator (head x)
-
-
--- | Add a trailing file path separator if one is not already present.
---
--- > hasTrailingPathSeparator (addTrailingPathSeparator x)
--- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x
--- > Posix:    addTrailingPathSeparator "test/rest" == "test/rest/"
-addTrailingPathSeparator :: FilePath -> FilePath
-addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator]
-
-
--- | Remove any trailing path separators
---
--- > dropTrailingPathSeparator "file/test/" == "file/test"
--- >           dropTrailingPathSeparator "/" == "/"
--- > Windows:  dropTrailingPathSeparator "\\" == "\\"
--- > Posix:    not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
-dropTrailingPathSeparator :: FilePath -> FilePath
-dropTrailingPathSeparator x =
-    if hasTrailingPathSeparator x && not (isDrive x)
-    then let x' = dropWhileEnd isPathSeparator x
-         in if null x' then [last x] else x'
-    else x
-
-
--- | Get the directory name, move up one level.
---
--- >           takeDirectory "/directory/other.ext" == "/directory"
--- >           takeDirectory x `isPrefixOf` x || takeDirectory x == "."
--- >           takeDirectory "foo" == "."
--- >           takeDirectory "/" == "/"
--- >           takeDirectory "/foo" == "/"
--- >           takeDirectory "/foo/bar/baz" == "/foo/bar"
--- >           takeDirectory "/foo/bar/baz/" == "/foo/bar/baz"
--- >           takeDirectory "foo/bar/baz" == "foo/bar"
--- > Windows:  takeDirectory "foo\\bar" == "foo"
--- > Windows:  takeDirectory "foo\\bar\\\\" == "foo\\bar"
--- > Windows:  takeDirectory "C:\\" == "C:\\"
-takeDirectory :: FilePath -> FilePath
-takeDirectory = dropTrailingPathSeparator . dropFileName
-
--- | Set the directory, keeping the filename the same.
---
--- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext"
--- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x
-replaceDirectory :: FilePath -> String -> FilePath
-replaceDirectory x dir = combineAlways dir (takeFileName x)
-
-
--- | An alias for '</>'.
-combine :: FilePath -> FilePath -> FilePath
-combine a b | hasLeadingPathSeparator b || hasDrive b = b
-            | otherwise = combineAlways a b
-
--- | Combine two paths, assuming rhs is NOT absolute.
-combineAlways :: FilePath -> FilePath -> FilePath
-combineAlways a b | null a = b
-                  | null b = a
-                  | hasTrailingPathSeparator a = a ++ b
-                  | otherwise = case a of
-                      [a1,':'] | isWindows && isLetter a1 -> a ++ b
-                      _ -> a ++ [pathSeparator] ++ b
-
-
--- | Combine two paths with a path separator.
---   If the second path starts with a path separator or a drive letter, then it returns the second.
---   The intention is that @readFile (dir '</>' file)@ will access the same file as
---   @setCurrentDirectory dir; readFile file@.
---
--- > Posix:   "/directory" </> "file.ext" == "/directory/file.ext"
--- > Windows: "/directory" </> "file.ext" == "/directory\\file.ext"
--- >          "directory" </> "/file.ext" == "/file.ext"
--- > Valid x => (takeDirectory x </> takeFileName x) `equalFilePath` x
---
---   Combined:
---
--- > Posix:   "/" </> "test" == "/test"
--- > Posix:   "home" </> "bob" == "home/bob"
--- > Posix:   "x:" </> "foo" == "x:/foo"
--- > Windows: "C:\\foo" </> "bar" == "C:\\foo\\bar"
--- > Windows: "home" </> "bob" == "home\\bob"
---
---   Not combined:
---
--- > Posix:   "home" </> "/bob" == "/bob"
--- > Windows: "home" </> "C:\\bob" == "C:\\bob"
---
---   Not combined (tricky):
---
---   On Windows, if a filepath starts with a single slash, it is relative to the
---   root of the current drive. In [1], this is (confusingly) referred to as an
---   absolute path.
---   The current behavior of '</>' is to never combine these forms.
---
--- > Windows: "home" </> "/bob" == "/bob"
--- > Windows: "home" </> "\\bob" == "\\bob"
--- > Windows: "C:\\home" </> "\\bob" == "\\bob"
---
---   On Windows, from [1]: "If a file name begins with only a disk designator
---   but not the backslash after the colon, it is interpreted as a relative path
---   to the current directory on the drive with the specified letter."
---   The current behavior of '</>' is to never combine these forms.
---
--- > Windows: "D:\\foo" </> "C:bar" == "C:bar"
--- > Windows: "C:\\foo" </> "C:bar" == "C:bar"
-(</>) :: FilePath -> FilePath -> FilePath
-(</>) = combine
-
-
--- | Split a path by the directory separator.
---
--- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"]
--- > concat (splitPath x) == x
--- > splitPath "test//item/" == ["test//","item/"]
--- > splitPath "test/item/file" == ["test/","item/","file"]
--- > splitPath "" == []
--- > Windows: splitPath "c:\\test\\path" == ["c:\\","test\\","path"]
--- > Posix:   splitPath "/file/test" == ["/","file/","test"]
-splitPath :: FilePath -> [FilePath]
-splitPath x = [drive | drive /= ""] ++ f path
-    where
-        (drive,path) = splitDrive x
-
-        f "" = []
-        f y = (a++c) : f d
-            where
-                (a,b) = break isPathSeparator y
-                (c,d) = span  isPathSeparator b
-
--- | Just as 'splitPath', but don't add the trailing slashes to each element.
---
--- >          splitDirectories "/directory/file.ext" == ["/","directory","file.ext"]
--- >          splitDirectories "test/file" == ["test","file"]
--- >          splitDirectories "/test/file" == ["/","test","file"]
--- > Windows: splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"]
--- >          Valid x => joinPath (splitDirectories x) `equalFilePath` x
--- >          splitDirectories "" == []
--- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"]
--- >          splitDirectories "/test///file" == ["/","test","file"]
-splitDirectories :: FilePath -> [FilePath]
-splitDirectories = map dropTrailingPathSeparator . splitPath
-
-
--- | Join path elements back together.
---
--- > joinPath a == foldr (</>) "" a
--- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext"
--- > Valid x => joinPath (splitPath x) == x
--- > joinPath [] == ""
--- > Posix: joinPath ["test","file","path"] == "test/file/path"
-joinPath :: [FilePath] -> FilePath
--- Note that this definition on c:\\c:\\, join then split will give c:\\.
-joinPath = foldr combine ""
-
-
-
-
-
-
----------------------------------------------------------------------
--- File name manipulators
-
--- | Equality of two 'FilePath's.
---   If you call @System.Directory.canonicalizePath@
---   first this has a much better chance of working.
---   Note that this doesn't follow symlinks or DOSNAM~1s.
---
--- Similar to 'normalise', this does not expand @".."@, because of symlinks.
---
--- >          x == y ==> equalFilePath x y
--- >          normalise x == normalise y ==> equalFilePath x y
--- >          equalFilePath "foo" "foo/"
--- >          not (equalFilePath "/a/../c" "/c")
--- >          not (equalFilePath "foo" "/foo")
--- > Posix:   not (equalFilePath "foo" "FOO")
--- > Windows: equalFilePath "foo" "FOO"
--- > Windows: not (equalFilePath "C:" "C:/")
-equalFilePath :: FilePath -> FilePath -> Bool
-equalFilePath a b = f a == f b
-    where
-        f x | isWindows = dropTrailingPathSeparator $ map toLower $ normalise x
-            | otherwise = dropTrailingPathSeparator $ normalise x
-
-
--- | Contract a filename, based on a relative path. Note that the resulting path
---   will never introduce @..@ paths, as the presence of symlinks means @..\/b@
---   may not reach @a\/b@ if it starts from @a\/c@. For a worked example see
---   <http://neilmitchell.blogspot.co.uk/2015/10/filepaths-are-subtle-symlinks-are-hard.html this blog post>.
---
---   The corresponding @makeAbsolute@ function can be found in
---   @System.Directory@.
---
--- >          makeRelative "/directory" "/directory/file.ext" == "file.ext"
--- >          Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x
--- >          makeRelative x x == "."
--- >          Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x
--- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob"
--- > Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob"
--- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob"
--- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob"
--- > Windows: makeRelative "/Home" "/home/bob" == "bob"
--- > Windows: makeRelative "/" "//" == "//"
--- > Posix:   makeRelative "/Home" "/home/bob" == "/home/bob"
--- > Posix:   makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"
--- > Posix:   makeRelative "/fred" "bob" == "bob"
--- > Posix:   makeRelative "/file/test" "/file/test/fred" == "fred"
--- > Posix:   makeRelative "/file/test" "/file/test/fred/" == "fred/"
--- > Posix:   makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
-makeRelative :: FilePath -> FilePath -> FilePath
-makeRelative root path
- | equalFilePath root path = "."
- | takeAbs root /= takeAbs path = path
- | otherwise = f (dropAbs root) (dropAbs path)
-    where
-        f "" y = dropWhile isPathSeparator y
-        f x y = let (x1,x2) = g x
-                    (y1,y2) = g y
-                in if equalFilePath x1 y1 then f x2 y2 else path
-
-        g x = (dropWhile isPathSeparator a, dropWhile isPathSeparator b)
-            where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x
-
-        -- on windows, need to drop '/' which is kind of absolute, but not a drive
-        dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = tail x
-        dropAbs x = dropDrive x
-
-        takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator]
-        takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x
-
--- | Normalise a file
---
--- * \/\/ outside of the drive can be made blank
---
--- * \/ -> 'pathSeparator'
---
--- * .\/ -> \"\"
---
--- Does not remove @".."@, because of symlinks.
---
--- > Posix:   normalise "/file/\\test////" == "/file/\\test/"
--- > Posix:   normalise "/file/./test" == "/file/test"
--- > Posix:   normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/"
--- > Posix:   normalise "../bob/fred/" == "../bob/fred/"
--- > Posix:   normalise "/a/../c" == "/a/../c"
--- > Posix:   normalise "./bob/fred/" == "bob/fred/"
--- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\"
--- > Windows: normalise "c:\\" == "C:\\"
--- > Windows: normalise "C:.\\" == "C:"
--- > Windows: normalise "\\\\server\\test" == "\\\\server\\test"
--- > Windows: normalise "//server/test" == "\\\\server\\test"
--- > Windows: normalise "c:/file" == "C:\\file"
--- > Windows: normalise "/file" == "\\file"
--- > Windows: normalise "\\" == "\\"
--- > Windows: normalise "/./" == "\\"
--- >          normalise "." == "."
--- > Posix:   normalise "./" == "./"
--- > Posix:   normalise "./." == "./"
--- > Posix:   normalise "/./" == "/"
--- > Posix:   normalise "/" == "/"
--- > Posix:   normalise "bob/fred/." == "bob/fred/"
--- > Posix:   normalise "//home" == "/home"
-normalise :: FilePath -> FilePath
-normalise path = result ++ [pathSeparator | addPathSeparator]
-    where
-        (drv,pth) = splitDrive path
-        result = joinDrive' (normaliseDrive drv) (f pth)
-
-        joinDrive' "" "" = "."
-        joinDrive' d p = joinDrive d p
-
-        addPathSeparator = isDirPath pth
-            && not (hasTrailingPathSeparator result)
-            && not (isRelativeDrive drv)
-
-        isDirPath xs = hasTrailingPathSeparator xs
-            || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs)
-
-        f = joinPath . dropDots . propSep . splitDirectories
-
-        propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs
-                       | otherwise = x : xs
-        propSep [] = []
-
-        dropDots = filter ("." /=)
-
-normaliseDrive :: FilePath -> FilePath
-normaliseDrive "" = ""
-normaliseDrive _ | isPosix = [pathSeparator]
-normaliseDrive drive = if isJust $ readDriveLetter x2
-                       then map toUpper x2
-                       else x2
-    where
-        x2 = map repSlash drive
-
-        repSlash x = if isPathSeparator x then pathSeparator else x
-
--- Information for validity functions on Windows. See [1].
-isBadCharacter :: Char -> Bool
-isBadCharacter x = x >= '\0' && x <= '\31' || x `elem` ":*?><|\""
-
-badElements :: [FilePath]
-badElements =
-    ["CON","PRN","AUX","NUL","CLOCK$"
-    ,"COM1","COM2","COM3","COM4","COM5","COM6","COM7","COM8","COM9"
-    ,"LPT1","LPT2","LPT3","LPT4","LPT5","LPT6","LPT7","LPT8","LPT9"]
-
-
--- | Is a FilePath valid, i.e. could you create a file like it? This function checks for invalid names,
---   and invalid characters, but does not check if length limits are exceeded, as these are typically
---   filesystem dependent.
---
--- >          isValid "" == False
--- >          isValid "\0" == False
--- > Posix:   isValid "/random_ path:*" == True
--- > Posix:   isValid x == not (null x)
--- > Windows: isValid "c:\\test" == True
--- > Windows: isValid "c:\\test:of_test" == False
--- > Windows: isValid "test*" == False
--- > Windows: isValid "c:\\test\\nul" == False
--- > Windows: isValid "c:\\test\\prn.txt" == False
--- > Windows: isValid "c:\\nul\\file" == False
--- > Windows: isValid "\\\\" == False
--- > Windows: isValid "\\\\\\foo" == False
--- > Windows: isValid "\\\\?\\D:file" == False
--- > Windows: isValid "foo\tbar" == False
--- > Windows: isValid "nul .txt" == False
--- > Windows: isValid " nul.txt" == True
-isValid :: FilePath -> Bool
-isValid "" = False
-isValid x | '\0' `elem` x = False
-isValid _ | isPosix = True
-isValid path =
-        not (any isBadCharacter x2) &&
-        not (any f $ splitDirectories x2) &&
-        not (isJust (readDriveShare x1) && all isPathSeparator x1) &&
-        not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1))
-    where
-        (x1,x2) = splitDrive path
-        f x = map toUpper (dropWhileEnd (== ' ') $ dropExtensions x) `elem` badElements
-
-
--- | Take a FilePath and make it valid; does not change already valid FilePaths.
---
--- > isValid (makeValid x)
--- > isValid x ==> makeValid x == x
--- > makeValid "" == "_"
--- > makeValid "file\0name" == "file_name"
--- > Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid"
--- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test"
--- > Windows: makeValid "test*" == "test_"
--- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_"
--- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt"
--- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"
--- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file"
--- > Windows: makeValid "\\\\\\foo" == "\\\\drive"
--- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file"
--- > Windows: makeValid "nul .txt" == "nul _.txt"
-makeValid :: FilePath -> FilePath
-makeValid "" = "_"
-makeValid path
-        | isPosix = map (\x -> if x == '\0' then '_' else x) path
-        | isJust (readDriveShare drv) && all isPathSeparator drv = take 2 drv ++ "drive"
-        | isJust (readDriveUNC drv) && not (hasTrailingPathSeparator drv) =
-            makeValid (drv ++ [pathSeparator] ++ pth)
-        | otherwise = joinDrive drv $ validElements $ validChars pth
-    where
-        (drv,pth) = splitDrive path
-
-        validChars = map f
-        f x = if isBadCharacter x then '_' else x
-
-        validElements x = joinPath $ map g $ splitPath x
-        g x = h a ++ b
-            where (a,b) = break isPathSeparator x
-        h x = if map toUpper (dropWhileEnd (== ' ') a) `elem` badElements then a ++ "_" <.> b else x
-            where (a,b) = splitExtensions x
-
-
--- | Is a path relative, or is it fixed to the root?
---
--- > Windows: isRelative "path\\test" == True
--- > Windows: isRelative "c:\\test" == False
--- > Windows: isRelative "c:test" == True
--- > Windows: isRelative "c:\\" == False
--- > Windows: isRelative "c:/" == False
--- > Windows: isRelative "c:" == True
--- > Windows: isRelative "\\\\foo" == False
--- > Windows: isRelative "\\\\?\\foo" == False
--- > Windows: isRelative "\\\\?\\UNC\\foo" == False
--- > Windows: isRelative "/foo" == True
--- > Windows: isRelative "\\foo" == True
--- > Posix:   isRelative "test/path" == True
--- > Posix:   isRelative "/test" == False
--- > Posix:   isRelative "/" == False
---
--- According to [1]:
---
--- * "A UNC name of any format [is never relative]."
---
--- * "You cannot use the "\\?\" prefix with a relative path."
-isRelative :: FilePath -> Bool
-isRelative x = null drive || isRelativeDrive drive
-    where drive = takeDrive x
-
-
-{- c:foo -}
--- From [1]: "If a file name begins with only a disk designator but not the
--- backslash after the colon, it is interpreted as a relative path to the
--- current directory on the drive with the specified letter."
-isRelativeDrive :: String -> Bool
-isRelativeDrive x =
-    maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x)
-
-
--- | @not . 'isRelative'@
---
--- > isAbsolute x == not (isRelative x)
-isAbsolute :: FilePath -> Bool
-isAbsolute = not . isRelative
-
-
------------------------------------------------------------------------------
--- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2])
--- Note that Data.List.dropWhileEnd is only available in base >= 4.5.
-dropWhileEnd :: (a -> Bool) -> [a] -> [a]
-dropWhileEnd p = reverse . dropWhile p . reverse
-
--- takeWhileEnd (>2) [1,2,3,4,1,2,3,4] == [3,4])
-takeWhileEnd :: (a -> Bool) -> [a] -> [a]
-takeWhileEnd p = reverse . takeWhile p . reverse
-
--- spanEnd (>2) [1,2,3,4,1,2,3,4] = ([1,2,3,4,1,2], [3,4])
-spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
-spanEnd p xs = (dropWhileEnd p xs, takeWhileEnd p xs)
-
--- breakEnd (< 2) [1,2,3,4,1,2,3,4] == ([1,2,3,4,1],[2,3,4])
-breakEnd :: (a -> Bool) -> [a] -> ([a], [a])
-breakEnd p = spanEnd (not . p)
-
--- | The stripSuffix function drops the given suffix from a list. It returns
--- Nothing if the list did not end with the suffix given, or Just the list
--- before the suffix, if it does.
-stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
-stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys)
+#include "Internal.hs"

System/OsPath.hs

+{-# LANGUAGE CPP #-}
+
+#define FILEPATH_NAME OsPath
+#define OSSTRING_NAME OsString
+#define WORD_NAME OsChar
+
+-- |
+-- Module      :  System.OsPath
+-- Copyright   :  © 2021 Julian Ospald
+-- License     :  MIT
+--
+-- Maintainer  :  Julian Ospald <hasufell@posteo.de>
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- An implementation of the <https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/abstract-file-path Abstract FilePath Proposal>,
+-- which aims to supersede @type FilePath = String@ for various reasons:
+--
+-- 1. it is more efficient and avoids memory fragmentation (uses unpinned 'ShortByteString' under the hood)
+-- 2. it is more type-safe (newtype over 'ShortByteString')
+-- 3. avoids round-tripping issues by not converting to String (which is not total and loses the encoding)
+-- 4. abstracts over unix and windows while keeping the original bytes
+--
+-- It is important to know that filenames\/filepaths have different representations across platforms:
+--
+-- - On /Windows/, filepaths are expected to be encoded as UTF16-LE <https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-dtyp/76f10dd8-699d-45e6-a53c-5aefc586da20 as per the documentation>, but
+--   may also include invalid surrogate pairs, in which case UCS-2 can be used. They are passed as @wchar_t*@ to syscalls.
+--   'OsPath' only maintains the wide character invariant.
+-- - On /Unix/, filepaths don't have a predefined encoding (although they
+--   are often interpreted as UTF8) as per the
+--   <https://pubs.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap03.html#tag_03_170 POSIX specification>
+--   and are passed as @char[]@ to syscalls. 'OsPath' maintains no invariant
+--   here.
+--
+-- Apart from encoding, filepaths have additional restrictions per platform:
+--
+-- - On /Windows/ the <https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file#naming-conventions naming convention> may apply
+-- - On /Unix/, only @NUL@ bytes are disallowed as per the <https://pubs.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap03.html#tag_03_170 POSIX specification>
+--
+-- Use 'isValid' to check for these restrictions ('OsPath' doesn't
+-- maintain this invariant).
+--
+-- Also note that these restrictions are
+-- not exhaustive and further filesystem specific restrictions may apply on
+-- all platforms. This library makes no attempt at satisfying these.
+-- Library users may need to account for that, depending
+-- on what filesystems they want to support.
+--
+-- It is advised to follow these principles when dealing with filepaths\/filenames:
+--
+-- 1. Avoid interpreting filenames that the OS returns, unless absolutely necessary.
+--    For example, the filepath separator is usually a predefined 'Word8'/'Word16', regardless of encoding.
+--    So even if we need to split filepaths, it might still not be necessary to understand the encoding
+--    of the filename.
+-- 2. When interpreting OS returned filenames consider that these might not be UTF8 on /unix/
+--    or at worst don't have an ASCII compatible encoding. The are 3 available strategies fer decoding/encoding:
+--    a) pick the best UTF (UTF-8 on unix, UTF-16LE on windows), b) decode with an explicitly defined 'TextEncoding',
+--    c) mimic the behavior of the @base@ library (permissive UTF16 on windows, current filesystem encoding on unix).
+-- 3. Avoid comparing @String@ based filepaths, because filenames of different encodings
+--    may have the same @String@ representation, although they're not the same byte-wise.
+
+
+#include "OsPath/Common.hs"

System/OsPath.hs-boot

+module System.OsPath where
+
+import System.OsPath.Types
+    ( OsPath )
+
+isValid :: OsPath -> Bool

System/OsPath/Encoding.hs

+module System.OsPath.Encoding
+  (
+  -- * Types
+    EncodingException(..)
+  , showEncodingException
+
+  -- * UCS-2
+  , ucs2le
+  , mkUcs2le
+  , ucs2le_DF
+  , ucs2le_EF
+  , ucs2le_decode
+  , ucs2le_encode
+
+  -- * UTF-16LE_b
+  , utf16le_b
+  , mkUTF16le_b
+  , utf16le_b_DF
+  , utf16le_b_EF
+  , utf16le_b_decode
+  , utf16le_b_encode
+
+  -- * base encoding
+  , encodeWithBasePosix
+  , decodeWithBasePosix
+  , encodeWithBaseWindows
+  , decodeWithBaseWindows
+  )
+  where
+
+import System.OsString.Encoding.Internal

System/OsPath/Internal.hs

+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE ViewPatterns #-}  -- needed to quote a view pattern
+
+module System.OsPath.Internal where
+
+import {-# SOURCE #-} System.OsPath
+    ( isValid )
+import System.OsPath.Types
+import qualified System.OsString.Internal as OS
+
+import Control.Monad.Catch
+    ( MonadThrow )
+import Data.ByteString
+    ( ByteString )
+import Language.Haskell.TH.Quote
+    ( QuasiQuoter (..) )
+import Language.Haskell.TH.Syntax
+    ( Lift (..), lift )
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+
+import System.OsString.Internal.Types
+import System.OsPath.Encoding
+import Control.Monad (when)
+import System.IO
+    ( TextEncoding )
+
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+import qualified System.OsPath.Windows as PF
+import GHC.IO.Encoding.UTF16 ( mkUTF16le )
+#else
+import qualified System.OsPath.Posix as PF
+import GHC.IO.Encoding.UTF8 ( mkUTF8 )
+#endif
+import GHC.Stack (HasCallStack)
+
+
+
+-- | Partial unicode friendly encoding.
+--
+-- On windows this encodes as UTF16-LE (strictly), which is a pretty good guess.
+-- On unix this encodes as UTF8 (strictly), which is a good guess.
+--
+-- Throws an 'EncodingException' if encoding fails. If the input does not
+-- contain surrogate chars, you can use 'unsafeEncodeUtf'.
+encodeUtf :: MonadThrow m => FilePath -> m OsPath
+encodeUtf = OS.encodeUtf
+
+-- | Unsafe unicode friendly encoding.
+--
+-- Like 'encodeUtf', except it crashes when the input contains
+-- surrogate chars. For sanitized input, this can be useful.
+unsafeEncodeUtf :: HasCallStack => String -> OsString
+unsafeEncodeUtf = OS.unsafeEncodeUtf
+
+-- | Encode a 'FilePath' with the specified encoding.
+encodeWith :: TextEncoding  -- ^ unix text encoding
+           -> TextEncoding  -- ^ windows text encoding
+           -> FilePath
+           -> Either EncodingException OsPath
+encodeWith = OS.encodeWith
+
+-- | Like 'encodeUtf', except this mimics the behavior of the base library when doing filesystem
+-- operations, which is:
+--
+-- 1. on unix, uses shady PEP 383 style encoding (based on the current locale,
+--    but PEP 383 only works properly on UTF-8 encodings, so good luck)
+-- 2. on windows does permissive UTF-16 encoding, where coding errors generate
+--    Chars in the surrogate range
+--
+-- Looking up the locale requires IO. If you're not worried about calls
+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure
+-- to deeply evaluate the result to catch exceptions).
+encodeFS :: FilePath -> IO OsPath
+encodeFS = OS.encodeFS
+
+
+-- | Partial unicode friendly decoding.
+--
+-- On windows this decodes as UTF16-LE (strictly), which is a pretty good guess.
+-- On unix this decodes as UTF8 (strictly), which is a good guess.
+--
+-- Throws a 'EncodingException' if decoding fails.
+decodeUtf :: MonadThrow m => OsPath -> m FilePath
+decodeUtf = OS.decodeUtf
+
+-- | Decode an 'OsPath' with the specified encoding.
+decodeWith :: TextEncoding  -- ^ unix text encoding
+           -> TextEncoding  -- ^ windows text encoding
+           -> OsPath
+           -> Either EncodingException FilePath
+decodeWith = OS.decodeWith
+
+-- | Like 'decodeUtf', except this mimics the behavior of the base library when doing filesystem
+-- operations, which is:
+--
+-- 1. on unix, uses shady PEP 383 style encoding (based on the current locale,
+--    but PEP 383 only works properly on UTF-8 encodings, so good luck)
+-- 2. on windows does permissive UTF-16 encoding, where coding errors generate
+--    Chars in the surrogate range
+--
+-- Looking up the locale requires IO. If you're not worried about calls
+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure
+-- to deeply evaluate the result to catch exceptions).
+decodeFS :: OsPath -> IO FilePath
+decodeFS = OS.decodeFS
+
+
+-- | Constructs an @OsPath@ from a ByteString.
+--
+-- On windows, this ensures valid UCS-2LE, on unix it is passed unchanged/unchecked.
+--
+-- Throws 'EncodingException' on invalid UCS-2LE on windows (although unlikely).
+fromBytes :: MonadThrow m
+          => ByteString
+          -> m OsPath
+fromBytes = OS.fromBytes
+
+
+
+-- | QuasiQuote an 'OsPath'. This accepts Unicode characters
+-- and encodes as UTF-8 on unix and UTF-16LE on windows. Runs 'isValid'
+-- on the input. If used as a pattern, requires turning on the @ViewPatterns@
+-- extension.
+osp :: QuasiQuoter
+osp = QuasiQuoter
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+  { quoteExp = \s -> do
+      osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF16le ErrorOnCodingFailure) $ s
+      when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')
+      lift osp'
+  , quotePat = \s -> do
+      osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF16le ErrorOnCodingFailure) $ s
+      when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')
+      [p|((==) osp' -> True)|]
+  , quoteType = \_ ->
+      fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)"
+  , quoteDec  = \_ ->
+      fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)"
+  }
+#else
+  { quoteExp = \s -> do
+      osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF8 ErrorOnCodingFailure) $ s
+      when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')
+      lift osp'
+  , quotePat = \s -> do
+      osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF8 ErrorOnCodingFailure) $ s
+      when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')
+      [p|((==) osp' -> True)|]
+  , quoteType = \_ ->
+      fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)"
+  , quoteDec  = \_ ->
+      fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)"
+  }
+#endif
+
+
+-- | Unpack an 'OsPath' to a list of 'OsChar'.
+unpack :: OsPath -> [OsChar]
+unpack = OS.unpack
+
+
+-- | Pack a list of 'OsChar' to an 'OsPath'.
+--
+-- Note that using this in conjunction with 'unsafeFromChar' to
+-- convert from @[Char]@ to 'OsPath' is probably not what
+-- you want, because it will truncate unicode code points.
+pack :: [OsChar] -> OsPath
+pack = OS.pack
+

System/OsPath/Posix.hs

+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE ViewPatterns #-}
+
+#undef  WINDOWS
+#define POSIX
+#define IS_WINDOWS False
+#define FILEPATH_NAME PosixPath
+#define OSSTRING_NAME PosixString
+#define WORD_NAME PosixChar
+
+#include "Common.hs"
+
+-- | QuasiQuote a 'PosixPath'. This accepts Unicode characters
+-- and encodes as UTF-8. Runs 'isValid' on the input.
+pstr :: QuasiQuoter
+pstr =
+  QuasiQuoter
+  { quoteExp = \s -> do
+      ps <- either (fail . show) pure $ encodeWith (mkUTF8 ErrorOnCodingFailure) s
+      when (not $ isValid ps) $ fail ("filepath not valid: " ++ show ps)
+      lift ps
+  , quotePat = \s -> do
+      osp' <- either (fail . show) pure . encodeWith (mkUTF8 ErrorOnCodingFailure) $ s
+      when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')
+      [p|((==) osp' -> True)|]
+  , quoteType = \_ ->
+      fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)"
+  , quoteDec  = \_ ->
+      fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)"
+  }

System/OsPath/Posix/Internal.hs

+{-# LANGUAGE CPP #-}
+
+#undef WINDOWS
+#define OS_PATH
+#define IS_WINDOWS False
+#define MODULE_NAME Posix
+
+#include "../../FilePath/Internal.hs"