From 32bbf19e0d02f68d2de9edc842bd0c04af74f12e Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Tue, 7 Dec 2021 17:03:03 +0100
Subject: [PATCH] Implement AbstractFilePath
---
.github/workflows/test.yaml | 95 +-
Generate.hs | 103 +-
Makefile | 9 +-
README.md | 12 +-
System/AbstractFilePath.hs | 69 +
System/AbstractFilePath.hs-boot | 6 +
System/AbstractFilePath/Common.hs | 861 +++++++++
.../AbstractFilePath/Data/ByteString/Short.hs | 1589 +++++++++++++++++
.../Data/ByteString/Short/Decode.hs | 286 +++
.../Data/ByteString/Short/Encode.hs | 64 +
.../Data/ByteString/Short/Internal.hs | 437 +++++
.../Data/ByteString/Short/Word16.hs | 862 +++++++++
System/AbstractFilePath/Internal.hs | 116 ++
System/AbstractFilePath/Posix.hs | 12 +
System/AbstractFilePath/Posix/Internal.hs | 8 +
System/AbstractFilePath/Types.hs | 34 +
System/AbstractFilePath/Windows.hs | 12 +
System/AbstractFilePath/Windows/Internal.hs | 9 +
System/FilePath/Internal.hs | 659 ++++---
System/FilePath/Posix.hs | 1051 +----------
System/FilePath/Windows.hs | 1052 +----------
System/OsString.hs | 60 +
System/OsString/Common.hs | 277 +++
System/OsString/Internal.hs | 159 ++
System/OsString/Internal/Types.hs | 233 +++
System/OsString/Posix.hs | 7 +
System/OsString/Types.hs | 14 +
System/OsString/Windows.hs | 13 +
cabal.project | 1 +
changelog.md | 5 +
filepath.cabal | 200 ++-
stack.yaml | 3 +
tests/Main.hs | 10 +
tests/Properties.hs | 23 +
tests/Properties/Common.hs | 422 +++++
tests/Properties/ShortByteString.hs | 3 +
tests/Properties/ShortByteString/Word16.hs | 3 +
tests/Test.hs | 14 +-
tests/TestGen.hs | 493 ++++-
tests/TestUtil.hs | 90 +-
tests/afpp/AbstractFilePathSpec.hs | 49 +
tests/afpp/Arbitrary.hs | 29 +
tests/afpp/Test.hs | 9 +
43 files changed, 7008 insertions(+), 2455 deletions(-)
create mode 100644 System/AbstractFilePath.hs
create mode 100644 System/AbstractFilePath.hs-boot
create mode 100644 System/AbstractFilePath/Common.hs
create mode 100644 System/AbstractFilePath/Data/ByteString/Short.hs
create mode 100644 System/AbstractFilePath/Data/ByteString/Short/Decode.hs
create mode 100644 System/AbstractFilePath/Data/ByteString/Short/Encode.hs
create mode 100644 System/AbstractFilePath/Data/ByteString/Short/Internal.hs
create mode 100644 System/AbstractFilePath/Data/ByteString/Short/Word16.hs
create mode 100644 System/AbstractFilePath/Internal.hs
create mode 100644 System/AbstractFilePath/Posix.hs
create mode 100644 System/AbstractFilePath/Posix/Internal.hs
create mode 100644 System/AbstractFilePath/Types.hs
create mode 100644 System/AbstractFilePath/Windows.hs
create mode 100644 System/AbstractFilePath/Windows/Internal.hs
create mode 100644 System/OsString.hs
create mode 100644 System/OsString/Common.hs
create mode 100644 System/OsString/Internal.hs
create mode 100644 System/OsString/Internal/Types.hs
create mode 100644 System/OsString/Posix.hs
create mode 100644 System/OsString/Types.hs
create mode 100644 System/OsString/Windows.hs
create mode 100644 cabal.project
create mode 100644 stack.yaml
create mode 100644 tests/Main.hs
create mode 100644 tests/Properties.hs
create mode 100644 tests/Properties/Common.hs
create mode 100644 tests/Properties/ShortByteString.hs
create mode 100644 tests/Properties/ShortByteString/Word16.hs
create mode 100644 tests/afpp/AbstractFilePathSpec.hs
create mode 100644 tests/afpp/Arbitrary.hs
create mode 100644 tests/afpp/Test.hs
diff --git a/.github/workflows/test.yaml b/.github/workflows/test.yaml
index 7992f6a..fce0a1f 100644
--- a/.github/workflows/test.yaml
+++ b/.github/workflows/test.yaml
@@ -14,43 +14,45 @@ jobs:
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']
+ ghc: ['8.0', '8.2', '8.4', '8.6', '8.8', '8.10', '9.0', '9.2']
+ cabal: ['latest']
include:
- - os: ubuntu-latest
- ghc: 'HEAD'
- experimental: true
- os: ubuntu-latest
ghc: 'recommended'
experimental: true
- os: ubuntu-latest
ghc: 'latest'
experimental: true
+ - os: windows-latest
+ ghc: '9.2.1'
+ experimental: true
exclude:
- os: macOS-latest
- ghc: '8.0.2'
+ ghc: '8.0'
- os: macOS-latest
- ghc: '8.2.2'
+ ghc: '8.2'
- os: macOS-latest
- ghc: '8.4.4'
+ ghc: '8.4'
- os: macOS-latest
- ghc: '8.6.5'
+ ghc: '8.6'
- os: macOS-latest
- ghc: '8.8.4'
+ ghc: '8.8'
- os: macOS-latest
- ghc: '9.0.2'
+ ghc: '9.0'
+ - os: windows-latest
+ ghc: '8.0'
- os: windows-latest
- ghc: '8.0.2'
+ ghc: '8.2'
- os: windows-latest
- ghc: '8.2.2'
+ ghc: '8.4'
- os: windows-latest
- ghc: '8.4.4'
+ ghc: '8.6'
- os: windows-latest
- ghc: '8.6.5'
+ ghc: '8.8'
- os: windows-latest
- ghc: '8.8.4'
+ ghc: '9.0'
- os: windows-latest
- ghc: '9.0.2'
+ ghc: '9.2'
steps:
- uses: actions/checkout@v2
@@ -59,11 +61,9 @@ jobs:
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-linux-deb10-unreg-validate.tar.xz?job=x86_64-linux-deb10-unreg-validate' head
- ghcup set ghc head
+ ghcup install ghc -u 'https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-linux-deb10-unreg-validate.tar.xz?job=x86_64-linux-deb10-unreg-validate' --set head
else
- ghcup install ghc ${{ matrix.ghc }}
- ghcup set ghc ${{ matrix.ghc }}
+ ghcup install ghc --set ${{ matrix.ghc }}
fi
ghcup install cabal ${{ matrix.cabal }}
shell: bash
@@ -71,10 +71,10 @@ jobs:
- name: Build
run: |
set -eux
- [ "${{ matrix.ghc }}" == 'HEAD' ] ||
- [ "${{ matrix.ghc }}" == 'recommended' ] ||
- [ "${{ matrix.ghc }}" == 'latest' ] ||
- [ "$(ghc --numeric-version)" = "${{ matrix.ghc }}" ]
+ [[ "${{ matrix.ghc }}" == 'HEAD' ]] ||
+ [[ "${{ matrix.ghc }}" == 'recommended' ]] ||
+ [[ "${{ matrix.ghc }}" == 'latest' ]] ||
+ [[ "$(ghc --numeric-version)" =~ "${{ matrix.ghc }}" ]]
cabal update
cabal build --enable-tests --enable-benchmarks
cabal test
@@ -88,7 +88,6 @@ jobs:
run: |
set -eux
export "PATH=$HOME/.cabal/bin:$PATH"
- cabal install --overwrite-policy=always --install-method=copy cpphs
make all
git diff --exit-code
@@ -102,33 +101,65 @@ jobs:
steps:
- uses: actions/checkout@v2
- uses: uraimo/run-on-arch-action@v2.1.1
- timeout-minutes: 60
+ timeout-minutes: 180
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
+ apt-get install -y ghc libghc-quickcheck2-dev libghc-tasty-dev libghc-tasty-quickcheck-dev git make curl
run: |
ghc --version
- ghc --make -o Main tests/Test.hs -itests/ +RTS -s
+ runhaskell --ghc-arg=-DGHC_MAKE Generate.hs
+ ghc --make -o Main tests/Test.hs -DGHC_MAKE -itests/ -O0 +RTS -s
+ ./Main 100 500 +RTS -s
+ ./Main 100 -500 +RTS -s
+ ghc --make -o Main tests/Main.hs -DGHC_MAKE -itests/ -O0 +RTS -s
./Main +RTS -s
emulated-i386:
runs-on: ubuntu-latest
container:
- image: i386/ubuntu:bionic
+ image: i386/debian:sid
steps:
- name: install
run: |
apt-get update -y
- apt-get install -y ghc libghc-quickcheck2-dev cpphs git make
+ apt-get install -y ghc libghc-quickcheck2-dev libghc-tasty-dev libghc-tasty-quickcheck-dev git make curl libghc-exceptions-dev
shell: bash
- uses: actions/checkout@v1
- name: test
run: |
ghc --version
- ghc --make -o Main tests/Test.hs -itests/ +RTS -s
+ runhaskell --ghc-arg=-DGHC_MAKE Generate.hs
+ ghc --make -o Main tests/Test.hs -DGHC_MAKE -itests/ +RTS -s
+ ./Main +RTS -s
+ ghc --make -o Main tests/Main.hs -DGHC_MAKE -itests/ +RTS -s
./Main +RTS -s
shell: bash
+
+ bounds-checking:
+ needs: build
+ runs-on: ubuntu-latest
+ steps:
+ - uses: actions/checkout@v2
+ - name: Test
+ run: |
+ ghcup install ghc --set 9.2.2
+ ghcup install cabal latest
+ cabal update
+ cabal run -w ghc-9.2.2 --ghc-options='-fcheck-prim-bounds -fno-ignore-asserts' bytestring-tests
+
+ sdist:
+ runs-on: ubuntu-latest
+ steps:
+ - uses: actions/checkout@v2
+ - name: Test
+ run: |
+ rm cabal.project
+ cabal update
+ cabal sdist
+ tar xf dist-newstyle/sdist/filepath-*.tar.gz
+ cd filepath-*
+ cabal build
diff --git a/Generate.hs b/Generate.hs
index 6937b2a..2bc5793 100755
--- a/Generate.hs
+++ b/Generate.hs
@@ -1,9 +1,10 @@
-{-# 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
@@ -16,11 +17,28 @@ main = do
let tests = map renderTest $ concatMap parseTest $ lines src
writeFileBinaryChanged "tests/TestGen.hs" $ unlines $
["-- GENERATED CODE: See ../Generate.hs"
+#ifndef GHC_MAKE
+ , "{-# LANGUAGE OverloadedStrings #-}"
+ , "{-# LANGUAGE ViewPatterns #-}"
+#endif
,"module TestGen(tests) where"
,"import TestUtil"
+ ,"import Prelude as P"
+ ,"import Data.Semigroup"
+ ,"import qualified Data.Char as C"
+ ,"import qualified System.AbstractFilePath.Data.ByteString.Short as SBS"
+ ,"import qualified System.AbstractFilePath.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.AbstractFilePath.Windows.Internal as AFP_W"
+ ,"import qualified System.AbstractFilePath.Posix.Internal as AFP_P"
+#else
+ ,"import System.AbstractFilePath.Types"
+ ,"import qualified System.AbstractFilePath.Windows as AFP_W"
+ ,"import qualified System.AbstractFilePath.Posix as AFP_P"
+#endif
+ , "import System.AbstractFilePath.Data.ByteString.Short.Encode"
,"tests :: [(String, Property)]"
,"tests ="] ++
[" " ++ c ++ "(" ++ show t1 ++ ", " ++ t2 ++ ")" | (c,(t1,t2)) <- zip ("[":repeat ",") tests] ++
@@ -28,7 +46,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 +62,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 +72,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 +106,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 unPFP)"
+ | v == "any" -> "(\\f (unPFP -> x) -> SBS." <> v <> " (f . PW) x)"
+ | v == "isPrefixOf" -> "(\\(unPFP -> x) (unPFP -> y) -> SBS." <> v <> " x y)"
+ | v == "isSuffixOf" -> "(\\(unPFP -> x) (unPFP -> y) -> SBS." <> v <> " x y)"
+ | otherwise -> "(SBS." <> v <> " . unPFP)"
+ AFP_W
+ | v == "concat" -> "(WS . SBS16." <> v <> " . fmap unWFP)"
+ | v == "any" -> "(\\f (unWFP -> x) -> SBS16." <> v <> " (f . WW) x)"
+ | v == "isPrefixOf" -> "(\\(unWFP -> x) (unWFP -> y) -> SBS16." <> v <> " x y)"
+ | v == "isSuffixOf" -> "(\\(unWFP -> x) (unWFP -> y) -> SBS16." <> v <> " x y)"
+ | otherwise -> "(SBS16." <> v <> " . unWFP)"
+ _ -> v
+#endif
+
---------------------------------------------------------------------
diff --git a/Makefile b/Makefile
index f6139d3..a18a915 100644
--- a/Makefile
+++ b/Makefile
@@ -1,10 +1,7 @@
-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
diff --git a/README.md b/README.md
index 772abd2..90817a5 100644
--- a/README.md
+++ b/README.md
@@ -14,7 +14,11 @@ All three modules provide the same API, and the same documentation (calling out
### 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 AbstractFilePath = 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)
@@ -22,11 +26,9 @@ and are passed as `char[]` to syscalls.
On windows (at least the API used by `Win32`) filepaths are UTF-16 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 `AbstractFilePath` 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).
diff --git a/System/AbstractFilePath.hs b/System/AbstractFilePath.hs
new file mode 100644
index 0000000..4785b3d
--- /dev/null
+++ b/System/AbstractFilePath.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE CPP #-}
+
+#define FILEPATH_NAME AbstractFilePath
+#define OSSTRING_NAME OsString
+#define WORD_NAME OsChar
+#define CTOR OsString
+#define WTOR OsChar
+
+-- |
+-- Module : System.AbstractFilePath
+-- 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 (uses unpinned 'ShortByteString' under the hood)
+-- 2. is more type-safe (not a type synonym, but a newtype)
+-- 3. avoids round-tripping issues, by not converting to String (which loses the encoding)
+--
+-- It is important to know that filenames\/filepaths have different representations across platforms:
+--
+-- - On /Windows/, filepaths are expected to be in UTF16 as passed to
+-- syscalls (although there are other APIs, the <https://hackage.haskell.org/package/Win32 Win32> package uses the wide character one).
+-- This invariant is maintained by 'AbstractFilePath'.
+-- - 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. 'AbstractFilePath' maintains no invariant
+-- here. Some functions however, such as 'toAbstractFilePath', may expect
+-- or produce UTF8.
+--
+-- 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 ('AbstractFilePath' 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', 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. Some strategies here involve looking
+-- up the current locale and using that for decoding ('fromAbstractFilePathIO' does this).
+-- Otherwise it can be reasonable to assume UTF8 on unix ('fromAbstractFilePath' does that) if your application specifically
+-- mentions that it requires a UTF8 compatible system. These things should be documented.
+-- 3. When dealing with user input (e.g. on the command line) on /unix/ as e.g. @String@ the input
+-- encoding is lost. The output encoding (e.g. how we write a filename to disk) can then
+-- either follow the current locale again ('toAbstractFilePathIO') or a fixed encoding
+-- ('toAbstractFilePath'). The decision should be clearly documented. If the input is in the
+-- form of a @ByteString@, then 'bsToAFP' may be of interest, unless the input needs further
+-- interpretation.
+
+#include "AbstractFilePath/Common.hs"
diff --git a/System/AbstractFilePath.hs-boot b/System/AbstractFilePath.hs-boot
new file mode 100644
index 0000000..51035b1
--- /dev/null
+++ b/System/AbstractFilePath.hs-boot
@@ -0,0 +1,6 @@
+module System.AbstractFilePath where
+
+import System.AbstractFilePath.Types
+ ( AbstractFilePath )
+
+isValid :: AbstractFilePath -> Bool
diff --git a/System/AbstractFilePath/Common.hs b/System/AbstractFilePath/Common.hs
new file mode 100644
index 0000000..b84bcbf
--- /dev/null
+++ b/System/AbstractFilePath/Common.hs
@@ -0,0 +1,861 @@
+{-# LANGUAGE CPP #-}
+-- This template expects CPP definitions for:
+-- WINDOWS
+-- POSIX
+-- FILEPATH_NAME = PosixFilePath | WindowsFilePath | AbstractFilePath
+-- OSSTRING_NAME = PosixString | WindowsString | OsString
+-- WORD_NAME = PosixChar | WindowsChar | OsChar
+-- WTOR = PW | WW | OsChar
+-- CTOR = PS | WS | OsString
+
+#ifdef WINDOWS
+module System.AbstractFilePath.Windows
+#elif defined(POSIX)
+module System.AbstractFilePath.Posix
+#else
+module System.AbstractFilePath
+#endif
+ (
+ -- * Types
+#ifdef WINDOWS
+ WindowsString
+ , WindowsChar
+ , WindowsFilePath
+#elif defined(POSIX)
+ PosixString
+ , PosixChar
+ , PosixFilePath
+#else
+ AbstractFilePath
+ , OsString
+ , OsChar
+#endif
+ -- * String construction
+#if defined(WINDOWS) || defined(POSIX)
+ , toPlatformString
+ , toPlatformStringIO
+ , bsToPlatformString
+ , pstr
+ , packPlatformString
+#else
+ , toAbstractFilePath
+ , toAbstractFilePathIO
+ , bsToAFP
+ , afp
+ , packAFP
+#endif
+
+ -- * String deconstruction
+#if defined(WINDOWS) || defined(POSIX)
+ , fromPlatformString
+#if defined(POSIX)
+ , fromPlatformStringEnc
+#endif
+ , fromPlatformStringIO
+ , unpackPlatformString
+#else
+ , fromAbstractFilePath
+ , fromAbstractFilePathEnc
+ , fromAbstractFilePathIO
+ , unpackAFP
+#endif
+
+ -- * Word construction
+ , unsafeFromChar
+
+ -- * Word deconstruction
+ , toChar
+
+ -- * Separator predicates
+ , pathSeparator
+ , pathSeparators
+ , isPathSeparator
+ , searchPathSeparator
+ , isSearchPathSeparator
+ , extSeparator
+ , isExtSeparator
+
+ -- * $PATH methods
+ , splitSearchPath,
+
+ -- * 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
+
+
+#ifdef WINDOWS
+import System.AbstractFilePath.Types
+import System.OsString.Windows
+ ( bsToPlatformString
+ , unsafeFromChar
+ , toChar
+ , fromPlatformString
+ , fromPlatformStringIO
+ , packPlatformString
+ , pstr
+ , toPlatformString
+ , toPlatformStringIO
+ , unpackPlatformString
+ )
+import Data.Bifunctor ( bimap )
+import qualified System.AbstractFilePath.Windows.Internal as C
+import System.AbstractFilePath.Types ()
+
+#elif defined(POSIX)
+
+import System.AbstractFilePath.Types
+import System.OsString.Posix
+ ( bsToPlatformString
+ , unsafeFromChar
+ , toChar
+ , fromPlatformString
+ , fromPlatformStringEnc
+ , fromPlatformStringIO
+ , packPlatformString
+ , pstr
+ , toPlatformString
+ , toPlatformStringIO
+ , unpackPlatformString
+ )
+import Data.Bifunctor ( bimap )
+import qualified System.AbstractFilePath.Posix.Internal as C
+import System.AbstractFilePath.Types ()
+
+#else
+
+import System.AbstractFilePath.Internal
+ ( afp
+ , bsToAFP
+ , fromAbstractFilePath
+ , fromAbstractFilePathEnc
+ , fromAbstractFilePathIO
+ , packAFP
+ , toAbstractFilePath
+ , toAbstractFilePathIO
+ , unpackAFP
+ )
+import System.AbstractFilePath.Types
+ ( AbstractFilePath )
+import System.OsString
+import System.OsString.Internal.Types
+
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+import qualified System.AbstractFilePath.Windows as C
+#else
+import qualified System.AbstractFilePath.Posix as C
+#endif
+
+import Data.Bifunctor
+ ( bimap )
+#endif
+
+
+------------------------
+-- Separator predicates
+
+
+-- | 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 :: WORD_NAME
+pathSeparator = WTOR C.pathSeparator
+
+-- | The list of all possible separators.
+--
+-- > Windows: pathSeparators == ['\\', '/']
+-- > Posix: pathSeparators == ['/']
+-- > pathSeparator `elem` pathSeparators
+pathSeparators :: [WORD_NAME]
+pathSeparators = WTOR <$> C.pathSeparators
+
+-- | Rather than using @(== 'pathSeparator')@, use this. Test if something
+-- is a path separator.
+--
+-- > isPathSeparator a == (a `elem` pathSeparators)
+isPathSeparator :: WORD_NAME -> Bool
+isPathSeparator (WTOR w) = C.isPathSeparator w
+
+-- | Is the character a file separator?
+--
+-- > isSearchPathSeparator a == (a == searchPathSeparator)
+searchPathSeparator :: WORD_NAME
+searchPathSeparator = WTOR C.searchPathSeparator
+
+-- | Is the character a file separator?
+--
+-- > isSearchPathSeparator a == (a == searchPathSeparator)
+isSearchPathSeparator :: WORD_NAME -> Bool
+isSearchPathSeparator (WTOR w) = C.isSearchPathSeparator w
+
+
+-- | File extension character
+--
+-- > extSeparator == '.'
+extSeparator :: WORD_NAME
+extSeparator = WTOR C.extSeparator
+
+
+-- | Is the character an extension character?
+--
+-- > isExtSeparator a == (a == extSeparator)
+isExtSeparator :: WORD_NAME -> Bool
+isExtSeparator (WTOR w) = C.isExtSeparator w
+
+
+---------------------------------------------------------------------
+-- 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 :: OSSTRING_NAME -> [FILEPATH_NAME]
+splitSearchPath (CTOR x) = fmap CTOR . C.splitSearchPath $ x
+
+
+
+------------------------
+-- Extension functions
+
+-- | 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_NAME -> (FILEPATH_NAME, OSSTRING_NAME)
+splitExtension (CTOR x) = bimap CTOR CTOR $ C.splitExtension x
+
+
+-- | 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_NAME -> OSSTRING_NAME
+takeExtension (CTOR x) = CTOR $ C.takeExtension x
+
+
+-- | 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_NAME -> OSSTRING_NAME -> FILEPATH_NAME
+(-<.>) = 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_NAME -> OSSTRING_NAME -> FILEPATH_NAME
+replaceExtension (CTOR path) (CTOR ext) = CTOR (C.replaceExtension path ext)
+
+
+-- | 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_NAME -> OSSTRING_NAME -> FILEPATH_NAME
+(<.>) = addExtension
+
+-- | Remove last extension, and the \".\" preceding it.
+--
+-- > dropExtension "/directory/path.ext" == "/directory/path"
+-- > dropExtension x == fst (splitExtension x)
+dropExtension :: FILEPATH_NAME -> FILEPATH_NAME
+dropExtension (CTOR x) = CTOR $ C.dropExtension x
+
+
+-- | 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_NAME -> OSSTRING_NAME -> FILEPATH_NAME
+addExtension (CTOR bs) (CTOR ext) = CTOR $ C.addExtension bs ext
+
+
+-- | Does the given filename have an extension?
+--
+-- > hasExtension "/directory/path.ext" == True
+-- > hasExtension "/directory/path" == False
+-- > null (takeExtension x) == not (hasExtension x)
+hasExtension :: FILEPATH_NAME -> Bool
+hasExtension (CTOR x) = C.hasExtension x
+
+-- | 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 :: OSSTRING_NAME -> FILEPATH_NAME -> Bool
+isExtensionOf (CTOR x) (CTOR y) = C.isExtensionOf x y
+
+-- | 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 :: OSSTRING_NAME -> FILEPATH_NAME -> Maybe FILEPATH_NAME
+stripExtension (CTOR bs) (CTOR x) = fmap CTOR $ C.stripExtension bs x
+
+-- | 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_NAME -> (FILEPATH_NAME, OSSTRING_NAME)
+splitExtensions (CTOR x) = bimap CTOR CTOR $ C.splitExtensions x
+
+
+-- | 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_NAME -> FILEPATH_NAME
+dropExtensions (CTOR x) = CTOR $ C.dropExtensions x
+
+
+-- | Get all extensions.
+--
+-- > takeExtensions "/directory/path.ext" == ".ext"
+-- > takeExtensions "file.tar.gz" == ".tar.gz"
+takeExtensions :: FILEPATH_NAME -> OSSTRING_NAME
+takeExtensions (CTOR x) = CTOR $ C.takeExtensions x
+
+-- | 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_NAME -> OSSTRING_NAME -> FILEPATH_NAME
+replaceExtensions (CTOR x) (CTOR y) = CTOR $ C.replaceExtensions x y
+
+
+------------------------
+-- Drive functions
+
+-- | 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_NAME -> (FILEPATH_NAME, FILEPATH_NAME)
+splitDrive (CTOR p) = bimap CTOR CTOR $ C.splitDrive p
+
+
+-- | 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_NAME -> FILEPATH_NAME -> FILEPATH_NAME
+joinDrive (CTOR a) (CTOR b) = CTOR $ C.joinDrive a b
+
+
+-- | Get the drive from a filepath.
+--
+-- > takeDrive x == fst (splitDrive x)
+takeDrive :: FILEPATH_NAME -> FILEPATH_NAME
+takeDrive (CTOR x) = CTOR $ C.takeDrive x
+
+
+-- | Delete the drive, if it exists.
+--
+-- > dropDrive x == snd (splitDrive x)
+dropDrive :: FILEPATH_NAME -> FILEPATH_NAME
+dropDrive (CTOR x) = CTOR $ C.dropDrive x
+
+
+-- | 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_NAME -> Bool
+hasDrive (CTOR x) = C.hasDrive x
+
+
+
+-- | 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_NAME -> Bool
+isDrive (CTOR x) = C.isDrive 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_NAME -> (FILEPATH_NAME, FILEPATH_NAME)
+splitFileName (CTOR x) = bimap CTOR CTOR $ C.splitFileName x
+
+
+-- | Set the filename.
+--
+-- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext"
+-- > Valid x => replaceFileName x (takeFileName x) == x
+replaceFileName :: FILEPATH_NAME -> OSSTRING_NAME -> FILEPATH_NAME
+replaceFileName (CTOR x) (CTOR y) = CTOR $ C.replaceFileName x y
+
+
+-- | 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_NAME -> FILEPATH_NAME
+dropFileName (CTOR x) = CTOR $ C.dropFileName x
+
+
+-- | 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_NAME -> FILEPATH_NAME
+takeFileName (CTOR x) = CTOR $ C.takeFileName x
+
+
+-- | 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_NAME -> FILEPATH_NAME
+takeBaseName (CTOR x) = CTOR $ C.takeBaseName x
+
+
+-- | 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_NAME -> OSSTRING_NAME -> FILEPATH_NAME
+replaceBaseName (CTOR path) (CTOR name) = CTOR $ C.replaceBaseName path name
+
+
+-- | Is an item either a directory or the last character a path separator?
+--
+-- > hasTrailingPathSeparator "test" == False
+-- > hasTrailingPathSeparator "test/" == True
+hasTrailingPathSeparator :: FILEPATH_NAME -> Bool
+hasTrailingPathSeparator (CTOR x) = C.hasTrailingPathSeparator 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_NAME -> FILEPATH_NAME
+addTrailingPathSeparator (CTOR bs) = CTOR $ C.addTrailingPathSeparator bs
+
+
+-- | Remove any trailing path separators
+--
+-- > dropTrailingPathSeparator "file/test/" == "file/test"
+-- > dropTrailingPathSeparator "/" == "/"
+-- > Windows: dropTrailingPathSeparator "\\" == "\\"
+-- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
+dropTrailingPathSeparator :: FILEPATH_NAME -> FILEPATH_NAME
+dropTrailingPathSeparator (CTOR x) = CTOR $ C.dropTrailingPathSeparator 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_NAME -> FILEPATH_NAME
+takeDirectory (CTOR x) = CTOR $ C.takeDirectory x
+
+
+-- | 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_NAME -> FILEPATH_NAME -> FILEPATH_NAME
+replaceDirectory (CTOR file) (CTOR dir) = CTOR $ C.replaceDirectory file dir
+
+
+-- | An alias for '</>'.
+combine :: FILEPATH_NAME -> FILEPATH_NAME -> FILEPATH_NAME
+combine (CTOR a) (CTOR b) = CTOR $ C.combine a 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_NAME -> FILEPATH_NAME -> FILEPATH_NAME
+(</>) = 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_NAME -> [FILEPATH_NAME]
+splitPath (CTOR bs) = fmap CTOR $ C.splitPath bs
+
+-- | 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_NAME -> [FILEPATH_NAME]
+splitDirectories (CTOR x) = fmap CTOR $ C.splitDirectories x
+
+-- | Join path elements back together.
+--
+-- > 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_NAME] -> FILEPATH_NAME
+joinPath = foldr (</>) (CTOR mempty)
+
+
+
+
+
+
+
+
+
+------------------------
+-- File name manipulations
+
+
+-- | 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_NAME -> FILEPATH_NAME -> Bool
+equalFilePath (CTOR p1) (CTOR p2) = C.equalFilePath p1 p2
+
+-- | 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_NAME -> FILEPATH_NAME -> FILEPATH_NAME
+makeRelative (CTOR root) (CTOR path) = CTOR $ C.makeRelative root path
+
+-- | 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_NAME -> FILEPATH_NAME
+normalise (CTOR filepath) = CTOR $ C.normalise filepath
+
+
+-- | 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_NAME -> Bool
+isValid (CTOR filepath) = C.isValid filepath
+
+
+-- | 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_NAME -> FILEPATH_NAME
+makeValid (CTOR path) = CTOR $ C.makeValid path
+
+
+-- | 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_NAME -> Bool
+isRelative (CTOR x) = C.isRelative x
+
+
+-- | @not . 'isRelative'@
+--
+-- > isAbsolute x == not (isRelative x)
+isAbsolute :: FILEPATH_NAME -> Bool
+isAbsolute (CTOR x) = C.isAbsolute x
diff --git a/System/AbstractFilePath/Data/ByteString/Short.hs b/System/AbstractFilePath/Data/ByteString/Short.hs
new file mode 100644
index 0000000..5a9accf
--- /dev/null
+++ b/System/AbstractFilePath/Data/ByteString/Short.hs
@@ -0,0 +1,1589 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE Unsafe #-}
+
+{-# OPTIONS_GHC -fno-warn-name-shadowing -fexpose-all-unfoldings #-}
+{-# OPTIONS_HADDOCK not-home #-}
+
+-- Not all architectures are forgiving of unaligned accesses; whitelist ones
+-- which are known not to trap (either to the kernel for emulation, or crash).
+#if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \
+ || ((defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) \
+ && defined(__ARM_FEATURE_UNALIGNED)) \
+ || defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \
+ || defined(powerpc64le_HOST_ARCH)
+#define SAFE_UNALIGNED 1
+#endif
+
+-- |
+-- Module : System.AbstractFilePath.Data.ByteString.Short
+-- Copyright : (c) Duncan Coutts 2012-2013, Julian Ospald 2022
+-- License : BSD-style
+--
+-- Maintainer : hasufell@posteo.de
+-- Stability : stable
+-- Portability : ghc only
+--
+-- A compact representation suitable for storing short byte strings in memory.
+--
+-- In typical use cases it can be imported alongside "Data.ByteString", e.g.
+--
+-- > import qualified Data.ByteString as B
+-- > import qualified Data.ByteString.Short as B
+-- > (ShortByteString, toShort, fromShort)
+--
+-- Other 'ShortByteString' operations clash with "Data.ByteString" or "Prelude"
+-- functions however, so they should be imported @qualified@ with a different
+-- alias e.g.
+--
+-- > import qualified Data.ByteString.Short as B.Short
+--
+module System.AbstractFilePath.Data.ByteString.Short (
+
+ -- * The @ShortByteString@ type
+
+ ShortByteString(..),
+
+ -- ** Memory overhead
+ -- | With GHC, the memory overheads are as follows, expressed in words and
+ -- in bytes (words are 4 and 8 bytes on 32 or 64bit machines respectively).
+ --
+ -- * 'B.ByteString' unshared: 8 words; 32 or 64 bytes.
+ --
+ -- * 'B.ByteString' shared substring: 4 words; 16 or 32 bytes.
+ --
+ -- * 'ShortByteString': 4 words; 16 or 32 bytes.
+ --
+ -- For the string data itself, both 'ShortByteString' and 'B.ByteString' use
+ -- one byte per element, rounded up to the nearest word. For example,
+ -- including the overheads, a length 10 'ShortByteString' would take
+ -- @16 + 12 = 28@ bytes on a 32bit platform and @32 + 16 = 48@ bytes on a
+ -- 64bit platform.
+ --
+ -- These overheads can all be reduced by 1 word (4 or 8 bytes) when the
+ -- 'ShortByteString' or 'B.ByteString' is unpacked into another constructor.
+ --
+ -- For example:
+ --
+ -- > data ThingId = ThingId {-# UNPACK #-} !Int
+ -- > {-# UNPACK #-} !ShortByteString
+ --
+ -- This will take @1 + 1 + 3@ words (the @ThingId@ constructor +
+ -- unpacked @Int@ + unpacked @ShortByteString@), plus the words for the
+ -- string data.
+
+ -- ** Heap fragmentation
+ -- | With GHC, the 'B.ByteString' representation uses /pinned/ memory,
+ -- meaning it cannot be moved by the GC. This is usually the right thing to
+ -- do for larger strings, but for small strings using pinned memory can
+ -- lead to heap fragmentation which wastes space. The 'ShortByteString'
+ -- type (and the @Text@ type from the @text@ package) use /unpinned/ memory
+ -- so they do not contribute to heap fragmentation. In addition, with GHC,
+ -- small unpinned strings are allocated in the same way as normal heap
+ -- allocations, rather than in a separate pinned area.
+
+ -- * Introducing and eliminating 'ShortByteString's
+ empty,
+ singleton,
+ pack,
+ unpack,
+ fromShort,
+ toShort,
+
+ -- * Basic interface
+ snoc,
+ cons,
+ append,
+ last,
+ tail,
+ uncons,
+ head,
+ init,
+ unsnoc,
+ null,
+ length,
+
+ -- * Transforming ShortByteStrings
+ map,
+ reverse,
+ intercalate,
+
+ -- * Reducing 'ShortByteString's (folds)
+ foldl,
+ foldl',
+ foldl1,
+ foldl1',
+
+ foldr,
+ foldr',
+ foldr1,
+ foldr1',
+
+ -- ** Special folds
+ all,
+ any,
+ concat,
+
+ -- ** Generating and unfolding ByteStrings
+ replicate,
+ unfoldr,
+ unfoldrN,
+
+ -- * Substrings
+
+ -- ** Breaking strings
+ take,
+ takeEnd,
+ takeWhileEnd,
+ takeWhile,
+ drop,
+ dropEnd,
+ dropWhile,
+ dropWhileEnd,
+ breakEnd,
+ break,
+ span,
+ spanEnd,
+ splitAt,
+ split,
+ splitWith,
+ stripSuffix,
+ stripPrefix,
+
+ -- * Predicates
+ isInfixOf,
+ isPrefixOf,
+ isSuffixOf,
+
+ -- ** Search for arbitrary substrings
+ breakSubstring,
+
+ -- * Searching ShortByteStrings
+
+ -- ** Searching by equality
+ elem,
+
+ -- ** Searching with a predicate
+ find,
+ filter,
+ partition,
+
+ -- * Indexing ShortByteStrings
+ index,
+ indexMaybe,
+ (!?),
+ elemIndex,
+ elemIndices,
+ count,
+ findIndex,
+ findIndices,
+
+ -- * Low level conversions
+ -- ** Packing 'Foreign.C.String.CString's and pointers
+ packCString,
+ packCStringLen,
+
+ -- ** Using ShortByteStrings as 'Foreign.C.String.CString's
+ useAsCString,
+ useAsCStringLen,
+ ) where
+
+import Prelude ()
+#if MIN_VERSION_bytestring(0,11,3)
+import Data.ByteString.Short.Internal
+#else
+#if !MIN_VERSION_base(4,11,0)
+import System.IO.Unsafe
+ ( unsafeDupablePerformIO )
+#endif
+import Data.ByteString.Short.Internal (
+ ShortByteString(..)
+#if !MIN_VERSION_bytestring(0,10,9)
+ , copyToPtr
+ , createFromPtr
+#endif
+ )
+import Data.ByteString.Short
+#if MIN_VERSION_bytestring(0,10,9)
+import Data.ByteString.Internal
+ ( checkedAdd
+ )
+#endif
+
+import Data.Bits
+ ( FiniteBits (finiteBitSize)
+ , shiftL
+#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED)
+ , shiftR
+#endif
+ , (.&.)
+ , (.|.)
+ )
+import Control.Applicative
+ ( pure )
+import Control.Exception
+ ( assert
+#if !MIN_VERSION_bytestring(0,10,10)
+ , throwIO
+#endif
+ ,
+ )
+import Control.Monad
+ ( (>>) )
+#if !MIN_VERSION_bytestring(0,10,10)
+import Foreign.C.String
+ ( CString
+ , CStringLen
+ )
+#endif
+#if !MIN_VERSION_base(4,11,0)
+import Foreign.Ptr
+ ( plusPtr )
+import Foreign.Marshal.Alloc
+ ( free
+ , mallocBytes
+ )
+#endif
+#if !MIN_VERSION_bytestring(0,10,9)
+import Foreign.Marshal.Alloc
+ ( allocaBytes )
+import Foreign.Storable
+ ( pokeByteOff )
+#endif
+import GHC.Exts
+ ( Int(I#), Int#
+ , State#
+ , ByteArray#, MutableByteArray#
+ , newByteArray#
+ , copyMutableByteArray#
+#if MIN_VERSION_base(4,11,0)
+ , compareByteArrays#
+#endif
+ , indexWord8Array#
+ , writeWord8Array#
+ , unsafeFreezeByteArray#
+#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED)
+ ,writeWord64Array#
+ ,indexWord8ArrayAsWord64#
+#endif
+ , setByteArray#
+ , indexWord8Array#
+ , writeWord8Array#
+ , unsafeFreezeByteArray#
+ )
+import GHC.ST
+ ( ST(ST)
+ , runST
+ )
+import GHC.Stack.Types
+ ( HasCallStack )
+import GHC.Word
+import Prelude
+ ( Eq(..), Ord(..)
+ , ($), ($!), error, (++), (.), (||)
+ , String
+ , Bool(..), (&&), otherwise
+ , (+), (-), fromIntegral
+ , (*)
+ , (^)
+ , return
+ , Maybe(..)
+ , not
+ , snd
+#if !MIN_VERSION_bytestring(0,10,9)
+ , show
+#endif
+#if !MIN_VERSION_bytestring(0,10,10)
+ , userError
+ , IO
+#endif
+ )
+
+#if !MIN_VERSION_bytestring(0,10,10)
+import qualified Data.ByteString.Internal as BS
+#endif
+
+import qualified Data.Foldable as Foldable
+import qualified Data.List as List
+import qualified GHC.Exts
+
+
+------------------------------------------------------------------------
+-- Simple operations
+
+#if !MIN_VERSION_bytestring(0,11,0)
+-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:
+--
+-- > 0 <= n < length bs
+--
+-- @since 0.11.0.0
+indexMaybe :: ShortByteString -> Int -> Maybe Word8
+indexMaybe sbs i
+ | i >= 0 && i < length sbs = Just $! unsafeIndex sbs i
+ | otherwise = Nothing
+{-# INLINE indexMaybe #-}
+
+-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:
+--
+-- > 0 <= n < length bs
+--
+-- @since 0.11.0.0
+(!?) :: ShortByteString -> Int -> Maybe Word8
+(!?) = indexMaybe
+{-# INLINE (!?) #-}
+#endif
+
+unsafeIndex :: ShortByteString -> Int -> Word8
+unsafeIndex sbs = indexWord8Array (asBA sbs)
+
+
+------------------------------------------------------------------------
+-- Internal utils
+
+asBA :: ShortByteString -> BA
+asBA (SBS ba#) = BA# ba#
+
+create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
+create len fill =
+ runST $ do
+ mba <- newByteArray len
+ fill mba
+ BA# ba# <- unsafeFreezeByteArray mba
+ return (SBS ba#)
+{-# INLINE create #-}
+
+-- | Given the maximum size needed and a function to make the contents
+-- of a ShortByteString, createAndTrim makes the 'ShortByteString'.
+-- The generating function is required to return the actual final size
+-- (<= the maximum size) and the result value. The resulting byte array
+-- is realloced to this size.
+createAndTrim :: Int -> (forall s. MBA s -> ST s (Int, a)) -> (ShortByteString, a)
+createAndTrim l fill =
+ runST $ do
+ mba <- newByteArray l
+ (l', res) <- fill mba
+ if assert (l' <= l) $ l' >= l
+ then do
+ BA# ba# <- unsafeFreezeByteArray mba
+ return (SBS ba#, res)
+ else do
+ mba2 <- newByteArray l'
+ copyMutableByteArray mba 0 mba2 0 l'
+ BA# ba# <- unsafeFreezeByteArray mba2
+ return (SBS ba#, res)
+{-# INLINE createAndTrim #-}
+
+createAndTrim' :: Int -> (forall s. MBA s -> ST s Int) -> ShortByteString
+createAndTrim' l fill =
+ runST $ do
+ mba <- newByteArray l
+ l' <- fill mba
+ if assert (l' <= l) $ l' >= l
+ then do
+ BA# ba# <- unsafeFreezeByteArray mba
+ return (SBS ba#)
+ else do
+ mba2 <- newByteArray l'
+ copyMutableByteArray mba 0 mba2 0 l'
+ BA# ba# <- unsafeFreezeByteArray mba2
+ return (SBS ba#)
+{-# INLINE createAndTrim' #-}
+
+createAndTrim'' :: Int -> (forall s. MBA s -> MBA s -> ST s (Int, Int)) -> (ShortByteString, ShortByteString)
+createAndTrim'' l fill =
+ runST $ do
+ mba1 <- newByteArray l
+ mba2 <- newByteArray l
+ (l1, l2) <- fill mba1 mba2
+ sbs1 <- freeze' l1 mba1
+ sbs2 <- freeze' l2 mba2
+ pure (sbs1, sbs2)
+ where
+ freeze' :: Int -> MBA s -> ST s ShortByteString
+ freeze' l' mba =
+ if assert (l' <= l) $ l' >= l
+ then do
+ BA# ba# <- unsafeFreezeByteArray mba
+ return (SBS ba#)
+ else do
+ mba2 <- newByteArray l'
+ copyMutableByteArray mba 0 mba2 0 l'
+ BA# ba# <- unsafeFreezeByteArray mba2
+ return (SBS ba#)
+{-# INLINE createAndTrim'' #-}
+
+
+------------------------------------------------------------------------
+-- Conversion to and from ByteString
+
+-- | /O(1)/ Convert a 'Word8' into a 'ShortByteString'
+--
+-- @since 0.11.3.0
+singleton :: Word8 -> ShortByteString
+singleton = \w -> create 1 (\mba -> writeWord8Array mba 0 w)
+
+
+------------------------------------------------------------------------
+-- Appending and concatenation
+
+append :: ShortByteString -> ShortByteString -> ShortByteString
+append src1 src2 =
+ let !len1 = length src1
+ !len2 = length src2
+ in create (len1 + len2) $ \dst -> do
+ copyByteArray (asBA src1) 0 dst 0 len1
+ copyByteArray (asBA src2) 0 dst len1 len2
+
+concat :: [ShortByteString] -> ShortByteString
+concat = \sbss ->
+ create (totalLen 0 sbss) (\dst -> copy dst 0 sbss)
+ where
+ totalLen !acc [] = acc
+ totalLen !acc (sbs: sbss) = totalLen (acc + length sbs) sbss
+
+ copy :: MBA s -> Int -> [ShortByteString] -> ST s ()
+ copy !_ !_ [] = return ()
+ copy !dst !off (src : sbss) = do
+ let !len = length src
+ copyByteArray (asBA src) 0 dst off len
+ copy dst (off + len) sbss
+
+-- ---------------------------------------------------------------------
+-- Basic interface
+
+infixr 5 `cons` --same as list (:)
+infixl 5 `snoc`
+
+-- | /O(n)/ Append a byte to the end of a 'ShortByteString'
+--
+-- Note: copies the entire byte array
+--
+-- @since 0.11.3.0
+snoc :: ShortByteString -> Word8 -> ShortByteString
+snoc = \sbs c -> let l = length sbs
+ nl = l + 1
+ in create nl $ \mba -> do
+ copyByteArray (asBA sbs) 0 mba 0 l
+ writeWord8Array mba l c
+
+-- | /O(n)/ 'cons' is analogous to (:) for lists.
+--
+-- Note: copies the entire byte array
+--
+-- @since 0.11.3.0
+cons :: Word8 -> ShortByteString -> ShortByteString
+cons c = \sbs -> let l = length sbs
+ nl = l + 1
+ in create nl $ \mba -> do
+ writeWord8Array mba 0 c
+ copyByteArray (asBA sbs) 0 mba 1 l
+
+-- | /O(1)/ Extract the last element of a ShortByteString, which must be finite and non-empty.
+-- An exception will be thrown in the case of an empty ShortByteString.
+--
+-- This is a partial function, consider using 'unsnoc' instead.
+--
+-- @since 0.11.3.0
+last :: HasCallStack => ShortByteString -> Word8
+last = \sbs -> case null sbs of
+ True -> errorEmptySBS "last"
+ False -> indexWord8Array (asBA sbs) (length sbs - 1)
+
+-- | /O(n)/ Extract the elements after the head of a ShortByteString, which must be non-empty.
+-- An exception will be thrown in the case of an empty ShortByteString.
+--
+-- This is a partial function, consider using 'uncons' instead.
+--
+-- Note: copies the entire byte array
+--
+-- @since 0.11.3.0
+tail :: HasCallStack => ShortByteString -> ShortByteString
+tail = \sbs ->
+ let l = length sbs
+ nl = l - 1
+ in case null sbs of
+ True -> errorEmptySBS "tail"
+ False -> create nl $ \mba -> copyByteArray (asBA sbs) 1 mba 0 nl
+
+-- | /O(n)/ Extract the head and tail of a ByteString, returning Nothing
+-- if it is empty.
+--
+-- @since 0.11.3.0
+uncons :: ShortByteString -> Maybe (Word8, ShortByteString)
+uncons = \sbs ->
+ let l = length sbs
+ nl = l - 1
+ in if | l <= 0 -> Nothing
+ | otherwise -> let h = indexWord8Array (asBA sbs) 0
+ t = create nl $ \mba -> copyByteArray (asBA sbs) 1 mba 0 nl
+ in Just (h, t)
+
+-- | /O(1)/ Extract the first element of a ShortByteString, which must be non-empty.
+-- An exception will be thrown in the case of an empty ShortByteString.
+--
+-- This is a partial function, consider using 'uncons' instead.
+--
+-- @since 0.11.3.0
+head :: HasCallStack => ShortByteString -> Word8
+head = \sbs -> case null sbs of
+ True -> errorEmptySBS "head"
+ False -> indexWord8Array (asBA sbs) 0
+
+-- | /O(n)/ Return all the elements of a 'ShortByteString' except the last one.
+-- An exception will be thrown in the case of an empty ShortByteString.
+--
+-- This is a partial function, consider using 'unsnoc' instead.
+--
+-- Note: copies the entire byte array
+--
+-- @since 0.11.3.0
+init :: HasCallStack => ShortByteString -> ShortByteString
+init = \sbs ->
+ let l = length sbs
+ nl = l - 1
+ in case null sbs of
+ True -> errorEmptySBS "init"
+ False -> create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl
+
+-- | /O(n)/ Extract the 'init' and 'last' of a ByteString, returning Nothing
+-- if it is empty.
+--
+-- @since 0.11.3.0
+unsnoc :: ShortByteString -> Maybe (ShortByteString, Word8)
+unsnoc = \sbs ->
+ let l = length sbs
+ nl = l - 1
+ in if | l <= 0 -> Nothing
+ | otherwise -> let l' = indexWord8Array (asBA sbs) (l - 1)
+ i = create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl
+ in Just (i, l')
+
+
+-- ---------------------------------------------------------------------
+-- Transformations
+
+-- | /O(n)/ 'map' @f xs@ is the ShortByteString obtained by applying @f@ to each
+-- element of @xs@.
+--
+-- @since 0.11.3.0
+map :: (Word8 -> Word8) -> ShortByteString -> ShortByteString
+map f = \sbs ->
+ let l = length sbs
+ ba = asBA sbs
+ in create l (\mba -> go ba mba 0 l)
+ where
+ go :: BA -> MBA s -> Int -> Int -> ST s ()
+ go !ba !mba !i !l
+ | i >= l = return ()
+ | otherwise = do
+ let w = indexWord8Array ba i
+ writeWord8Array mba i (f w)
+ go ba mba (i+1) l
+
+
+-- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order.
+--
+-- @since 0.11.3.0
+reverse :: ShortByteString -> ShortByteString
+reverse = \sbs ->
+ let l = length sbs
+ ba = asBA sbs
+-- https://gitlab.haskell.org/ghc/ghc/-/issues/21015
+#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED)
+ in create l (\mba -> go ba mba l)
+ where
+ go :: forall s. BA -> MBA s -> Int -> ST s ()
+ go !ba !mba !l = do
+ -- this is equivalent to: (q, r) = l `quotRem` 8
+ let q = l `shiftR` 3
+ r = l .&. 7
+ i' <- goWord8Chunk 0 r
+ goWord64Chunk i' 0 q
+ where
+
+ goWord64Chunk :: Int -> Int -> Int -> ST s ()
+ goWord64Chunk !off !i' !cl = loop i'
+ where
+ loop :: Int -> ST s ()
+ loop !i
+ | i >= cl = return ()
+ | otherwise = do
+ let w = indexWord8ArrayAsWord64 ba (off + (i * 8))
+ writeWord64Array mba (cl - 1 - i) (byteSwap64 w)
+ loop (i+1)
+
+ goWord8Chunk :: Int -> Int -> ST s Int
+ goWord8Chunk !i' !cl = loop i'
+ where
+ loop :: Int -> ST s Int
+ loop !i
+ | i >= cl = return i
+ | otherwise = do
+ let w = indexWord8Array ba i
+ writeWord8Array mba (l - 1 - i) w
+ loop (i+1)
+#else
+ in create l (\mba -> go ba mba 0 l)
+ where
+ go :: BA -> MBA s -> Int -> Int -> ST s ()
+ go !ba !mba !i !l
+ | i >= l = return ()
+ | otherwise = do
+ let w = indexWord8Array ba i
+ writeWord8Array mba (l - 1 - i) w
+ go ba mba (i+1) l
+#endif
+
+
+-- | /O(n)/ The 'intercalate' function takes a 'ShortByteString' and a list of
+-- 'ShortByteString's and concatenates the list after interspersing the first
+-- argument between each element of the list.
+--
+-- @since 0.11.3.0
+intercalate :: ShortByteString -> [ShortByteString] -> ShortByteString
+intercalate sep = \case
+ [] -> empty
+ [x] -> x -- This branch exists for laziness, not speed
+ (sbs:t) -> let !totalLen = List.foldl' (\acc chunk -> acc +! length sep +! length chunk) (length sbs) t
+ in create totalLen (\mba ->
+ let !l = length sbs
+ in copyByteArray (asBA sbs) 0 mba 0 l >> go mba l t)
+ where
+ ba = asBA sep
+ lba = length sep
+
+ go :: MBA s -> Int -> [ShortByteString] -> ST s ()
+ go _ _ [] = pure ()
+ go mba !off (chunk:chunks) = do
+ let lc = length chunk
+ copyByteArray ba 0 mba off lba
+ copyByteArray (asBA chunk) 0 mba (off + lba) lc
+ go mba (off + lc + lba) chunks
+ (+!) = checkedAdd "Short.intercalate"
+
+
+-- ---------------------------------------------------------------------
+-- Reducing 'ByteString's
+
+-- | 'foldl', applied to a binary operator, a starting value (typically
+-- the left-identity of the operator), and a ShortByteString, reduces the
+-- ShortByteString using the binary operator, from left to right.
+--
+-- @since 0.11.3.0
+foldl :: (a -> Word8 -> a) -> a -> ShortByteString -> a
+foldl f v = List.foldl f v . unpack
+
+-- | 'foldl'' is like 'foldl', but strict in the accumulator.
+--
+-- @since 0.11.3.0
+foldl' :: (a -> Word8 -> a) -> a -> ShortByteString -> a
+foldl' f v = List.foldl' f v . unpack
+
+-- | 'foldr', applied to a binary operator, a starting value
+-- (typically the right-identity of the operator), and a ShortByteString,
+-- reduces the ShortByteString using the binary operator, from right to left.
+--
+-- @since 0.11.3.0
+foldr :: (Word8 -> a -> a) -> a -> ShortByteString -> a
+foldr f v = List.foldr f v . unpack
+
+-- | 'foldr'' is like 'foldr', but strict in the accumulator.
+--
+-- @since 0.11.3.0
+foldr' :: (Word8 -> a -> a) -> a -> ShortByteString -> a
+foldr' k v = Foldable.foldr' k v . unpack
+
+-- | 'foldl1' is a variant of 'foldl' that has no starting value
+-- argument, and thus must be applied to non-empty 'ShortByteString's.
+-- An exception will be thrown in the case of an empty ShortByteString.
+--
+-- @since 0.11.3.0
+foldl1 :: HasCallStack => (Word8 -> Word8 -> Word8) -> ShortByteString -> Word8
+foldl1 k = List.foldl1 k . unpack
+
+-- | 'foldl1'' is like 'foldl1', but strict in the accumulator.
+-- An exception will be thrown in the case of an empty ShortByteString.
+--
+-- @since 0.11.3.0
+foldl1' :: HasCallStack => (Word8 -> Word8 -> Word8) -> ShortByteString -> Word8
+foldl1' k = List.foldl1' k . unpack
+
+-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,
+-- and thus must be applied to non-empty 'ShortByteString's
+-- An exception will be thrown in the case of an empty ShortByteString.
+--
+-- @since 0.11.3.0
+foldr1 :: HasCallStack => (Word8 -> Word8 -> Word8) -> ShortByteString -> Word8
+foldr1 k = List.foldr1 k . unpack
+
+-- | 'foldr1'' is a variant of 'foldr1', but is strict in the
+-- accumulator.
+--
+-- @since 0.11.3.0
+foldr1' :: HasCallStack => (Word8 -> Word8 -> Word8) -> ShortByteString -> Word8
+foldr1' k = \sbs -> if null sbs then errorEmptySBS "foldr1'" else foldr' k (last sbs) (init sbs)
+
+
+
+-- ---------------------------------------------------------------------
+-- Special folds
+
+-- | /O(n)/ Applied to a predicate and a 'ShortByteString', 'all' determines
+-- if all elements of the 'ShortByteString' satisfy the predicate.
+--
+-- @since 0.11.3.0
+all :: (Word8 -> Bool) -> ShortByteString -> Bool
+all k = \sbs ->
+ let l = length sbs
+ ba = asBA sbs
+ w = indexWord8Array ba
+ go !n | n >= l = True
+ | otherwise = k (w n) && go (n + 1)
+ in go 0
+
+
+-- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if
+-- any element of the 'ByteString' satisfies the predicate.
+--
+-- @since 0.11.3.0
+any :: (Word8 -> Bool) -> ShortByteString -> Bool
+any k = \sbs ->
+ let l = length sbs
+ ba = asBA sbs
+ w = indexWord8Array ba
+ go !n | n >= l = False
+ | otherwise = k (w n) || go (n + 1)
+ in go 0
+
+
+
+-- ---------------------------------------------------------------------
+-- Substrings
+
+-- | /O(n)/ 'take' @n@, applied to a ShortByteString @xs@, returns the prefix
+-- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.
+--
+-- Note: copies the entire byte array
+--
+-- @since 0.11.3.0
+take :: Int -> ShortByteString -> ShortByteString
+take = \n -> \sbs -> let sl = length sbs
+ in if | n >= sl -> sbs
+ | n <= 0 -> empty
+ | otherwise ->
+ create n $ \mba -> copyByteArray (asBA sbs) 0 mba 0 n
+
+-- | Similar to 'Prelude.takeWhile',
+-- returns the longest (possibly empty) prefix of elements
+-- satisfying the predicate.
+--
+-- @since 0.11.3.0
+takeWhile :: (Word8 -> Bool) -> ShortByteString -> ShortByteString
+takeWhile f = \sbs -> take (findIndexOrLength (not . f) sbs) sbs
+
+-- | /O(n)/ @'takeEnd' n xs@ is equivalent to @'drop' ('length' xs - n) xs@.
+-- Takes @n@ elements from end of bytestring.
+--
+-- >>> takeEnd 3 "abcdefg"
+-- "efg"
+-- >>> takeEnd 0 "abcdefg"
+-- ""
+-- >>> takeEnd 4 "abc"
+-- "abc"
+--
+-- @since 0.11.3.0
+takeEnd :: Int -> ShortByteString -> ShortByteString
+takeEnd n = \sbs -> let sl = length sbs
+ in if | n >= sl -> sbs
+ | n <= 0 -> empty
+ | otherwise -> create n $ \mba -> copyByteArray (asBA sbs) (max 0 (sl - n)) mba 0 n
+
+
+-- | Returns the longest (possibly empty) suffix of elements
+-- satisfying the predicate.
+--
+-- @'takeWhileEnd' p@ is equivalent to @'reverse' . 'takeWhile' p . 'reverse'@.
+--
+-- @since 0.11.3.0
+takeWhileEnd :: (Word8 -> Bool) -> ShortByteString -> ShortByteString
+takeWhileEnd f = \sbs -> drop (findFromEndUntil (not . f) sbs) sbs
+
+-- | /O(n)/ 'drop' @n@ @xs@ returns the suffix of @xs@ after the first n elements, or @[]@ if @n > 'length' xs@.
+--
+-- Note: copies the entire byte array
+--
+-- @since 0.11.3.0
+drop :: Int -> ShortByteString -> ShortByteString
+drop = \n -> \sbs ->
+ let len = length sbs
+ in if | n <= 0 -> sbs
+ | n >= len -> empty
+ | otherwise ->
+ let newLen = len - n
+ in create newLen $ \mba -> copyByteArray (asBA sbs) n mba 0 newLen
+
+-- | /O(n)/ @'dropEnd' n xs@ is equivalent to @'take' ('length' xs - n) xs@.
+-- Drops @n@ elements from end of bytestring.
+--
+-- >>> dropEnd 3 "abcdefg"
+-- "abcd"
+-- >>> dropEnd 0 "abcdefg"
+-- "abcdefg"
+-- >>> dropEnd 4 "abc"
+-- ""
+--
+-- @since 0.11.3.0
+dropEnd :: Int -> ShortByteString -> ShortByteString
+dropEnd n = \sbs -> let sl = length sbs
+ nl = sl - n
+ in if | n >= sl -> empty
+ | n <= 0 -> sbs
+ | otherwise -> create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl
+
+-- | Similar to 'Prelude.dropWhile',
+-- drops the longest (possibly empty) prefix of elements
+-- satisfying the predicate and returns the remainder.
+--
+-- Note: copies the entire byte array
+--
+-- @since 0.11.3.0
+dropWhile :: (Word8 -> Bool) -> ShortByteString -> ShortByteString
+dropWhile f = \sbs -> drop (findIndexOrLength (not . f) sbs) sbs
+
+-- | Similar to 'Prelude.dropWhileEnd',
+-- drops the longest (possibly empty) suffix of elements
+-- satisfying the predicate and returns the remainder.
+--
+-- @'dropWhileEnd' p@ is equivalent to @'reverse' . 'dropWhile' p . 'reverse'@.
+--
+-- @since 0.11.3.0
+dropWhileEnd :: (Word8 -> Bool) -> ShortByteString -> ShortByteString
+dropWhileEnd f = \sbs -> take (findFromEndUntil (not . f) sbs) sbs
+
+-- | Returns the longest (possibly empty) suffix of elements which __do not__
+-- satisfy the predicate and the remainder of the string.
+--
+-- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('takeWhileEnd' (not . p) &&& 'dropWhileEnd' (not . p))@.
+--
+-- @since 0.11.3.0
+breakEnd :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)
+breakEnd p = \sbs -> splitAt (findFromEndUntil p sbs) sbs
+
+-- | Similar to 'Prelude.break',
+-- returns the longest (possibly empty) prefix of elements which __do not__
+-- satisfy the predicate and the remainder of the string.
+--
+-- 'break' @p@ is equivalent to @'span' (not . p)@ and to @('takeWhile' (not . p) &&& 'dropWhile' (not . p))@.
+--
+-- @since 0.11.3.0
+break :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)
+break = \p -> \sbs -> case findIndexOrLength p sbs of n -> (take n sbs, drop n sbs)
+
+-- | Similar to 'Prelude.span',
+-- returns the longest (possibly empty) prefix of elements
+-- satisfying the predicate and the remainder of the string.
+--
+-- 'span' @p@ is equivalent to @'break' (not . p)@ and to @('takeWhile' p &&& 'dropWhile' p)@.
+--
+-- @since 0.11.3.0
+span :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)
+span p = break (not . p)
+
+-- | Returns the longest (possibly empty) suffix of elements
+-- satisfying the predicate and the remainder of the string.
+--
+-- 'spanEnd' @p@ is equivalent to @'breakEnd' (not . p)@ and to @('takeWhileEnd' p &&& 'dropWhileEnd' p)@.
+--
+-- We have
+--
+-- > spanEnd (not . isSpace) "x y z" == ("x y ", "z")
+--
+-- and
+--
+-- > spanEnd (not . isSpace) sbs
+-- > ==
+-- > let (x, y) = span (not . isSpace) (reverse sbs) in (reverse y, reverse x)
+--
+-- @since 0.11.3.0
+spanEnd :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)
+spanEnd p = \sbs -> splitAt (findFromEndUntil (not . p) sbs) sbs
+
+-- | /O(n)/ 'splitAt' @n sbs@ is equivalent to @('take' n sbs, 'drop' n sbs)@.
+--
+-- Note: copies the substrings
+--
+-- @since 0.11.3.0
+splitAt :: Int -> ShortByteString -> (ShortByteString, ShortByteString)
+splitAt n = \sbs -> if
+ | n <= 0 -> (empty, sbs)
+ | otherwise ->
+ let slen = length sbs
+ in if | n >= length sbs -> (sbs, empty)
+ | otherwise ->
+ let llen = min slen (max 0 n)
+ rlen = max 0 (slen - max 0 n)
+ lsbs = create llen $ \mba -> copyByteArray (asBA sbs) 0 mba 0 llen
+ rsbs = create rlen $ \mba -> copyByteArray (asBA sbs) n mba 0 rlen
+ in (lsbs, rsbs)
+
+-- | /O(n)/ Break a 'ShortByteString' into pieces separated by the byte
+-- argument, consuming the delimiter. I.e.
+--
+-- > split 10 "a\nb\nd\ne" == ["a","b","d","e"] -- fromEnum '\n' == 10
+-- > split 97 "aXaXaXa" == ["","X","X","X",""] -- fromEnum 'a' == 97
+-- > split 120 "x" == ["",""] -- fromEnum 'x' == 120
+-- > split undefined "" == [] -- and not [""]
+--
+-- and
+--
+-- > intercalate [c] . split c == id
+-- > split == splitWith . (==)
+--
+-- Note: copies the substrings
+--
+-- @since 0.11.3.0
+split :: Word8 -> ShortByteString -> [ShortByteString]
+split w = splitWith (== w)
+
+
+-- | /O(n)/ Splits a 'ShortByteString' into components delimited by
+-- separators, where the predicate returns True for a separator element.
+-- The resulting components do not contain the separators. Two adjacent
+-- separators result in an empty component in the output. eg.
+--
+-- > splitWith (==97) "aabbaca" == ["","","bb","c",""] -- fromEnum 'a' == 97
+-- > splitWith undefined "" == [] -- and not [""]
+--
+-- @since 0.11.3.0
+splitWith :: (Word8 -> Bool) -> ShortByteString -> [ShortByteString]
+splitWith p = \sbs -> if
+ | null sbs -> []
+ | otherwise -> go sbs
+ where
+ go sbs'
+ | null sbs' = [empty]
+ | otherwise =
+ case break p sbs' of
+ (a, b)
+ | null b -> [a]
+ | otherwise -> a : go (tail b)
+
+
+-- | /O(n)/ The 'stripSuffix' function takes two ShortByteStrings and returns 'Just'
+-- the remainder of the second iff the first is its suffix, and otherwise
+-- 'Nothing'.
+--
+-- @since 0.11.3.0
+stripSuffix :: ShortByteString -> ShortByteString -> Maybe ShortByteString
+stripSuffix sbs1 = \sbs2 -> do
+ let l1 = length sbs1
+ l2 = length sbs2
+ if | isSuffixOf sbs1 sbs2 ->
+ if null sbs1
+ then Just sbs2
+ else Just $! create (l2 - l1) $ \dst -> do
+ copyByteArray (asBA sbs2) 0 dst 0 (l2 - l1)
+ | otherwise -> Nothing
+
+-- | /O(n)/ The 'stripPrefix' function takes two ShortByteStrings and returns 'Just'
+-- the remainder of the second iff the first is its prefix, and otherwise
+-- 'Nothing'.
+--
+-- @since 0.11.3.0
+stripPrefix :: ShortByteString -> ShortByteString -> Maybe ShortByteString
+stripPrefix sbs1 = \sbs2 -> do
+ let l1 = length sbs1
+ l2 = length sbs2
+ if | isPrefixOf sbs1 sbs2 ->
+ if null sbs1
+ then Just sbs2
+ else Just $! create (l2 - l1) $ \dst -> do
+ copyByteArray (asBA sbs2) l1 dst 0 (l2 - l1)
+ | otherwise -> Nothing
+
+
+-- ---------------------------------------------------------------------
+-- Unfolds and replicates
+
+
+-- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@
+-- the value of every element. The following holds:
+--
+-- > replicate w c = unfoldr w (\u -> Just (u,u)) c
+--
+-- @since 0.11.3.0
+replicate :: Int -> Word8 -> ShortByteString
+replicate w c
+ | w <= 0 = empty
+ | otherwise = create w (\mba -> setByteArray mba 0 w (fromIntegral c))
+
+
+-- | /O(n)/, where /n/ is the length of the result. The 'unfoldr'
+-- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a
+-- ShortByteString from a seed value. The function takes the element and
+-- returns 'Nothing' if it is done producing the ShortByteString or returns
+-- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string,
+-- and @b@ is the seed value for further production.
+--
+-- This function is not efficient/safe. It will build a list of @[Word8]@
+-- and run the generator until it returns `Nothing`, otherwise recurse infinitely,
+-- then finally create a 'ShortByteString'.
+--
+-- If you know the maximum length, consider using 'unfoldrN'.
+--
+-- Examples:
+--
+-- > unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0
+-- > == pack [0, 1, 2, 3, 4, 5]
+--
+-- @since 0.11.3.0
+unfoldr :: (a -> Maybe (Word8, a)) -> a -> ShortByteString
+unfoldr f = \x0 -> packBytesRev $ go x0 []
+ where
+ go x words' = case f x of
+ Nothing -> words'
+ Just (w, x') -> go x' (w:words')
+
+-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ShortByteString from a seed
+-- value. However, the length of the result is limited by the first
+-- argument to 'unfoldrN'. This function is more efficient than 'unfoldr'
+-- when the maximum length of the result is known.
+--
+-- The following equation relates 'unfoldrN' and 'unfoldr':
+--
+-- > fst (unfoldrN n f s) == take n (unfoldr f s)
+--
+-- @since 0.11.3.0
+unfoldrN :: forall a. Int -> (a -> Maybe (Word8, a)) -> a -> (ShortByteString, Maybe a)
+unfoldrN i f = \x0 ->
+ if | i < 0 -> (empty, Just x0)
+ | otherwise -> createAndTrim i $ \mba -> go mba x0 0
+
+ where
+ go :: forall s. MBA s -> a -> Int -> ST s (Int, Maybe a)
+ go !mba !x !n = go' x n
+ where
+ go' :: a -> Int -> ST s (Int, Maybe a)
+ go' !x' !n'
+ | n' == i = return (n', Just x')
+ | otherwise = case f x' of
+ Nothing -> return (n', Nothing)
+ Just (w, x'') -> do
+ writeWord8Array mba n' w
+ go' x'' (n'+1)
+
+
+
+-- --------------------------------------------------------------------
+-- Predicates
+
+-- | Check whether one string is a substring of another.
+--
+-- @since 0.11.3.0
+isInfixOf :: ShortByteString -> ShortByteString -> Bool
+isInfixOf sbs = \s -> null sbs || not (null $ snd $ (GHC.Exts.inline breakSubstring) sbs s)
+
+-- |/O(n)/ The 'isPrefixOf' function takes two ShortByteStrings and returns 'True'
+--
+-- @since 0.11.3.0
+isPrefixOf :: ShortByteString -> ShortByteString -> Bool
+#if MIN_VERSION_base(4,11,0)
+isPrefixOf sbs1 = \sbs2 -> do
+ let l1 = length sbs1
+ l2 = length sbs2
+ if | l1 == 0 -> True
+ | l2 < l1 -> False
+ | otherwise ->
+ let i = compareByteArraysOff (asBA sbs1) 0 (asBA sbs2) 0 l1
+ in i == 0
+#else
+isPrefixOf sbs1 sbs2 =
+ let l1 = length sbs1
+ l2 = length sbs2
+ in if | l1 == 0 -> True
+ | l2 < l1 -> False
+ | otherwise -> unsafeDupablePerformIO $ do
+ p1 <- mallocBytes l1
+ p2 <- mallocBytes l2
+ copyToPtr sbs1 0 p1 l1
+ copyToPtr sbs2 0 p2 l2
+ i <- BS.memcmp p1 p2 (fromIntegral l1)
+ free p1
+ free p2
+ return $! i == 0
+#endif
+
+-- | /O(n)/ The 'isSuffixOf' function takes two ShortByteStrings and returns 'True'
+-- iff the first is a suffix of the second.
+--
+-- The following holds:
+--
+-- > isSuffixOf x y == reverse x `isPrefixOf` reverse y
+--
+-- @since 0.11.3.0
+isSuffixOf :: ShortByteString -> ShortByteString -> Bool
+#if MIN_VERSION_base(4,11,0)
+isSuffixOf sbs1 = \sbs2 -> do
+ let l1 = length sbs1
+ l2 = length sbs2
+ if | l1 == 0 -> True
+ | l2 < l1 -> False
+ | otherwise ->
+ let i = compareByteArraysOff (asBA sbs1) 0 (asBA sbs2) (l2 - l1) l1
+ in i == 0
+#else
+isSuffixOf sbs1 sbs2 =
+ let l1 = length sbs1
+ l2 = length sbs2
+ in if | l1 == 0 -> True
+ | l2 < l1 -> False
+ | otherwise -> unsafeDupablePerformIO $ do
+ p1 <- mallocBytes l1
+ p2 <- mallocBytes l2
+ copyToPtr sbs1 0 p1 l1
+ copyToPtr sbs2 0 p2 l2
+ i <- BS.memcmp p1 (p2 `plusPtr` (l2 - l1)) (fromIntegral l1)
+ free p1
+ free p2
+ return $! i == 0
+#endif
+
+-- | Break a string on a substring, returning a pair of the part of the
+-- string prior to the match, and the rest of the string.
+--
+-- The following relationships hold:
+--
+-- > break (== c) l == breakSubstring (singleton c) l
+--
+-- For example, to tokenise a string, dropping delimiters:
+--
+-- > tokenise x y = h : if null t then [] else tokenise x (drop (length x) t)
+-- > where (h,t) = breakSubstring x y
+--
+-- To skip to the first occurence of a string:
+--
+-- > snd (breakSubstring x y)
+--
+-- To take the parts of a string before a delimiter:
+--
+-- > fst (breakSubstring x y)
+--
+-- Note that calling `breakSubstring x` does some preprocessing work, so
+-- you should avoid unnecessarily duplicating breakSubstring calls with the same
+-- pattern.
+--
+-- @since 0.11.3.0
+breakSubstring :: ShortByteString -- ^ String to search for
+ -> ShortByteString -- ^ String to search in
+ -> (ShortByteString, ShortByteString) -- ^ Head and tail of string broken at substring
+breakSubstring pat =
+ case lp of
+ 0 -> (empty,)
+ 1 -> breakByte (head pat)
+ _ -> if lp * 8 <= finiteBitSize (0 :: Word)
+ then shift
+ else karpRabin
+ where
+ lp = length pat
+ karpRabin :: ShortByteString -> (ShortByteString, ShortByteString)
+ karpRabin src
+ | length src < lp = (src,empty)
+ | otherwise = search (rollingHash $ take lp src) lp
+ where
+ k = 2891336453 :: Word32
+ rollingHash = foldl' (\h b -> h * k + fromIntegral b) 0
+ hp = rollingHash pat
+ m = k ^ lp
+ get = fromIntegral . unsafeIndex src
+ search !hs !i
+ | hp == hs && pat == take lp b = u
+ | length src <= i = (src, empty) -- not found
+ | otherwise = search hs' (i + 1)
+ where
+ u@(_, b) = splitAt (i - lp) src
+ hs' = hs * k +
+ get i -
+ m * get (i - lp)
+ {-# INLINE karpRabin #-}
+
+ shift :: ShortByteString -> (ShortByteString, ShortByteString)
+ shift !src
+ | length src < lp = (src, empty)
+ | otherwise = search (intoWord $ take lp src) lp
+ where
+ intoWord :: ShortByteString -> Word
+ intoWord = foldl' (\w b -> (w `shiftL` 8) .|. fromIntegral b) 0
+
+ wp = intoWord pat
+ mask' = (1 `shiftL` (8 * lp)) - 1
+ search !w !i
+ | w == wp = splitAt (i - lp) src
+ | length src <= i = (src, empty)
+ | otherwise = search w' (i + 1)
+ where
+ b = fromIntegral (unsafeIndex src i)
+ w' = mask' .&. ((w `shiftL` 8) .|. b)
+ {-# INLINE shift #-}
+
+
+-- --------------------------------------------------------------------
+-- Searching ShortByteString
+
+-- | /O(n)/ 'elem' is the 'ShortByteString' membership predicate.
+--
+-- @since 0.11.3.0
+elem :: Word8 -> ShortByteString -> Bool
+elem c = \sbs -> case elemIndex c sbs of Nothing -> False ; _ -> True
+
+-- | /O(n)/ 'filter', applied to a predicate and a ByteString,
+-- returns a ByteString containing those characters that satisfy the
+-- predicate.
+--
+-- @since 0.11.3.0
+filter :: (Word8 -> Bool) -> ShortByteString -> ShortByteString
+filter k = \sbs -> let l = length sbs
+ in if | l <= 0 -> sbs
+ | otherwise -> createAndTrim' l $ \mba -> go mba (asBA sbs) l
+ where
+ go :: forall s. MBA s -- mutable output bytestring
+ -> BA -- input bytestring
+ -> Int -- length of input bytestring
+ -> ST s Int
+ go !mba ba !l = go' 0 0
+ where
+ go' :: Int -- bytes read
+ -> Int -- bytes written
+ -> ST s Int
+ go' !br !bw
+ | br >= l = return bw
+ | otherwise = do
+ let w = indexWord8Array ba br
+ if k w
+ then do
+ writeWord8Array mba bw w
+ go' (br+1) (bw+1)
+ else
+ go' (br+1) bw
+
+-- | /O(n)/ The 'find' function takes a predicate and a ByteString,
+-- and returns the first element in matching the predicate, or 'Nothing'
+-- if there is no such element.
+--
+-- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing
+--
+-- @since 0.11.3.0
+find :: (Word8 -> Bool) -> ShortByteString -> Maybe Word8
+find f = \sbs -> case findIndex f sbs of
+ Just n -> Just (sbs `index` n)
+ _ -> Nothing
+
+-- | /O(n)/ The 'partition' function takes a predicate a ByteString and returns
+-- the pair of ByteStrings with elements which do and do not satisfy the
+-- predicate, respectively; i.e.,
+--
+-- > partition p bs == (filter p sbs, filter (not . p) sbs)
+--
+-- @since 0.11.3.0
+partition :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)
+partition k = \sbs -> let l = length sbs
+ in if | l <= 0 -> (sbs, sbs)
+ | otherwise -> createAndTrim'' l $ \mba1 mba2 -> go mba1 mba2 (asBA sbs) l
+ where
+ go :: forall s.
+ MBA s -- mutable output bytestring1
+ -> MBA s -- mutable output bytestring2
+ -> BA -- input bytestring
+ -> Int -- length of input bytestring
+ -> ST s (Int, Int) -- (length mba1, length mba2)
+ go !mba1 !mba2 ba !l = go' 0 0
+ where
+ go' :: Int -- bytes read
+ -> Int -- bytes written to bytestring 1
+ -> ST s (Int, Int) -- (length mba1, length mba2)
+ go' !br !bw1
+ | br >= l = return (bw1, br - bw1)
+ | otherwise = do
+ let w = indexWord8Array ba br
+ if k w
+ then do
+ writeWord8Array mba1 bw1 w
+ go' (br+1) (bw1+1)
+ else do
+ writeWord8Array mba2 (br - bw1) w
+ go' (br+1) bw1
+
+
+-- --------------------------------------------------------------------
+-- Indexing ShortByteString
+
+-- | /O(n)/ The 'elemIndex' function returns the index of the first
+-- element in the given 'ShortByteString' which is equal to the query
+-- element, or 'Nothing' if there is no such element.
+--
+-- @since 0.11.3.0
+elemIndex :: Word8 -> ShortByteString -> Maybe Int
+elemIndex k = findIndex (==k)
+
+
+-- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning
+-- the indices of all elements equal to the query element, in ascending order.
+--
+-- @since 0.11.3.0
+elemIndices :: Word8 -> ShortByteString -> [Int]
+elemIndices k = findIndices (==k)
+
+-- | count returns the number of times its argument appears in the ShortByteString
+--
+-- @since 0.11.3.0
+count :: Word8 -> ShortByteString -> Int
+count w = List.length . elemIndices w
+
+-- | /O(n)/ The 'findIndex' function takes a predicate and a 'ShortByteString' and
+-- returns the index of the first element in the ByteString
+-- satisfying the predicate.
+--
+-- @since 0.11.3.0
+findIndex :: (Word8 -> Bool) -> ShortByteString -> Maybe Int
+findIndex k = \sbs ->
+ let l = length sbs
+ ba = asBA sbs
+ w = indexWord8Array ba
+ go !n | n >= l = Nothing
+ | k (w n) = Just n
+ | otherwise = go (n + 1)
+ in go 0
+
+
+-- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the
+-- indices of all elements satisfying the predicate, in ascending order.
+--
+-- @since 0.11.3.0
+findIndices :: (Word8 -> Bool) -> ShortByteString -> [Int]
+findIndices k = \sbs ->
+ let l = length sbs
+ ba = asBA sbs
+ w = indexWord8Array ba
+ go !n | n >= l = []
+ | k (w n) = n : go (n + 1)
+ | otherwise = go (n + 1)
+ in go 0
+
+
+------------------------------------------------------------------------
+-- Primop wrappers
+
+data BA = BA# ByteArray#
+data MBA s = MBA# (MutableByteArray# s)
+
+indexWord8Array :: BA -> Int -> Word8
+indexWord8Array (BA# ba#) (I# i#) = W8# (indexWord8Array# ba# i#)
+
+#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED)
+indexWord8ArrayAsWord64 :: BA -> Int -> Word64
+indexWord8ArrayAsWord64 (BA# ba#) (I# i#) = W64# (indexWord8ArrayAsWord64# ba# i#)
+#endif
+
+newByteArray :: Int -> ST s (MBA s)
+newByteArray (I# len#) =
+ ST $ \s -> case newByteArray# len# s of
+ (# s, mba# #) -> (# s, MBA# mba# #)
+
+unsafeFreezeByteArray :: MBA s -> ST s BA
+unsafeFreezeByteArray (MBA# mba#) =
+ ST $ \s -> case unsafeFreezeByteArray# mba# s of
+ (# s, ba# #) -> (# s, BA# ba# #)
+
+writeWord8Array :: MBA s -> Int -> Word8 -> ST s ()
+writeWord8Array (MBA# mba#) (I# i#) (W8# w#) =
+ ST $ \s -> case writeWord8Array# mba# i# w# s of
+ s -> (# s, () #)
+
+#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED)
+writeWord64Array :: MBA s -> Int -> Word64 -> ST s ()
+writeWord64Array (MBA# mba#) (I# i#) (W64# w#) =
+ ST $ \s -> case writeWord64Array# mba# i# w# s of
+ s -> (# s, () #)
+#endif
+
+copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s ()
+copyByteArray (BA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) =
+ ST $ \s -> case copyByteArray# src# src_off# dst# dst_off# len# s of
+ s -> (# s, () #)
+
+setByteArray :: MBA s -> Int -> Int -> Int -> ST s ()
+setByteArray (MBA# dst#) (I# off#) (I# len#) (I# c#) =
+ ST $ \s -> case setByteArray# dst# off# len# c# s of
+ s -> (# s, () #)
+
+copyMutableByteArray :: MBA s -> Int -> MBA s -> Int -> Int -> ST s ()
+copyMutableByteArray (MBA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) =
+ ST $ \s -> case copyMutableByteArray# src# src_off# dst# dst_off# len# s of
+ s -> (# s, () #)
+
+
+------------------------------------------------------------------------
+-- FFI imports
+--
+
+#if MIN_VERSION_base(4,11,0)
+compareByteArraysOff :: BA -- ^ array 1
+ -> Int -- ^ offset for array 1
+ -> BA -- ^ array 2
+ -> Int -- ^ offset for array 2
+ -> Int -- ^ length to compare
+ -> Int -- ^ like memcmp
+compareByteArraysOff (BA# ba1#) (I# ba1off#) (BA# ba2#) (I# ba2off#) (I# len#) =
+ I# (compareByteArrays# ba1# ba1off# ba2# ba2off# len#)
+#endif
+
+------------------------------------------------------------------------
+-- Primop replacements
+
+copyByteArray# :: ByteArray# -> Int#
+ -> MutableByteArray# s -> Int#
+ -> Int#
+ -> State# s -> State# s
+
+copyByteArray# = GHC.Exts.copyByteArray#
+
+#if !MIN_VERSION_bytestring(0,10,10)
+-- | /O(n)./ Construct a new @ShortByteString@ from a @CString@. The
+-- resulting @ShortByteString@ is an immutable copy of the original
+-- @CString@, and is managed on the Haskell heap. The original
+-- @CString@ must be null terminated.
+--
+-- @since 0.10.10.0
+packCString :: CString -> IO ShortByteString
+packCString cstr = do
+ len <- BS.c_strlen cstr
+ packCStringLen (cstr, fromIntegral len)
+
+-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a
+-- null-terminated @CString@. The @CString@ is a copy and will be freed
+-- automatically; it must not be stored or used after the
+-- subcomputation finishes.
+--
+-- @since 0.10.10.0
+useAsCString :: ShortByteString -> (CString -> IO a) -> IO a
+useAsCString sbs action =
+ allocaBytes (l+1) $ \buf -> do
+ copyToPtr sbs 0 buf (fromIntegral l)
+ pokeByteOff buf l (0::Word8)
+ action buf
+ where l = length sbs
+
+-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CStringLen@.
+-- As for @useAsCString@ this function makes a copy of the original @ShortByteString@.
+-- It must not be stored or used after the subcomputation finishes.
+--
+-- @since 0.10.10.0
+useAsCStringLen :: ShortByteString -> (CStringLen -> IO a) -> IO a
+useAsCStringLen sbs action =
+ allocaBytes l $ \buf -> do
+ copyToPtr sbs 0 buf (fromIntegral l)
+ action (buf, l)
+ where l = length sbs
+
+-- | /O(n)./ Construct a new @ShortByteString@ from a @CStringLen@. The
+-- resulting @ShortByteString@ is an immutable copy of the original @CStringLen@.
+-- The @ShortByteString@ is a normal Haskell value and will be managed on the
+-- Haskell heap.
+--
+-- @since 0.10.10.0
+packCStringLen :: CStringLen -> IO ShortByteString
+packCStringLen (cstr, len) | len >= 0 = createFromPtr cstr len
+packCStringLen (_, len) =
+ moduleErrorIO "packCStringLen" ("negative length: " ++ show len)
+
+moduleErrorIO :: HasCallStack => String -> String -> IO a
+moduleErrorIO fun msg = throwIO . userError $ moduleErrorMsg fun msg
+{-# NOINLINE moduleErrorIO #-}
+#endif
+
+
+-- ---------------------------------------------------------------------
+-- Internal utilities
+
+
+moduleErrorMsg :: String -> String -> String
+moduleErrorMsg fun msg = "System.AbstractFilePath.Data.ByteString.Short." ++ fun ++ ':':' ':msg
+
+
+-- Find from the end of the string using predicate.
+--
+-- Return '0' if the predicate returns false for the entire ShortByteString.
+findFromEndUntil :: (Word8 -> Bool) -> ShortByteString -> Int
+findFromEndUntil k sbs = go (length sbs - 1)
+ where
+ ba = asBA sbs
+ go !n | n < 0 = 0
+ | k (indexWord8Array ba n) = n + 1
+ | otherwise = go (n - 1)
+
+findIndexOrLength :: (Word8 -> Bool) -> ShortByteString -> Int
+findIndexOrLength k sbs = go 0
+ where
+ l = length sbs
+ ba = asBA sbs
+ go !n | n >= l = l
+ | k (indexWord8Array ba n) = n
+ | otherwise = go (n + 1)
+
+
+packBytesRev :: [Word8] -> ShortByteString
+packBytesRev cs = packLenBytesRev (List.length cs) cs
+
+packLenBytesRev :: Int -> [Word8] -> ShortByteString
+packLenBytesRev len ws0 =
+ create len (\mba -> go mba len ws0)
+ where
+ go :: MBA s -> Int -> [Word8] -> ST s ()
+ go !_ !_ [] = return ()
+ go !mba !i (w:ws) = do
+ writeWord8Array mba (i - 1) w
+ go mba (i - 1) ws
+
+
+breakByte :: Word8 -> ShortByteString -> (ShortByteString, ShortByteString)
+breakByte c sbs = case elemIndex c sbs of
+ Nothing -> (sbs, empty)
+ Just n -> (take n sbs, drop n sbs)
+
+-- Common up near identical calls to `error' to reduce the number
+-- constant strings created when compiled:
+errorEmptySBS :: HasCallStack => String -> a
+errorEmptySBS fun = moduleError fun "empty ShortByteString"
+{-# NOINLINE errorEmptySBS #-}
+
+moduleError :: HasCallStack => String -> String -> a
+moduleError fun msg = error (moduleErrorMsg fun msg)
+{-# NOINLINE moduleError #-}
+
+#if !MIN_VERSION_bytestring(0,10,9)
+-- | Add two non-negative numbers. Errors out on overflow.
+checkedAdd :: String -> Int -> Int -> Int
+checkedAdd fun x y
+ | r >= 0 = r
+ | otherwise = overflowError fun
+ where r = x + y
+{-# INLINE checkedAdd #-}
+
+overflowError :: String -> a
+overflowError fun = error $ "Data.ByteString." ++ fun ++ ": size overflow"
+#endif
+
+
+#endif
diff --git a/System/AbstractFilePath/Data/ByteString/Short/Decode.hs b/System/AbstractFilePath/Data/ByteString/Short/Decode.hs
new file mode 100644
index 0000000..1c3397d
--- /dev/null
+++ b/System/AbstractFilePath/Data/ByteString/Short/Decode.hs
@@ -0,0 +1,286 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE BangPatterns #-}
+
+module System.AbstractFilePath.Data.ByteString.Short.Decode (decodeUtf16LE, decodeUtf16LEWith, decodeUtf16LE', decodeUtf16LE'', decodeUtf8, decodeUtf8With, decodeUtf8', strictDecode, lenientDecode, OnError, OnDecodeError, UnicodeException(..)) where
+
+import Data.ByteString.Internal
+ ( ByteString )
+import Data.ByteString.Short
+ ( ShortByteString, toShort )
+import Data.Bits
+ ( shiftL )
+import Data.Typeable (Typeable)
+import Data.Word
+ ( Word16, Word8 )
+import GHC.Word (Word8(..), Word16(..))
+import Control.Exception
+import qualified Data.ByteString.Short as BS
+ ( index, length )
+import GHC.IO
+ ( unsafeDupablePerformIO )
+import GHC.Base
+import Control.DeepSeq (NFData, rnf)
+import Numeric (showHex)
+#if !MIN_VERSION_base(4,16,0)
+
+word8ToWord# :: Word# -> Word#
+word16ToWord# :: Word# -> Word#
+word8ToWord# w = w
+word16ToWord# w = w
+{-# INLINE word16ToWord# #-}
+{-# INLINE word8ToWord# #-}
+
+#endif
+
+unsafeChr16 :: Word16 -> Char
+unsafeChr16 (W16# w#) = C# (chr# (word2Int# (word16ToWord# w#)))
+{-# INLINE unsafeChr16 #-}
+
+unsafeChr8 :: Word8 -> Char
+unsafeChr8 (W8# w#) = C# (chr# (word2Int# (word8ToWord# w#)))
+{-# INLINE unsafeChr8 #-}
+
+-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
+-- encoding.
+streamUtf8 :: OnDecodeError -> ShortByteString -> [Char]
+streamUtf8 onErr bs = go 0
+ where
+ l = BS.length bs
+ go i
+ | i >= l = []
+ | validate1_8 x1 = (unsafeChr8 x1) : go (i+1)
+ | i+1 < l && validate2_8 x1 x2 = (chr2 x1 x2) : go (i+2)
+ | i+2 < l && validate3_8 x1 x2 x3 = (chr3 x1 x2 x3) : go (i+3)
+ | i+3 < l && validate4_8 x1 x2 x3 x4 = (chr4 x1 x2 x3 x4) : go (i+4)
+ | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) ++ go (i+1)
+ where
+ x1 = idx i
+ x2 = idx (i + 1)
+ x3 = idx (i + 2)
+ x4 = idx (i + 3)
+ idx = BS.index bs
+{-# INLINE [0] streamUtf8 #-}
+
+-- | /O(n)/ Convert a 'ShortByteString' into a 'Stream Char', using little
+-- endian UTF-16 encoding.
+streamUtf16LE :: OnDecodeError -> ShortByteString -> [Char]
+streamUtf16LE onErr bs = go 0
+ where
+ l = BS.length bs
+ {-# INLINE go #-}
+ go i
+ | i >= l = []
+ | i+1 < l && validate1_16 x1 = (unsafeChr16 x1) : go (i+2)
+ | i+3 < l && validate2_16 x1 x2 = (chr2_16 x1 x2) : go (i+4)
+ | otherwise = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing ++ go (i+1)
+ where
+ x1 = idx i + (idx (i + 1) `shiftL` 8)
+ x2 = idx (i + 2) + (idx (i + 3) `shiftL` 8)
+ idx = fromIntegral . BS.index bs :: Int -> Word16
+{-# INLINE [0] streamUtf16LE #-}
+
+-- | Decode text from little endian UTF-16 encoding.
+decodeUtf16LEWith :: OnDecodeError -> ShortByteString -> String
+decodeUtf16LEWith onErr bs = streamUtf16LE onErr bs
+{-# INLINE decodeUtf16LEWith #-}
+
+-- | Decode text from little endian UTF-16 encoding.
+--
+-- If the input contains any invalid little endian UTF-16 data, an
+-- exception will be thrown. For more control over the handling of
+-- invalid data, use 'decodeUtf16LEWith'.
+decodeUtf16LE :: ShortByteString -> String
+decodeUtf16LE = decodeUtf16LEWith strictDecode
+{-# INLINE decodeUtf16LE #-}
+
+-- | Decode text from little endian UTF-16 encoding.
+decodeUtf8With :: OnDecodeError -> ShortByteString -> String
+decodeUtf8With onErr bs = streamUtf8 onErr bs
+{-# INLINE decodeUtf8With #-}
+
+-- | Decode text from little endian UTF-16 encoding.
+--
+-- If the input contains any invalid little endian UTF-16 data, an
+-- exception will be thrown. For more control over the handling of
+-- invalid data, use 'decodeUtf16LEWith'.
+decodeUtf8 :: ShortByteString -> String
+decodeUtf8 = decodeUtf8With strictDecode
+{-# INLINE decodeUtf8 #-}
+
+
+decodeError :: String -> String -> OnDecodeError -> Maybe Word8 -> String
+decodeError func kind onErr mb =
+ case onErr desc mb of
+ Nothing -> []
+ Just c -> [c]
+ where desc = "System.AbstractFilePath.Data.ByteString.Short.Decode." ++ func ++ ": Invalid " ++
+ kind ++ " stream"
+
+
+-- | Decode a 'ShortByteString' containing UTF-8 encoded text.
+--
+-- If the input contains any invalid UTF-8 data, the relevant
+-- exception will be returned, otherwise the decoded text.
+decodeUtf8' :: ShortByteString -> Either UnicodeException String
+decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
+{-# INLINE decodeUtf8' #-}
+
+
+-- | Decode a 'ShortByteString' containing UTF-16 encoded text.
+--
+-- If the input contains any invalid UTF-16 data, the relevant
+-- exception will be returned, otherwise the decoded text.
+decodeUtf16LE' :: ShortByteString -> Either UnicodeException String
+decodeUtf16LE' = unsafeDupablePerformIO . try . evaluate . decodeUtf16LEWith strictDecode
+{-# INLINE decodeUtf16LE' #-}
+
+
+-- | Decode a 'ByteString' containing UTF-16 encoded text.
+--
+-- If the input contains any invalid UTF-16 data, the relevant
+-- exception will be returned, otherwise the decoded text.
+decodeUtf16LE'' :: ByteString -> Either UnicodeException String
+decodeUtf16LE'' = unsafeDupablePerformIO . try . evaluate . decodeUtf16LEWith strictDecode . toShort
+{-# INLINE decodeUtf16LE'' #-}
+
+-- | Throw a 'UnicodeException' if decoding fails.
+strictDecode :: OnDecodeError
+strictDecode desc c = throw (DecodeError desc c)
+
+-- | Replace an invalid input byte with the Unicode replacement
+-- character U+FFFD.
+lenientDecode :: OnDecodeError
+lenientDecode _ _ = Just '\xfffd'
+
+
+type OnError a b = String -> Maybe a -> Maybe b
+type OnDecodeError = OnError Word8 Char
+-- | An exception type for representing Unicode encoding errors.
+data UnicodeException =
+ DecodeError String (Maybe Word8)
+ -- ^ Could not decode a byte sequence because it was invalid under
+ -- the given encoding, or ran out of input in mid-decode.
+ deriving (Eq, Typeable)
+
+-------------------------------
+-- Internal
+
+
+between :: Word8 -- ^ byte to check
+ -> Word8 -- ^ lower bound
+ -> Word8 -- ^ upper bound
+ -> Bool
+between x y z = x >= y && x <= z
+{-# INLINE between #-}
+
+
+validate1_8 :: Word8 -> Bool
+validate1_8 x1 = x1 <= 0x7F
+{-# INLINE validate1_8 #-}
+
+validate2_8 :: Word8 -> Word8 -> Bool
+validate2_8 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF
+{-# INLINE validate2_8 #-}
+
+validate3_8 :: Word8 -> Word8 -> Word8 -> Bool
+{-# INLINE validate3_8 #-}
+validate3_8 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4
+ where
+ validate3_1 = (x1 == 0xE0) &&
+ between x2 0xA0 0xBF &&
+ between x3 0x80 0xBF
+ validate3_2 = between x1 0xE1 0xEC &&
+ between x2 0x80 0xBF &&
+ between x3 0x80 0xBF
+ validate3_3 = x1 == 0xED &&
+ between x2 0x80 0x9F &&
+ between x3 0x80 0xBF
+ validate3_4 = between x1 0xEE 0xEF &&
+ between x2 0x80 0xBF &&
+ between x3 0x80 0xBF
+
+validate4_8 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
+{-# INLINE validate4_8 #-}
+validate4_8 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3
+ where
+ validate4_1 = x1 == 0xF0 &&
+ between x2 0x90 0xBF &&
+ between x3 0x80 0xBF &&
+ between x4 0x80 0xBF
+ validate4_2 = between x1 0xF1 0xF3 &&
+ between x2 0x80 0xBF &&
+ between x3 0x80 0xBF &&
+ between x4 0x80 0xBF
+ validate4_3 = x1 == 0xF4 &&
+ between x2 0x80 0x8F &&
+ between x3 0x80 0xBF &&
+ between x4 0x80 0xBF
+
+chr2 :: Word8 -> Word8 -> Char
+chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
+ where
+ !y1# = word2Int# (word8ToWord# x1#)
+ !y2# = word2Int# (word8ToWord# x2#)
+ !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#
+ !z2# = y2# -# 0x80#
+{-# INLINE chr2 #-}
+
+chr3 :: Word8 -> Word8 -> Word8 -> Char
+chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))
+ where
+ !y1# = word2Int# (word8ToWord# x1#)
+ !y2# = word2Int# (word8ToWord# x2#)
+ !y3# = word2Int# (word8ToWord# x3#)
+ !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#
+ !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#
+ !z3# = y3# -# 0x80#
+{-# INLINE chr3 #-}
+
+chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
+chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =
+ C# (chr# (z1# +# z2# +# z3# +# z4#))
+ where
+ !y1# = word2Int# (word8ToWord# x1#)
+ !y2# = word2Int# (word8ToWord# x2#)
+ !y3# = word2Int# (word8ToWord# x3#)
+ !y4# = word2Int# (word8ToWord# x4#)
+ !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#
+ !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#
+ !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#
+ !z4# = y4# -# 0x80#
+{-# INLINE chr4 #-}
+
+validate1_16 :: Word16 -> Bool
+validate1_16 x1 = x1 < 0xD800 || x1 > 0xDFFF
+{-# INLINE validate1_16 #-}
+
+validate2_16 :: Word16 -> Word16 -> Bool
+validate2_16 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&
+ x2 >= 0xDC00 && x2 <= 0xDFFF
+{-# INLINE validate2_16 #-}
+
+chr2_16 :: Word16 -> Word16 -> Char
+chr2_16 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))
+ where
+ !x# = word2Int# (word16ToWord# a#)
+ !y# = word2Int# (word16ToWord# b#)
+ !upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#
+ !lower# = y# -# 0xDC00#
+{-# INLINE chr2_16 #-}
+
+
+showUnicodeException :: UnicodeException -> String
+showUnicodeException (DecodeError desc (Just w))
+ = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)
+showUnicodeException (DecodeError desc Nothing)
+ = "Cannot decode input: " ++ desc
+
+instance Show UnicodeException where
+ show = showUnicodeException
+
+instance Exception UnicodeException
+
+instance NFData UnicodeException where
+ rnf (DecodeError desc w) = rnf desc `seq` rnf w `seq` ()
diff --git a/System/AbstractFilePath/Data/ByteString/Short/Encode.hs b/System/AbstractFilePath/Data/ByteString/Short/Encode.hs
new file mode 100644
index 0000000..cbded63
--- /dev/null
+++ b/System/AbstractFilePath/Data/ByteString/Short/Encode.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
+
+module System.AbstractFilePath.Data.ByteString.Short.Encode (encodeUtf8, encodeUtf16LE) where
+
+import Data.Bits
+ ( shiftR, (.&.) )
+import Data.ByteString.Short
+ ( ShortByteString )
+import Data.Char
+ ( ord )
+import Data.Word
+ ( Word8 )
+
+import qualified Data.ByteString.Short as BS
+ ( pack )
+
+
+encodeUtf8 :: String -> ShortByteString
+encodeUtf8 = BS.pack . encode
+ where
+ encode :: String -> [Word8]
+ encode = concatMap encodeChar
+
+ encodeChar :: Char -> [Word8]
+ encodeChar = map fromIntegral . go . ord
+ where
+ go oc
+ | oc <= 0x7f = [oc]
+
+ | oc <= 0x7ff = [ 0xc0 + (oc `shiftR` 6)
+ , 0x80 + oc .&. 0x3f
+ ]
+
+ | oc <= 0xffff = [ 0xe0 + (oc `shiftR` 12)
+ , 0x80 + ((oc `shiftR` 6) .&. 0x3f)
+ , 0x80 + oc .&. 0x3f
+ ]
+ | otherwise = [ 0xf0 + (oc `shiftR` 18)
+ , 0x80 + ((oc `shiftR` 12) .&. 0x3f)
+ , 0x80 + ((oc `shiftR` 6) .&. 0x3f)
+ , 0x80 + oc .&. 0x3f
+ ]
+{-# INLINE encodeUtf8 #-}
+
+
+encodeUtf16LE :: String -> ShortByteString
+encodeUtf16LE = BS.pack . encode
+ where
+ encode :: String -> [Word8]
+ encode = concatMap encodeChar
+
+ encodeChar :: Char -> [Word8]
+ encodeChar = map fromIntegral . go . ord
+ where
+ go oc
+ | oc < 0x10000 = [ oc, oc `shiftR` 8 ]
+ | otherwise =
+ let m = oc - 0x10000
+ in [ m `shiftR` 10
+ , (m `shiftR` 18) + 0xD8
+ , m .&. 0x3FF
+ , ((m .&. 0x3FF) `shiftR` 8) + 0xDC ]
+{-# INLINE encodeUtf16LE #-}
diff --git a/System/AbstractFilePath/Data/ByteString/Short/Internal.hs b/System/AbstractFilePath/Data/ByteString/Short/Internal.hs
new file mode 100644
index 0000000..004b826
--- /dev/null
+++ b/System/AbstractFilePath/Data/ByteString/Short/Internal.hs
@@ -0,0 +1,437 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ViewPatterns #-}
+
+-- |
+-- Module : System.AbstractFilePath.Data.ByteString.Short.Internal
+-- Copyright : © 2022 Julian Ospald
+-- License : MIT
+--
+-- Maintainer : Julian Ospald <hasufell@posteo.de>
+-- Stability : experimental
+-- Portability : portable
+--
+-- Internal low-level utilities mostly for 'System.AbstractFilePath.Data.ByteString.Short.Word16',
+-- such as byte-array operations and other stuff not meant to be exported from Word16 module.
+module System.AbstractFilePath.Data.ByteString.Short.Internal where
+
+import Control.Monad.ST
+import Control.Exception (assert, throwIO)
+import Data.ByteString.Short.Internal (ShortByteString(..), length)
+#if !MIN_VERSION_base(4,11,0)
+import Data.Semigroup
+ ( Semigroup((<>)) )
+#endif
+#if !MIN_VERSION_bytestring(0,10,9)
+import Foreign.Marshal.Alloc (allocaBytes)
+import Foreign.C.String ( CString, CStringLen )
+import Foreign.C.Types ( CSize(..) )
+import Foreign.Storable (pokeByteOff)
+#endif
+import Foreign.Marshal.Array (withArray0, peekArray0, newArray0, withArrayLen, peekArray)
+import GHC.Exts
+import GHC.Word
+import GHC.ST
+ ( ST (ST) )
+import GHC.Stack ( HasCallStack )
+import Prelude hiding
+ ( length )
+
+import qualified Data.ByteString.Short.Internal as BS
+import qualified Data.Char as C
+import qualified Data.List as List
+
+
+_nul :: Word16
+_nul = 0x00
+
+isSpace :: Word16 -> Bool
+isSpace = C.isSpace . word16ToChar
+
+-- | Total conversion to char.
+word16ToChar :: Word16 -> Char
+word16ToChar = C.chr . fromIntegral
+
+create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString
+create len fill =
+ runST $ do
+ mba <- newByteArray len
+ fill mba
+ BA# ba# <- unsafeFreezeByteArray mba
+ return (SBS ba#)
+{-# INLINE create #-}
+
+
+asBA :: ShortByteString -> BA
+asBA (SBS ba#) = BA# ba#
+
+
+
+data BA = BA# ByteArray#
+data MBA s = MBA# (MutableByteArray# s)
+
+
+newPinnedByteArray :: Int -> ST s (MBA s)
+newPinnedByteArray (I# len#) =
+ ST $ \s -> case newPinnedByteArray# len# s of
+ (# s', mba# #) -> (# s', MBA# mba# #)
+
+newByteArray :: Int -> ST s (MBA s)
+newByteArray (I# len#) =
+ ST $ \s -> case newByteArray# len# s of
+ (# s', mba# #) -> (# s', MBA# mba# #)
+
+copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s ()
+copyByteArray (BA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) =
+ ST $ \s -> case copyByteArray# src# src_off# dst# dst_off# len# s of
+ s' -> (# s', () #)
+
+unsafeFreezeByteArray :: MBA s -> ST s BA
+unsafeFreezeByteArray (MBA# mba#) =
+ ST $ \s -> case unsafeFreezeByteArray# mba# s of
+ (# s', ba# #) -> (# s', BA# ba# #)
+
+copyAddrToByteArray :: Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()
+copyAddrToByteArray (Ptr src#) (MBA# dst#) (I# dst_off#) (I# len#) =
+ ST $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of
+ s' -> (# s', () #)
+
+
+-- this is a copy-paste from bytestring
+#if !MIN_VERSION_bytestring(0,10,9)
+------------------------------------------------------------------------
+-- Primop replacements
+
+-- ---------------------------------------------------------------------
+--
+-- Standard C functions
+--
+
+foreign import ccall unsafe "string.h strlen" c_strlen
+ :: CString -> IO CSize
+
+
+-- ---------------------------------------------------------------------
+--
+-- Uses our C code
+--
+
+-- | /O(n)./ Construct a new @ShortByteString@ from a @CString@. The
+-- resulting @ShortByteString@ is an immutable copy of the original
+-- @CString@, and is managed on the Haskell heap. The original
+-- @CString@ must be null terminated.
+--
+-- @since 0.10.10.0
+packCString :: CString -> IO ShortByteString
+packCString cstr = do
+ len <- c_strlen cstr
+ packCStringLen (cstr, fromIntegral len)
+
+-- | /O(n)./ Construct a new @ShortByteString@ from a @CStringLen@. The
+-- resulting @ShortByteString@ is an immutable copy of the original @CStringLen@.
+-- The @ShortByteString@ is a normal Haskell value and will be managed on the
+-- Haskell heap.
+--
+-- @since 0.10.10.0
+packCStringLen :: CStringLen -> IO ShortByteString
+packCStringLen (cstr, len) | len >= 0 = BS.createFromPtr cstr len
+packCStringLen (_, len) =
+ moduleErrorIO "packCStringLen" ("negative length: " ++ show len)
+
+-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a
+-- null-terminated @CString@. The @CString@ is a copy and will be freed
+-- automatically; it must not be stored or used after the
+-- subcomputation finishes.
+--
+-- @since 0.10.10.0
+useAsCString :: ShortByteString -> (CString -> IO a) -> IO a
+useAsCString bs action =
+ allocaBytes (l+1) $ \buf -> do
+ BS.copyToPtr bs 0 buf (fromIntegral l)
+ pokeByteOff buf l (0::Word8)
+ action buf
+ where l = length bs
+
+-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CStringLen@.
+-- As for @useAsCString@ this function makes a copy of the original @ShortByteString@.
+-- It must not be stored or used after the subcomputation finishes.
+--
+-- @since 0.10.10.0
+useAsCStringLen :: ShortByteString -> (CStringLen -> IO a) -> IO a
+useAsCStringLen bs action =
+ allocaBytes l $ \buf -> do
+ BS.copyToPtr bs 0 buf (fromIntegral l)
+ action (buf, l)
+ where l = length bs
+
+
+#endif
+
+
+-- | /O(n)./ Construct a new @ShortByteString@ from a @CWString@. The
+-- resulting @ShortByteString@ is an immutable copy of the original
+-- @CWString@, and is managed on the Haskell heap. The original
+-- @CWString@ must be null terminated.
+--
+-- @since 0.10.10.0
+packCWString :: Ptr Word16 -> IO ShortByteString
+packCWString cwstr = do
+ cs <- peekArray0 _nul cwstr
+ return (packWord16 cs)
+
+-- | /O(n)./ Construct a new @ShortByteString@ from a @CWStringLen@. The
+-- resulting @ShortByteString@ is an immutable copy of the original @CWStringLen@.
+-- The @ShortByteString@ is a normal Haskell value and will be managed on the
+-- Haskell heap.
+--
+-- @since 0.10.10.0
+packCWStringLen :: (Ptr Word16, Int) -> IO ShortByteString
+packCWStringLen (cp, len) = do
+ cs <- peekArray len cp
+ return (packWord16 cs)
+
+
+-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a
+-- null-terminated @CWString@. The @CWString@ is a copy and will be freed
+-- automatically; it must not be stored or used after the
+-- subcomputation finishes.
+--
+-- @since 0.10.10.0
+useAsCWString :: ShortByteString -> (Ptr Word16 -> IO a) -> IO a
+useAsCWString = withArray0 _nul . unpackWord16
+
+-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CWStringLen@.
+-- As for @useAsCWString@ this function makes a copy of the original @ShortByteString@.
+-- It must not be stored or used after the subcomputation finishes.
+--
+-- @since 0.10.10.0
+useAsCWStringLen :: ShortByteString -> ((Ptr Word16, Int) -> IO a) -> IO a
+useAsCWStringLen bs action = withArrayLen (unpackWord16 bs) $ \ len ptr -> action (ptr, len)
+
+-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CWStringLen@.
+-- As for @useAsCWString@ this function makes a copy of the original @ShortByteString@.
+-- It must not be stored or used after the subcomputation finishes.
+--
+-- @since 0.10.10.0
+newCWString :: ShortByteString -> IO (Ptr Word16)
+newCWString = newArray0 _nul . unpackWord16
+
+
+
+
+ -- ---------------------------------------------------------------------
+-- Internal utilities
+
+moduleErrorIO :: String -> String -> IO a
+moduleErrorIO fun msg = throwIO . userError $ moduleErrorMsg fun msg
+{-# NOINLINE moduleErrorIO #-}
+
+moduleErrorMsg :: String -> String -> String
+moduleErrorMsg fun msg = "System.AbstractFilePath.Data.ByteString.Short." ++ fun ++ ':':' ':msg
+
+packWord16 :: [Word16] -> ShortByteString
+packWord16 cs = packLenWord16 (List.length cs) cs
+
+packLenWord16 :: Int -> [Word16] -> ShortByteString
+packLenWord16 len ws0 =
+ create (len * 2) (\mba -> go mba 0 ws0)
+ where
+ go :: MBA s -> Int -> [Word16] -> ST s ()
+ go !_ !_ [] = return ()
+ go !mba !i (w:ws) = do
+ writeWord16Array mba i w
+ go mba (i+2) ws
+
+
+unpackWord16 :: ShortByteString -> [Word16]
+unpackWord16 sbs = go len []
+ where
+ len = length sbs
+ go !i !acc
+ | i < 1 = acc
+ | otherwise = let !w = indexWord16Array (asBA sbs) (i - 2)
+ in go (i - 2) (w:acc)
+
+packWord16Rev :: [Word16] -> ShortByteString
+packWord16Rev cs = packLenWord16Rev ((List.length cs) * 2) cs
+
+packLenWord16Rev :: Int -> [Word16] -> ShortByteString
+packLenWord16Rev len ws0 =
+ create len (\mba -> go mba len ws0)
+ where
+ go :: MBA s -> Int -> [Word16] -> ST s ()
+ go !_ !_ [] = return ()
+ go !mba !i (w:ws) = do
+ writeWord16Array mba (i - 2) w
+ go mba (i - 2) ws
+
+
+-- | This isn't strictly Word16 array write. Instead it's two consecutive Word8 array
+-- writes to avoid endianness issues due to primops doing automatic alignment based
+-- on host platform. We want to always write LE to the byte array.
+writeWord16Array :: MBA s
+ -> Int -- ^ Word8 index (not Word16)
+ -> Word16
+ -> ST s ()
+writeWord16Array (MBA# mba#) (I# i#) (W16# w#) =
+ case encodeWord16LE# w# of
+ (# lsb#, msb# #) ->
+ (ST $ \s -> case writeWord8Array# mba# i# lsb# s of
+ s' -> (# s', () #)) >>
+ (ST $ \s -> case writeWord8Array# mba# (i# +# 1#) msb# s of
+ s' -> (# s', () #))
+
+-- | This isn't strictly Word16 array read. Instead it's two Word8 array reads
+-- to avoid endianness issues due to primops doing automatic alignment based
+-- on host platform. We expect the byte array to be LE always.
+indexWord16Array :: BA
+ -> Int -- ^ Word8 index (not Word16)
+ -> Word16
+indexWord16Array (BA# ba#) (I# i#) =
+ case (# indexWord8Array# ba# i#, indexWord8Array# ba# (i# +# 1#) #) of
+ (# lsb#, msb# #) -> W16# ((decodeWord16LE# (# lsb#, msb# #)))
+
+#if !MIN_VERSION_base(4,16,0)
+
+encodeWord16LE# :: Word# -- ^ Word16
+ -> (# Word#, Word# #) -- ^ Word8 (LSB, MSB)
+encodeWord16LE# x# = (# (x# `and#` int2Word# 0xff#)
+ , ((x# `and#` int2Word# 0xff00#) `shiftRL#` 8#) #)
+
+decodeWord16LE# :: (# Word#, Word# #) -- ^ Word8 (LSB, MSB)
+ -> Word# -- ^ Word16
+decodeWord16LE# (# lsb#, msb# #) = ((msb# `shiftL#` 8#) `or#` lsb#)
+
+#else
+
+encodeWord16LE# :: Word16# -- ^ Word16
+ -> (# Word8#, Word8# #) -- ^ Word8 (LSB, MSB)
+encodeWord16LE# x# = (# word16ToWord8# x#
+ , word16ToWord8# (x# `uncheckedShiftRLWord16#` 8#) #)
+ where
+ word16ToWord8# y = wordToWord8# (word16ToWord# y)
+
+decodeWord16LE# :: (# Word8#, Word8# #) -- ^ Word8 (LSB, MSB)
+ -> Word16# -- ^ Word16
+decodeWord16LE# (# lsb#, msb# #) = ((word8ToWord16# msb# `uncheckedShiftLWord16#` 8#) `orWord16#` word8ToWord16# lsb#)
+ where
+ word8ToWord16# y = wordToWord16# (word8ToWord# y)
+
+#endif
+
+setByteArray :: MBA s -> Int -> Int -> Int -> ST s ()
+setByteArray (MBA# dst#) (I# off#) (I# len#) (I# c#) =
+ ST $ \s -> case setByteArray# dst# off# len# c# s of
+ s' -> (# s', () #)
+
+copyMutableByteArray :: MBA s -> Int -> MBA s -> Int -> Int -> ST s ()
+copyMutableByteArray (MBA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) =
+ ST $ \s -> case copyMutableByteArray# src# src_off# dst# dst_off# len# s of
+ s' -> (# s', () #)
+
+-- | Given the maximum size needed and a function to make the contents
+-- of a ShortByteString, createAndTrim makes the 'ShortByteString'.
+-- The generating function is required to return the actual final size
+-- (<= the maximum size) and the result value. The resulting byte array
+-- is realloced to this size.
+createAndTrim :: Int -> (forall s. MBA s -> ST s (Int, a)) -> (ShortByteString, a)
+createAndTrim l fill =
+ runST $ do
+ mba <- newByteArray l
+ (l', res) <- fill mba
+ if assert (l' <= l) $ l' >= l
+ then do
+ BA# ba# <- unsafeFreezeByteArray mba
+ return (SBS ba#, res)
+ else do
+ mba2 <- newByteArray l'
+ copyMutableByteArray mba 0 mba2 0 l'
+ BA# ba# <- unsafeFreezeByteArray mba2
+ return (SBS ba#, res)
+{-# INLINE createAndTrim #-}
+
+createAndTrim' :: Int -> (forall s. MBA s -> ST s Int) -> ShortByteString
+createAndTrim' l fill =
+ runST $ do
+ mba <- newByteArray l
+ l' <- fill mba
+ if assert (l' <= l) $ l' >= l
+ then do
+ BA# ba# <- unsafeFreezeByteArray mba
+ return (SBS ba#)
+ else do
+ mba2 <- newByteArray l'
+ copyMutableByteArray mba 0 mba2 0 l'
+ BA# ba# <- unsafeFreezeByteArray mba2
+ return (SBS ba#)
+{-# INLINE createAndTrim' #-}
+
+createAndTrim'' :: Int -> (forall s. MBA s -> MBA s -> ST s (Int, Int)) -> (ShortByteString, ShortByteString)
+createAndTrim'' l fill =
+ runST $ do
+ mba1 <- newByteArray l
+ mba2 <- newByteArray l
+ (l1, l2) <- fill mba1 mba2
+ sbs1 <- freeze' l1 mba1
+ sbs2 <- freeze' l2 mba2
+ pure (sbs1, sbs2)
+ where
+ freeze' :: Int -> MBA s -> ST s ShortByteString
+ freeze' l' mba =
+ if assert (l' <= l) $ l' >= l
+ then do
+ BA# ba# <- unsafeFreezeByteArray mba
+ return (SBS ba#)
+ else do
+ mba2 <- newByteArray l'
+ copyMutableByteArray mba 0 mba2 0 l'
+ BA# ba# <- unsafeFreezeByteArray mba2
+ return (SBS ba#)
+{-# INLINE createAndTrim'' #-}
+
+-- Returns the index of the first match or the length of the whole
+-- bytestring if nothing matched.
+findIndexOrLength :: (Word16 -> Bool) -> ShortByteString -> Int
+findIndexOrLength k (assertEven -> sbs) = go 0
+ where
+ l = BS.length sbs
+ ba = asBA sbs
+ w = indexWord16Array ba
+ go !n | n >= l = l `div` 2
+ | k (w n) = n `div` 2
+ | otherwise = go (n + 2)
+{-# INLINE findIndexOrLength #-}
+
+
+-- | Returns the length of the substring matching, not the index.
+-- If no match, returns 0.
+findFromEndUntil :: (Word16 -> Bool) -> ShortByteString -> Int
+findFromEndUntil k sbs = go (BS.length sbs - 2)
+ where
+ ba = asBA sbs
+ w = indexWord16Array ba
+ go !n | n < 0 = 0
+ | k (w n) = (n `div` 2) + 1
+ | otherwise = go (n - 2)
+{-# INLINE findFromEndUntil #-}
+
+
+assertEven :: ShortByteString -> ShortByteString
+assertEven sbs@(SBS barr#)
+ | even (I# (sizeofByteArray# barr#)) = sbs
+ | otherwise = error ("Uneven number of bytes: " <> show (BS.length sbs) <> ". This is not a Word16 bytestream.")
+
+
+-- Common up near identical calls to `error' to reduce the number
+-- constant strings created when compiled:
+errorEmptySBS :: HasCallStack => String -> a
+errorEmptySBS fun = moduleError fun "empty ShortByteString"
+{-# NOINLINE errorEmptySBS #-}
+
+moduleError :: HasCallStack => String -> String -> a
+moduleError fun msg = error (moduleErrorMsg fun msg)
+{-# NOINLINE moduleError #-}
diff --git a/System/AbstractFilePath/Data/ByteString/Short/Word16.hs b/System/AbstractFilePath/Data/ByteString/Short/Word16.hs
new file mode 100644
index 0000000..a187b1e
--- /dev/null
+++ b/System/AbstractFilePath/Data/ByteString/Short/Word16.hs
@@ -0,0 +1,862 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-# OPTIONS_GHC -fno-warn-name-shadowing -fexpose-all-unfoldings #-}
+
+-- |
+-- Module : System.AbstractFilePath.Data.ByteString.Short.Word16
+-- Copyright : © 2022 Julian Ospald
+-- License : MIT
+--
+-- Maintainer : Julian Ospald <hasufell@posteo.de>
+-- Stability : experimental
+-- Portability : portable
+--
+-- ShortByteStrings encoded as UTF16-LE, suitable for windows FFI calls.
+--
+-- Word16s are *always* in BE encoding (both input and output), so e.g. 'pack'
+-- takes a list of BE encoded @[Word16]@ and produces a UTF16-LE encoded ShortByteString.
+--
+-- Likewise, 'unpack' takes a UTF16-LE encoded ShortByteString and produces a list of BE encoded @[Word16]@.
+--
+-- Indices and lengths are always in respect to Word16, not Word8.
+--
+-- All functions will error out if the input string is not a valid UTF16 stream (uneven number of bytes).
+-- So use this module with caution.
+module System.AbstractFilePath.Data.ByteString.Short.Word16 (
+ -- * The @ShortByteString@ type and representation
+ ShortByteString(..),
+
+ -- * Introducing and eliminating 'ShortByteString's
+ empty,
+ singleton,
+ pack,
+ unpack,
+ fromShort,
+ toShort,
+
+ -- * Basic interface
+ snoc,
+ cons,
+ append,
+ last,
+ tail,
+ uncons,
+ head,
+ init,
+ unsnoc,
+ null,
+ length,
+ numWord16,
+
+ -- * Transforming ShortByteStrings
+ map,
+ reverse,
+ intercalate,
+
+ -- * Reducing 'ShortByteString's (folds)
+ foldl,
+ foldl',
+ foldl1,
+ foldl1',
+
+ foldr,
+ foldr',
+ foldr1,
+ foldr1',
+
+ -- ** Special folds
+ all,
+ any,
+ concat,
+
+ -- ** Generating and unfolding ByteStrings
+ replicate,
+ unfoldr,
+ unfoldrN,
+
+ -- * Substrings
+
+ -- ** Breaking strings
+ take,
+ takeEnd,
+ takeWhileEnd,
+ takeWhile,
+ drop,
+ dropEnd,
+ dropWhile,
+ dropWhileEnd,
+ breakEnd,
+ break,
+ span,
+ spanEnd,
+ splitAt,
+ split,
+ splitWith,
+ stripSuffix,
+ stripPrefix,
+
+ -- * Predicates
+ isInfixOf,
+ isPrefixOf,
+ isSuffixOf,
+
+ -- ** Search for arbitrary substrings
+ breakSubstring,
+
+ -- * Searching ShortByteStrings
+
+ -- ** Searching by equality
+ elem,
+
+ -- ** Searching with a predicate
+ find,
+ filter,
+ partition,
+
+ -- * Indexing ShortByteStrings
+ index,
+ indexMaybe,
+ (!?),
+ elemIndex,
+ elemIndices,
+ count,
+ findIndex,
+ findIndices,
+
+ -- ** Encoding validation
+ -- isValidUtf8,
+
+ -- * Low level conversions
+ -- ** Packing 'CString's and pointers
+ packCWString,
+ packCWStringLen,
+ newCWString,
+
+ -- ** Using ShortByteStrings as 'CString's
+ useAsCWString,
+ useAsCWStringLen
+ )
+where
+import System.AbstractFilePath.Data.ByteString.Short ( append, intercalate, concat, stripSuffix, stripPrefix, isInfixOf, isPrefixOf, isSuffixOf, breakSubstring, length, empty, null, ShortByteString(..), fromShort, toShort )
+import System.AbstractFilePath.Data.ByteString.Short.Internal
+import Data.Bits
+ ( shiftR )
+import Data.Word
+import Prelude hiding
+ ( all
+ , any
+ , reverse
+ , break
+ , concat
+ , drop
+ , dropWhile
+ , elem
+ , filter
+ , foldl
+ , foldl1
+ , foldr
+ , foldr1
+ , head
+ , init
+ , last
+ , length
+ , map
+ , null
+ , replicate
+ , span
+ , splitAt
+ , tail
+ , take
+ , takeWhile
+ )
+import qualified Data.Foldable as Foldable
+import GHC.ST ( ST )
+import GHC.Stack ( HasCallStack )
+
+import qualified Data.ByteString.Short.Internal as BS
+import qualified Data.List as List
+
+
+-- -----------------------------------------------------------------------------
+-- Introducing and eliminating 'ShortByteString's
+
+-- | /O(1)/ Convert a 'Word16' into a 'ShortByteString'
+singleton :: Word16 -> ShortByteString
+singleton = \w -> create 2 (\mba -> writeWord16Array mba 0 w)
+
+
+-- | /O(n)/. Convert a list into a 'ShortByteString'
+pack :: [Word16] -> ShortByteString
+pack = packWord16
+
+
+-- | /O(n)/. Convert a 'ShortByteString' into a list.
+unpack :: ShortByteString -> [Word16]
+unpack = unpackWord16 . assertEven
+
+
+-- ---------------------------------------------------------------------
+-- Basic interface
+
+-- | This is like 'length', but the number of 'Word16', not 'Word8'.
+numWord16 :: ShortByteString -> Int
+numWord16 = (`shiftR` 1) . BS.length . assertEven
+
+infixr 5 `cons` --same as list (:)
+infixl 5 `snoc`
+
+-- | /O(n)/ Append a Word16 to the end of a 'ShortByteString'
+--
+-- Note: copies the entire byte array
+snoc :: ShortByteString -> Word16 -> ShortByteString
+snoc = \(assertEven -> sbs) c -> let l = BS.length sbs
+ nl = l + 2
+ in create nl $ \mba -> do
+ copyByteArray (asBA sbs) 0 mba 0 l
+ writeWord16Array mba l c
+
+-- | /O(n)/ 'cons' is analogous to (:) for lists.
+--
+-- Note: copies the entire byte array
+cons :: Word16 -> ShortByteString -> ShortByteString
+cons c = \(assertEven -> sbs) -> let l = BS.length sbs
+ nl = l + 2
+ in create nl $ \mba -> do
+ writeWord16Array mba 0 c
+ copyByteArray (asBA sbs) 0 mba 2 l
+
+-- | /O(1)/ Extract the last element of a ShortByteString, which must be finite and at least one Word16.
+-- An exception will be thrown in the case of an empty ShortByteString.
+last :: HasCallStack => ShortByteString -> Word16
+last = \(assertEven -> sbs) -> case null sbs of
+ True -> errorEmptySBS "last"
+ False -> indexWord16Array (asBA sbs) (BS.length sbs - 2)
+
+-- | /O(n)/ Extract the elements after the head of a ShortByteString, which must at least one Word16.
+-- An exception will be thrown in the case of an empty ShortByteString.
+--
+-- Note: copies the entire byte array
+tail :: HasCallStack => ShortByteString -> ShortByteString
+tail = \(assertEven -> sbs) ->
+ let l = BS.length sbs
+ nl = l - 2
+ in if
+ | l <= 0 -> errorEmptySBS "tail"
+ | otherwise -> create nl $ \mba -> copyByteArray (asBA sbs) 2 mba 0 nl
+
+-- | /O(n)/ Extract the head and tail of a ByteString, returning Nothing
+-- if it is empty.
+uncons :: ShortByteString -> Maybe (Word16, ShortByteString)
+uncons = \(assertEven -> sbs) ->
+ let l = BS.length sbs
+ nl = l - 2
+ in if | l <= 0 -> Nothing
+ | otherwise -> let h = indexWord16Array (asBA sbs) 0
+ t = create nl $ \mba -> copyByteArray (asBA sbs) 2 mba 0 nl
+ in Just (h, t)
+
+-- | /O(1)/ Extract the first element of a ShortByteString, which must be at least one Word16.
+-- An exception will be thrown in the case of an empty ShortByteString.
+head :: HasCallStack => ShortByteString -> Word16
+head = \(assertEven -> sbs) -> case null sbs of
+ True -> errorEmptySBS "last"
+ False -> indexWord16Array (asBA sbs) 0
+
+-- | /O(n)/ Return all the elements of a 'ShortByteString' except the last one.
+-- An exception will be thrown in the case of an empty ShortByteString.
+--
+-- Note: copies the entire byte array
+init :: HasCallStack => ShortByteString -> ShortByteString
+init = \(assertEven -> sbs) ->
+ let l = BS.length sbs
+ nl = l - 2
+ in if
+ | l <= 0 -> errorEmptySBS "tail"
+ | otherwise -> create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl
+
+-- | /O(n)/ Extract the 'init' and 'last' of a ByteString, returning Nothing
+-- if it is empty.
+unsnoc :: ShortByteString -> Maybe (ShortByteString, Word16)
+unsnoc = \(assertEven -> sbs) ->
+ let l = BS.length sbs
+ nl = l - 2
+ in if | l <= 0 -> Nothing
+ | otherwise -> let l' = indexWord16Array (asBA sbs) (l - 2)
+ i = create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl
+ in Just (i, l')
+
+
+-- ---------------------------------------------------------------------
+-- Transformations
+
+-- | /O(n)/ 'map' @f xs@ is the ShortByteString obtained by applying @f@ to each
+-- element of @xs@.
+map :: (Word16 -> Word16) -> ShortByteString -> ShortByteString
+map f = \(assertEven -> sbs) ->
+ let l = BS.length sbs
+ ba = asBA sbs
+ in create l (\mba -> go ba mba 0 l)
+ where
+ go :: BA -> MBA s -> Int -> Int -> ST s ()
+ go !ba !mba !i !l
+ | i >= l = return ()
+ | otherwise = do
+ let w = indexWord16Array ba i
+ writeWord16Array mba i (f w)
+ go ba mba (i+2) l
+
+-- TODO: implement more efficiently
+-- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order.
+reverse :: ShortByteString -> ShortByteString
+reverse = \(assertEven -> sbs) ->
+ let l = BS.length sbs
+ ba = asBA sbs
+ in create l (\mba -> go ba mba 0 l)
+ where
+ go :: BA -> MBA s -> Int -> Int -> ST s ()
+ go !ba !mba !i !l
+ | i >= l = return ()
+ | otherwise = do
+ let w = indexWord16Array ba i
+ writeWord16Array mba (l - 2 - i) w
+ go ba mba (i+2) l
+
+
+-- ---------------------------------------------------------------------
+-- Special folds
+
+-- | /O(n)/ Applied to a predicate and a 'ShortByteString', 'all' determines
+-- if all elements of the 'ShortByteString' satisfy the predicate.
+all :: (Word16 -> Bool) -> ShortByteString -> Bool
+all k = \(assertEven -> sbs) ->
+ let l = BS.length sbs
+ ba = asBA sbs
+ w = indexWord16Array ba
+ go !n | n >= l = True
+ | otherwise = k (w n) && go (n + 2)
+ in go 0
+
+
+-- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if
+-- any element of the 'ByteString' satisfies the predicate.
+any :: (Word16 -> Bool) -> ShortByteString -> Bool
+any k = \(assertEven -> sbs) ->
+ let l = BS.length sbs
+ ba = asBA sbs
+ w = indexWord16Array ba
+ go !n | n >= l = False
+ | otherwise = k (w n) || go (n + 2)
+ in go 0
+
+
+-- ---------------------------------------------------------------------
+-- Unfolds and replicates
+
+
+-- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@
+-- the value of every element. The following holds:
+--
+-- > replicate w c = unfoldr w (\u -> Just (u,u)) c
+replicate :: Int -> Word16 -> ShortByteString
+replicate w c
+ | w <= 0 = empty
+ -- can't use setByteArray here, because we write UTF-16LE
+ | otherwise = create (w * 2) (\mba -> go mba 0)
+ where
+ go mba ix
+ | ix < 0 || ix >= w * 2 = pure ()
+ | otherwise = writeWord16Array mba ix c >> go mba (ix + 2)
+
+-- | /O(n)/, where /n/ is the length of the result. The 'unfoldr'
+-- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a
+-- ShortByteString from a seed value. The function takes the element and
+-- returns 'Nothing' if it is done producing the ShortByteString or returns
+-- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string,
+-- and @b@ is the seed value for further production.
+--
+-- This function is not efficient/safe. It will build a list of @[Word16]@
+-- and run the generator until it returns `Nothing`, otherwise recurse infinitely,
+-- then finally create a 'ShortByteString'.
+--
+-- Examples:
+--
+-- > unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0
+-- > == pack [0, 1, 2, 3, 4, 5]
+--
+unfoldr :: (a -> Maybe (Word16, a)) -> a -> ShortByteString
+unfoldr f x0 = packWord16Rev $ go x0 mempty
+ where
+ go x words' = case f x of
+ Nothing -> words'
+ Just (w, x') -> go x' (w:words')
+
+-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ShortByteString from a seed
+-- value. However, the length of the result is limited by the first
+-- argument to 'unfoldrN'. This function is more efficient than 'unfoldr'
+-- when the maximum length of the result is known.
+--
+-- The following equation relates 'unfoldrN' and 'unfoldr':
+--
+-- > fst (unfoldrN n f s) == take n (unfoldr f s)
+--
+unfoldrN :: forall a.
+ Int -- ^ number of 'Word16'
+ -> (a -> Maybe (Word16, a))
+ -> a
+ -> (ShortByteString, Maybe a)
+unfoldrN i f = \x0 ->
+ if | i < 0 -> (empty, Just x0)
+ | otherwise -> createAndTrim (i * 2) $ \mba -> go mba x0 0
+
+ where
+ go :: forall s. MBA s -> a -> Int -> ST s (Int, Maybe a)
+ go !mba !x !n = go' x n
+ where
+ go' :: a -> Int -> ST s (Int, Maybe a)
+ go' !x' !n'
+ | n' == i * 2 = return (n', Just x')
+ | otherwise = case f x' of
+ Nothing -> return (n', Nothing)
+ Just (w, x'') -> do
+ writeWord16Array mba n' w
+ go' x'' (n'+2)
+
+
+-- --------------------------------------------------------------------
+-- Predicates
+
+
+
+-- ---------------------------------------------------------------------
+-- Substrings
+
+-- | /O(n)/ 'take' @n@, applied to a ShortByteString @xs@, returns the prefix
+-- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.
+--
+-- Note: copies the entire byte array
+take :: Int -- ^ number of Word16
+ -> ShortByteString
+ -> ShortByteString
+take = \n -> \(assertEven -> sbs) ->
+ let sl = numWord16 sbs
+ len8 = n * 2
+ in if | n >= sl -> sbs
+ | n <= 0 -> empty
+ | otherwise ->
+ create len8 $ \mba -> copyByteArray (asBA sbs) 0 mba 0 len8
+
+
+-- | /O(1)/ @'takeEnd' n xs@ is equivalent to @'drop' ('length' xs - n) xs@.
+-- Takes @n@ elements from end of bytestring.
+--
+-- >>> takeEnd 3 "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL"
+-- "e\NULf\NULg\NUL"
+-- >>> takeEnd 0 "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL"
+-- ""
+-- >>> takeEnd 4 "a\NULb\NULc\NUL"
+-- "a\NULb\NULc\NUL"
+takeEnd :: Int -- ^ number of 'Word16'
+ -> ShortByteString
+ -> ShortByteString
+takeEnd n = \(assertEven -> sbs) ->
+ let sl = BS.length sbs
+ n2 = n * 2
+ in if | n2 >= sl -> sbs
+ | n2 <= 0 -> empty
+ | otherwise -> create n2 $ \mba -> copyByteArray (asBA sbs) (max 0 (sl - n2)) mba 0 n2
+
+-- | Similar to 'P.takeWhile',
+-- returns the longest (possibly empty) prefix of elements
+-- satisfying the predicate.
+takeWhile :: (Word16 -> Bool) -> ShortByteString -> ShortByteString
+takeWhile f ps = take (findIndexOrLength (not . f) ps) ps
+
+-- | Returns the longest (possibly empty) suffix of elements
+-- satisfying the predicate.
+--
+-- @'takeWhileEnd' p@ is equivalent to @'reverse' . 'takeWhile' p . 'reverse'@.
+takeWhileEnd :: (Word16 -> Bool) -> ShortByteString -> ShortByteString
+takeWhileEnd f ps = drop (findFromEndUntil (not . f) ps) ps
+
+
+-- | /O(n)/ 'drop' @n@ @xs@ returns the suffix of @xs@ after the first n elements, or @[]@ if @n > 'length' xs@.
+--
+-- Note: copies the entire byte array
+drop :: Int -- ^ number of 'Word16'
+ -> ShortByteString
+ -> ShortByteString
+drop = \n' -> \(assertEven -> sbs) ->
+ let len = BS.length sbs
+ n = n' * 2
+ in if | n <= 0 -> sbs
+ | n >= len -> empty
+ | otherwise ->
+ let newLen = len - n
+ in create newLen $ \mba -> copyByteArray (asBA sbs) n mba 0 newLen
+
+-- | /O(1)/ @'dropEnd' n xs@ is equivalent to @'take' ('length' xs - n) xs@.
+-- Drops @n@ elements from end of bytestring.
+--
+-- >>> dropEnd 3 "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL"
+-- "a\NULb\NULc\NULd\NUL"
+-- >>> dropEnd 0 "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL"
+-- "a\NULb\NULc\NULd\NULe\NULf\NULg\NUL"
+-- >>> dropEnd 4 "a\NULb\NULc\NUL"
+-- ""
+dropEnd :: Int -- ^ number of 'Word16'
+ -> ShortByteString
+ -> ShortByteString
+dropEnd n' = \(assertEven -> sbs) ->
+ let sl = BS.length sbs
+ nl = sl - n
+ n = n' * 2
+ in if | n >= sl -> empty
+ | n <= 0 -> sbs
+ | otherwise -> create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl
+
+-- | Similar to 'P.dropWhile',
+-- drops the longest (possibly empty) prefix of elements
+-- satisfying the predicate and returns the remainder.
+--
+-- Note: copies the entire byte array
+dropWhile :: (Word16 -> Bool) -> ShortByteString -> ShortByteString
+dropWhile f = \(assertEven -> ps) -> drop (findIndexOrLength (not . f) ps) ps
+
+-- | Similar to 'P.dropWhileEnd',
+-- drops the longest (possibly empty) suffix of elements
+-- satisfying the predicate and returns the remainder.
+--
+-- @'dropWhileEnd' p@ is equivalent to @'reverse' . 'dropWhile' p . 'reverse'@.
+--
+-- @since 0.10.12.0
+dropWhileEnd :: (Word16 -> Bool) -> ShortByteString -> ShortByteString
+dropWhileEnd f = \(assertEven -> ps) -> take (findFromEndUntil (not . f) ps) ps
+
+-- | Returns the longest (possibly empty) suffix of elements which __do not__
+-- satisfy the predicate and the remainder of the string.
+--
+-- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('takeWhileEnd' (not . p) &&& 'dropWhileEnd' (not . p))@.
+breakEnd :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)
+breakEnd p = \(assertEven -> sbs) -> splitAt (findFromEndUntil p sbs) sbs
+
+-- | Similar to 'P.break',
+-- returns the longest (possibly empty) prefix of elements which __do not__
+-- satisfy the predicate and the remainder of the string.
+--
+-- 'break' @p@ is equivalent to @'span' (not . p)@ and to @('takeWhile' (not . p) &&& 'dropWhile' (not . p))@.
+break :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)
+break = \p -> \(assertEven -> ps) -> case findIndexOrLength p ps of n -> (take n ps, drop n ps)
+
+-- | Similar to 'P.span',
+-- returns the longest (possibly empty) prefix of elements
+-- satisfying the predicate and the remainder of the string.
+--
+-- 'span' @p@ is equivalent to @'break' (not . p)@ and to @('takeWhile' p &&& 'dropWhile' p)@.
+--
+span :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)
+span p = break (not . p) . assertEven
+
+-- | Returns the longest (possibly empty) suffix of elements
+-- satisfying the predicate and the remainder of the string.
+--
+-- 'spanEnd' @p@ is equivalent to @'breakEnd' (not . p)@ and to @('takeWhileEnd' p &&& 'dropWhileEnd' p)@.
+--
+-- We have
+--
+-- > spanEnd (not . isSpace) "x y z" == ("x y ", "z")
+--
+-- and
+--
+-- > spanEnd (not . isSpace) ps
+-- > ==
+-- > let (x, y) = span (not . isSpace) (reverse ps) in (reverse y, reverse x)
+--
+spanEnd :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)
+spanEnd p = \(assertEven -> ps) -> splitAt (findFromEndUntil (not.p) ps) ps
+
+-- | /O(n)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@.
+--
+-- Note: copies the substrings
+splitAt :: Int -- ^ number of Word16
+ -> ShortByteString
+ -> (ShortByteString, ShortByteString)
+splitAt n' = \(assertEven -> sbs) -> if
+ | n <= 0 -> (empty, sbs)
+ | otherwise ->
+ let slen = BS.length sbs
+ in if | n >= BS.length sbs -> (sbs, empty)
+ | otherwise ->
+ let llen = min slen (max 0 n)
+ rlen = max 0 (slen - max 0 n)
+ lsbs = create llen $ \mba -> copyByteArray (asBA sbs) 0 mba 0 llen
+ rsbs = create rlen $ \mba -> copyByteArray (asBA sbs) n mba 0 rlen
+ in (lsbs, rsbs)
+ where
+ n = n' * 2
+
+-- | /O(n)/ Break a 'ShortByteString' into pieces separated by the byte
+-- argument, consuming the delimiter. I.e.
+--
+-- > split 10 "a\nb\nd\ne" == ["a","b","d","e"] -- fromEnum '\n' == 10
+-- > split 97 "aXaXaXa" == ["","X","X","X",""] -- fromEnum 'a' == 97
+-- > split 120 "x" == ["",""] -- fromEnum 'x' == 120
+-- > split undefined "" == [] -- and not [""]
+--
+-- and
+--
+-- > intercalate [c] . split c == id
+-- > split == splitWith . (==)
+--
+-- Note: copies the substrings
+split :: Word16 -> ShortByteString -> [ShortByteString]
+split w = splitWith (== w) . assertEven
+
+
+-- | /O(n)/ Splits a 'ShortByteString' into components delimited by
+-- separators, where the predicate returns True for a separator element.
+-- The resulting components do not contain the separators. Two adjacent
+-- separators result in an empty component in the output. eg.
+--
+-- > splitWith (==97) "aabbaca" == ["","","bb","c",""] -- fromEnum 'a' == 97
+-- > splitWith undefined "" == [] -- and not [""]
+--
+splitWith :: (Word16 -> Bool) -> ShortByteString -> [ShortByteString]
+splitWith p = \(assertEven -> sbs) -> if
+ | BS.null sbs -> []
+ | otherwise -> go sbs
+ where
+ go sbs'
+ | BS.null sbs' = [mempty]
+ | otherwise =
+ case break p sbs' of
+ (a, b)
+ | BS.null b -> [a]
+ | otherwise -> a : go (tail b)
+
+
+-- ---------------------------------------------------------------------
+-- Reducing 'ByteString's
+
+-- | 'foldl', applied to a binary operator, a starting value (typically
+-- the left-identity of the operator), and a ShortByteString, reduces the
+-- ShortByteString using the binary operator, from left to right.
+--
+foldl :: (a -> Word16 -> a) -> a -> ShortByteString -> a
+foldl f v = List.foldl f v . unpack . assertEven
+
+-- | 'foldl'' is like 'foldl', but strict in the accumulator.
+--
+foldl' :: (a -> Word16 -> a) -> a -> ShortByteString -> a
+foldl' f v = List.foldl' f v . unpack . assertEven
+
+-- | 'foldr', applied to a binary operator, a starting value
+-- (typically the right-identity of the operator), and a ShortByteString,
+-- reduces the ShortByteString using the binary operator, from right to left.
+foldr :: (Word16 -> a -> a) -> a -> ShortByteString -> a
+foldr f v = List.foldr f v . unpack . assertEven
+
+-- | 'foldr'' is like 'foldr', but strict in the accumulator.
+foldr' :: (Word16 -> a -> a) -> a -> ShortByteString -> a
+foldr' k v = Foldable.foldr' k v . unpack . assertEven
+
+-- | 'foldl1' is a variant of 'foldl' that has no starting value
+-- argument, and thus must be applied to non-empty 'ShortByteString's.
+-- An exception will be thrown in the case of an empty ShortByteString.
+foldl1 :: HasCallStack => (Word16 -> Word16 -> Word16) -> ShortByteString -> Word16
+foldl1 k = List.foldl1 k . unpack . assertEven
+
+-- | 'foldl1'' is like 'foldl1', but strict in the accumulator.
+-- An exception will be thrown in the case of an empty ShortByteString.
+foldl1' :: HasCallStack => (Word16 -> Word16 -> Word16) -> ShortByteString -> Word16
+foldl1' k = List.foldl1' k . unpack . assertEven
+
+-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,
+-- and thus must be applied to non-empty 'ShortByteString's
+-- An exception will be thrown in the case of an empty ShortByteString.
+foldr1 :: HasCallStack => (Word16 -> Word16 -> Word16) -> ShortByteString -> Word16
+foldr1 k = List.foldr1 k . unpack . assertEven
+
+-- | 'foldr1'' is a variant of 'foldr1', but is strict in the
+-- accumulator.
+foldr1' :: HasCallStack => (Word16 -> Word16 -> Word16) -> ShortByteString -> Word16
+foldr1' k = \(assertEven -> sbs) -> if null sbs then errorEmptySBS "foldr1'" else foldr' k (last sbs) (init sbs)
+
+
+-- --------------------------------------------------------------------
+-- Searching ShortByteString
+
+-- | /O(1)/ 'ShortByteString' index (subscript) operator, starting from 0.
+index :: HasCallStack
+ => ShortByteString
+ -> Int -- ^ number of 'Word16'
+ -> Word16
+index = \(assertEven -> sbs) i -> if
+ | i >= 0 && i < numWord16 sbs -> unsafeIndex sbs i
+ | otherwise -> indexError sbs i
+
+-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:
+--
+-- > 0 <= n < length bs
+--
+-- @since 0.11.0.0
+indexMaybe :: ShortByteString
+ -> Int -- ^ number of 'Word16'
+ -> Maybe Word16
+indexMaybe = \(assertEven -> sbs) i -> if
+ | i >= 0 && i < numWord16 sbs -> Just $! unsafeIndex sbs i
+ | otherwise -> Nothing
+{-# INLINE indexMaybe #-}
+
+unsafeIndex :: ShortByteString
+ -> Int -- ^ number of 'Word16'
+ -> Word16
+unsafeIndex sbs i = indexWord16Array (asBA sbs) (i * 2)
+
+indexError :: HasCallStack => ShortByteString -> Int -> a
+indexError sbs i =
+ moduleError "index" $ "error in array index: " ++ show i
+ ++ " not in range [0.." ++ show (numWord16 sbs) ++ "]"
+
+-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:
+--
+-- > 0 <= n < length bs
+--
+-- @since 0.11.0.0
+(!?) :: ShortByteString
+ -> Int -- ^ number of 'Word16'
+ -> Maybe Word16
+(!?) = indexMaybe
+{-# INLINE (!?) #-}
+
+-- | /O(n)/ 'elem' is the 'ShortByteString' membership predicate.
+elem :: Word16 -> ShortByteString -> Bool
+elem c = \(assertEven -> sbs) -> case elemIndex c sbs of Nothing -> False ; _ -> True
+
+-- | /O(n)/ 'filter', applied to a predicate and a ByteString,
+-- returns a ByteString containing those characters that satisfy the
+-- predicate.
+filter :: (Word16 -> Bool) -> ShortByteString -> ShortByteString
+filter k = \(assertEven -> sbs) ->
+ let l = BS.length sbs
+ in if | l <= 0 -> sbs
+ | otherwise -> createAndTrim' l $ \mba -> go mba (asBA sbs) l
+ where
+ go :: forall s. MBA s -- mutable output bytestring
+ -> BA -- input bytestring
+ -> Int -- length of input bytestring
+ -> ST s Int
+ go !mba ba !l = go' 0 0
+ where
+ go' :: Int -- bytes read
+ -> Int -- bytes written
+ -> ST s Int
+ go' !br !bw
+ | br >= l = return bw
+ | otherwise = do
+ let w = indexWord16Array ba br
+ if k w
+ then do
+ writeWord16Array mba bw w
+ go' (br+2) (bw+2)
+ else
+ go' (br+2) bw
+
+-- | /O(n)/ The 'find' function takes a predicate and a ByteString,
+-- and returns the first element in matching the predicate, or 'Nothing'
+-- if there is no such element.
+--
+-- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing
+--
+find :: (Word16 -> Bool) -> ShortByteString -> Maybe Word16
+find f = \(assertEven -> sbs) -> case findIndex f sbs of
+ Just n -> Just (sbs `index` n)
+ _ -> Nothing
+
+-- | /O(n)/ The 'partition' function takes a predicate a ByteString and returns
+-- the pair of ByteStrings with elements which do and do not satisfy the
+-- predicate, respectively; i.e.,
+--
+-- > partition p bs == (filter p xs, filter (not . p) xs)
+--
+partition :: (Word16 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)
+partition k = \(assertEven -> sbs) ->
+ let l = BS.length sbs
+ in if | l <= 0 -> (sbs, sbs)
+ | otherwise -> createAndTrim'' l $ \mba1 mba2 -> go mba1 mba2 (asBA sbs) l
+ where
+ go :: forall s.
+ MBA s -- mutable output bytestring1
+ -> MBA s -- mutable output bytestring2
+ -> BA -- input bytestring
+ -> Int -- length of input bytestring
+ -> ST s (Int, Int) -- (length mba1, length mba2)
+ go !mba1 !mba2 ba !l = go' 0 0
+ where
+ go' :: Int -- bytes read
+ -> Int -- bytes written to bytestring 1
+ -> ST s (Int, Int) -- (length mba1, length mba2)
+ go' !br !bw1
+ | br >= l = return (bw1, br - bw1)
+ | otherwise = do
+ let w = indexWord16Array ba br
+ if k w
+ then do
+ writeWord16Array mba1 bw1 w
+ go' (br+2) (bw1+2)
+ else do
+ writeWord16Array mba2 (br - bw1) w
+ go' (br+2) bw1
+
+-- --------------------------------------------------------------------
+-- Indexing ShortByteString
+
+-- | /O(n)/ The 'elemIndex' function returns the index of the first
+-- element in the given 'ShortByteString' which is equal to the query
+-- element, or 'Nothing' if there is no such element.
+elemIndex :: Word16
+ -> ShortByteString
+ -> Maybe Int -- ^ number of 'Word16'
+elemIndex k = findIndex (==k) . assertEven
+
+-- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning
+-- the indices of all elements equal to the query element, in ascending order.
+elemIndices :: Word16 -> ShortByteString -> [Int]
+elemIndices k = findIndices (==k) . assertEven
+
+-- | count returns the number of times its argument appears in the ShortByteString
+count :: Word16 -> ShortByteString -> Int
+count w = List.length . elemIndices w . assertEven
+
+-- | /O(n)/ The 'findIndex' function takes a predicate and a 'ShortByteString' and
+-- returns the index of the first element in the ByteString
+-- satisfying the predicate.
+findIndex :: (Word16 -> Bool) -> ShortByteString -> Maybe Int
+findIndex k = \(assertEven -> sbs) ->
+ let l = BS.length sbs
+ ba = asBA sbs
+ w = indexWord16Array ba
+ go !n | n >= l = Nothing
+ | k (w n) = Just (n `shiftR` 1)
+ | otherwise = go (n + 2)
+ in go 0
+
+-- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the
+-- indices of all elements satisfying the predicate, in ascending order.
+findIndices :: (Word16 -> Bool) -> ShortByteString -> [Int]
+findIndices k = \(assertEven -> sbs) ->
+ let l = BS.length sbs
+ ba = asBA sbs
+ w = indexWord16Array ba
+ go !n | n >= l = []
+ | k (w n) = (n `shiftR` 1) : go (n + 2)
+ | otherwise = go (n + 2)
+ in go 0
+
diff --git a/System/AbstractFilePath/Internal.hs b/System/AbstractFilePath/Internal.hs
new file mode 100644
index 0000000..058220d
--- /dev/null
+++ b/System/AbstractFilePath/Internal.hs
@@ -0,0 +1,116 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+
+module System.AbstractFilePath.Internal where
+
+import {-# SOURCE #-} System.AbstractFilePath
+ ( isValid )
+import System.AbstractFilePath.Types
+import System.OsString.Internal
+import qualified System.OsString.Internal as OS
+import System.OsString.Internal.Types
+
+import Control.Monad.Catch
+ ( MonadThrow )
+import Data.ByteString
+ ( ByteString )
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote
+ ( QuasiQuoter (..) )
+import Language.Haskell.TH.Syntax
+ ( Lift (..), lift )
+import System.IO
+ ( TextEncoding )
+#ifndef WINDOWS
+import System.AbstractFilePath.Data.ByteString.Short.Decode
+ (
+ UnicodeException (..)
+ )
+#endif
+
+
+
+-- | Total Unicode-friendly encoding.
+--
+-- On windows this encodes as UTF16, which is expected.
+-- On unix this encodes as UTF8, which is a good guess.
+toAbstractFilePath :: String -> AbstractFilePath
+toAbstractFilePath = toOsString
+
+
+-- | Like 'toAbstractFilePath', except on unix this uses the current
+-- locale for encoding instead of always UTF8.
+--
+-- Looking up the locale requires IO. If you're not worried about calls
+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible.
+toAbstractFilePathIO :: String -> IO AbstractFilePath
+toAbstractFilePathIO = toOsStringIO
+
+
+-- | Partial unicode friendly decoding.
+--
+-- On windows this decodes as UTF16 (which is the expected filename encoding).
+-- On unix this decodes as UTF8 (which is a good guess). Note that
+-- filenames on unix are encoding agnostic char arrays.
+--
+-- Throws a 'UnicodeException' if decoding fails.
+--
+-- Note that filenames of different encodings may have the same @String@
+-- representation, although they're not the same byte-wise.
+fromAbstractFilePath :: MonadThrow m => AbstractFilePath -> m String
+fromAbstractFilePath = fromOsString
+
+-- | Like 'fromAbstractFilePath', except on unix this uses the provided
+-- 'TextEncoding' for decoding.
+--
+-- On windows, the TextEncoding parameter is ignored.
+fromAbstractFilePathEnc :: AbstractFilePath -> TextEncoding -> Either UnicodeException String
+fromAbstractFilePathEnc = fromOsStringEnc
+
+-- | Like 'fromAbstractFilePath', except on unix this uses the current
+-- locale for decoding instead of always UTF8.
+--
+-- Looking up the locale requires IO. If you're not worried about calls
+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible.
+--
+-- Throws 'UnicodeException' if decoding fails.
+fromAbstractFilePathIO :: AbstractFilePath -> IO String
+fromAbstractFilePathIO = fromOsStringIO
+
+
+-- | Constructs an @AbstractFilePath@ from a ByteString.
+--
+-- On windows, this ensures valid UTF16, on unix it is passed unchanged/unchecked.
+--
+-- Throws 'UnicodeException' on invalid UTF16 on windows.
+bsToAFP :: MonadThrow m
+ => ByteString
+ -> m AbstractFilePath
+bsToAFP = OS.bsToOsString
+
+
+mkAbstractFilePath :: ByteString -> Q Exp
+mkAbstractFilePath bs =
+ case bsToAFP bs of
+ Just afp' ->
+ if isValid afp'
+ then lift afp'
+ else error "invalid filepath"
+ Nothing -> error "invalid encoding"
+
+-- | QuasiQuote an 'AbstractFilePath'. This accepts Unicode characters
+-- and encodes as UTF-8 on unix and UTF-16 on windows. Runs 'filepathIsValid'
+-- on the input.
+afp :: QuasiQuoter
+afp = qq mkAbstractFilePath
+
+
+unpackAFP :: AbstractFilePath -> [OsChar]
+unpackAFP = unpackOsString
+
+
+packAFP :: [OsChar] -> AbstractFilePath
+packAFP = packOsString
+
diff --git a/System/AbstractFilePath/Posix.hs b/System/AbstractFilePath/Posix.hs
new file mode 100644
index 0000000..b23be2c
--- /dev/null
+++ b/System/AbstractFilePath/Posix.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE CPP #-}
+
+#undef WINDOWS
+#define POSIX
+#define IS_WINDOWS False
+#define FILEPATH_NAME PosixFilePath
+#define OSSTRING_NAME PosixString
+#define WORD_NAME PosixChar
+#define CTOR PS
+#define WTOR PW
+
+#include "Common.hs"
diff --git a/System/AbstractFilePath/Posix/Internal.hs b/System/AbstractFilePath/Posix/Internal.hs
new file mode 100644
index 0000000..83f1479
--- /dev/null
+++ b/System/AbstractFilePath/Posix/Internal.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE CPP #-}
+
+#undef WINDOWS
+#define ABSTRACT_FILEPATH
+#define IS_WINDOWS False
+#define MODULE_NAME Posix
+
+#include "../../FilePath/Internal.hs"
diff --git a/System/AbstractFilePath/Types.hs b/System/AbstractFilePath/Types.hs
new file mode 100644
index 0000000..b9d2a1f
--- /dev/null
+++ b/System/AbstractFilePath/Types.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE CPP #-}
+module System.AbstractFilePath.Types
+ ( module System.AbstractFilePath.Types
+ , unWFP
+ , unPFP
+ , unWW
+ , unPW
+ , WindowsString(WS)
+ , PosixString(PS)
+ , WindowsChar(WW)
+ , PosixChar(PW)
+ )
+where
+
+import System.OsString.Internal.Types
+
+
+-- | Filepaths are UTF16 data on windows as passed to syscalls.
+type WindowsFilePath = WindowsString
+
+-- | Filepaths are @char[]@ data on unix as passed to syscalls.
+type PosixFilePath = PosixString
+
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+type PlatformFilePath = WindowsFilePath
+#else
+type PlatformFilePath = PosixFilePath
+#endif
+
+
+-- | Type representing filenames\/pathnames.
+--
+-- This type doesn't add any guarantees over 'OsString'.
+type AbstractFilePath = OsString
diff --git a/System/AbstractFilePath/Windows.hs b/System/AbstractFilePath/Windows.hs
new file mode 100644
index 0000000..4dda5fa
--- /dev/null
+++ b/System/AbstractFilePath/Windows.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE CPP #-}
+
+#undef POSIX
+#define IS_WINDOWS True
+#define WINDOWS
+#define FILEPATH_NAME WindowsFilePath
+#define OSSTRING_NAME WindowsString
+#define WORD_NAME WindowsChar
+#define CTOR WS
+#define WTOR WW
+
+#include "Common.hs"
diff --git a/System/AbstractFilePath/Windows/Internal.hs b/System/AbstractFilePath/Windows/Internal.hs
new file mode 100644
index 0000000..faaf9c5
--- /dev/null
+++ b/System/AbstractFilePath/Windows/Internal.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE CPP #-}
+
+#undef POSIX
+#define WINDOWS
+#define ABSTRACT_FILEPATH
+#define IS_WINDOWS True
+#define MODULE_NAME Windows
+
+#include "../../FilePath/Internal.hs"
diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs
index c3dcb86..37ae792 100644
--- a/System/FilePath/Internal.hs
+++ b/System/FilePath/Internal.hs
@@ -1,6 +1,3 @@
-#if __GLASGOW_HASKELL__ >= 704
-{-# LANGUAGE Safe #-}
-#endif
{-# LANGUAGE PatternGuards #-}
-- This template expects CPP definitions for:
@@ -61,16 +58,25 @@
--
-- References:
-- [1] <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx Naming Files, Paths and Namespaces> (Microsoft MSDN)
+#ifndef ABSTRACT_FILEPATH
module System.FilePath.MODULE_NAME
+#else
+module System.AbstractFilePath.MODULE_NAME.Internal
+#endif
(
-- * Separator predicates
+#ifndef ABSTRACT_FILEPATH
FilePath,
+#endif
pathSeparator, pathSeparators, isPathSeparator,
searchPathSeparator, isSearchPathSeparator,
extSeparator, isExtSeparator,
-- * @$PATH@ methods
- splitSearchPath, getSearchPath,
+ splitSearchPath,
+#ifndef ABSTRACT_FILEPATH
+ getSearchPath,
+#endif
-- * Extension functions
splitExtension,
@@ -103,11 +109,39 @@ module System.FilePath.MODULE_NAME
)
where
-import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
+import Prelude (Char, Bool(..), Maybe(..), (.), (&&), (<=), not, fst, maybe, (||), (==), ($), otherwise, fmap, mempty, (>=), (/=), (++), snd)
+import Data.Semigroup ((<>))
+import qualified Prelude as P
import Data.Maybe(isJust)
-import Data.List(stripPrefix, isSuffixOf)
+import qualified Data.List as L
+#ifndef ABSTRACT_FILEPATH
+import Data.String (fromString)
import System.Environment(getEnv)
+import Prelude (String, map, FilePath, Eq, IO, id, last, init, reverse, dropWhile, null, break, takeWhile, take, all, elem, any, head, length, tail, span)
+import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
+import Data.List(stripPrefix, isSuffixOf, uncons)
+#define CHAR Char
+#define STRING String
+#define FILEPATH FilePath
+#else
+import Prelude (fromIntegral)
+import System.AbstractFilePath.Data.ByteString.Short.Encode
+import qualified Data.Char as C
+#ifdef WINDOWS
+import Data.Word ( Word16 )
+import System.AbstractFilePath.Data.ByteString.Short.Word16
+#define CHAR Word16
+#define STRING ShortByteString
+#define FILEPATH ShortByteString
+#else
+import Data.Word ( Word8 )
+import System.AbstractFilePath.Data.ByteString.Short
+#define CHAR Word8
+#define STRING ShortByteString
+#define FILEPATH ShortByteString
+#endif
+#endif
infixr 7 <.>, -<.>
@@ -138,51 +172,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 +236,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 ABSTRACT_FILEPATH
+-- | Get a list of 'FILEPATH's in the $PATH variable.
+getSearchPath :: IO [FILEPATH]
getSearchPath = fmap splitSearchPath (getEnv "PATH")
+#endif
---------------------------------------------------------------------
@@ -224,7 +269,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,12 +278,12 @@ 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)
+splitExtension :: FILEPATH -> (STRING, STRING)
+splitExtension x = if null nameDot
+ then (x, mempty)
+ else (dir <> init nameDot, singleton extSeparator <> ext)
where
- (dir,file) = splitFileName_ x
+ (dir,file) = splitFileName_ x
(nameDot,ext) = breakEnd isExtSeparator file
-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
@@ -247,7 +292,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 +300,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 +313,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 +340,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 <> singleton extSeparator <> xs
(a,b) = splitDrive file
@@ -309,7 +355,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 +367,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 (singleton _period <> 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 +389,22 @@ 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 singleton _period <> 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 +415,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 +433,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 +443,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 +464,54 @@ 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 unpack bs of
+ (x:c:y:xs)
+ | c == _colon && isLetter x && isPathSeparator y -> Just $ addSlash (pack [x,_colon]) (pack (y:xs))
+ (x:c:xs)
+ | c == _colon && isLetter x -> Just (pack [x,_colon], pack xs)
+ _ -> 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 (singleton s1 <> singleton s2 <> 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 +524,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 +547,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 +558,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 +576,31 @@ 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
+splitFileName :: FILEPATH -> (STRING, STRING)
+splitFileName x = if null path
+ then (dotSlash, file)
+ else (path, file)
+ where
+ (path, file) = splitFileName_ x
+ dotSlash = singleton _period <> 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
+splitFileName_ :: FILEPATH -> (STRING, STRING)
+splitFileName_ fp = (drv <> dir, file)
+ where
+ (drv, pth) = splitDrive fp
+ (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 :: FILEPATH -> STRING -> FILEPATH
replaceFileName x y = a </> y where (a,_) = splitFileName_ x
-- | Drop the filename. Unlike 'takeDirectory', this function will leave
@@ -549,7 +608,7 @@ replaceFileName x y = a </> y where (a,_) = splitFileName_ x
--
-- > dropFileName "/directory/file.ext" == "/directory/"
-- > dropFileName x == fst (splitFileName x)
-dropFileName :: FilePath -> FilePath
+dropFileName :: FILEPATH -> FILEPATH
dropFileName = fst . splitFileName
@@ -557,12 +616,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 +633,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 +643,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 +653,16 @@ 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 x
+ | null x = False
+ | otherwise = isPathSeparator $ head x
-- | Add a trailing file path separator if one is not already present.
@@ -609,8 +670,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 +680,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 +701,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 <> singleton pathSeparator <> b
-- | Combine two paths with a path separator.
@@ -707,7 +770,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 +783,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 +805,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 +828,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 +843,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 +874,26 @@ 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 | length x >= 1 && isPathSeparator (head x) && not (hasDrive x) = tail x
+ dropAbs x = dropDrive x
+
+ takeAbs x | length x >= 1 && isPathSeparator (head x) && not (hasDrive x) = singleton pathSeparator
+ takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x
-- | Normalise a file
--
@@ -863,53 +927,71 @@ makeRelative root path
-- > Posix: normalise "/" == "/"
-- > Posix: normalise "bob/fred/." == "bob/fred/"
-- > Posix: normalise "//home" == "/home"
-normalise :: FilePath -> FilePath
-normalise path = result ++ [pathSeparator | addPathSeparator]
+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 filepath
+ && 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]
+ | otherwise = if isJust $ readDriveLetter x2
+ then map toUpper x2
+ else x2
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
-
+ 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 +1011,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 +1042,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 <> singleton pathSeparator <> pth)
+ | otherwise = joinDrive drv $ validElements $ validCHARs pth
+
+ where
+ (drv,pth) = splitDrive path
- validChars = map f
- f x = if isBadCharacter x then '_' else x
+ validCHARs = map f
+ f x = if isBadCHARacter x then _underscore 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
+ 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 +1086,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 +1095,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,9 +1103,10 @@ isRelativeDrive x =
-- | @not . 'isRelative'@
--
-- > isAbsolute x == not (isRelative x)
-isAbsolute :: FilePath -> Bool
+isAbsolute :: FILEPATH -> Bool
isAbsolute = not . isRelative
+#ifndef ABSTRACT_FILEPATH
-----------------------------------------------------------------------------
-- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2])
@@ -1046,3 +1131,103 @@ breakEnd p = spanEnd (not . p)
-- before the suffix, if it does.
stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys)
+
+
+unsnoc :: [a] -> Maybe ([a], a)
+unsnoc [] = Nothing
+unsnoc xs = Just (init xs, last xs)
+
+
+_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
+snoc str = \c -> str <> [c]
+
+#else
+#ifdef WINDOWS
+fromString :: P.String -> STRING
+fromString = encodeUtf16LE
+#else
+fromString :: P.String -> STRING
+fromString = encodeUtf8
+#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
diff --git a/System/FilePath/Posix.hs b/System/FilePath/Posix.hs
index 219f7d1..d07171f 100644
--- a/System/FilePath/Posix.hs
+++ b/System/FilePath/Posix.hs
@@ -1,1048 +1,7 @@
+{-# 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"
diff --git a/System/FilePath/Windows.hs b/System/FilePath/Windows.hs
index 56aa719..a53580c 100644
--- a/System/FilePath/Windows.hs
+++ b/System/FilePath/Windows.hs
@@ -1,1048 +1,8 @@
+{-# 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"
diff --git a/System/OsString.hs b/System/OsString.hs
new file mode 100644
index 0000000..47e7250
--- /dev/null
+++ b/System/OsString.hs
@@ -0,0 +1,60 @@
+-- |
+-- Module : OsString
+-- Copyright : © 2021 Julian Ospald
+-- License : MIT
+--
+-- Maintainer : Julian Ospald <hasufell@posteo.de>
+-- Stability : experimental
+-- Portability : portable
+--
+-- An implementation of platform specific short 'OsString', which is:
+--
+-- 1. on windows UTF16 data
+-- 2. on unix UTF8 data
+--
+-- It captures the notion of syscall specific encoding to avoid roundtrip issues
+-- and memory fragmentation by using unpinned byte arrays.
+module System.OsString
+ (
+ -- * String types
+ OsString
+
+ -- * String construction
+ , toOsString
+ , toOsStringIO
+ , bsToOsString
+ , osstr
+ , packOsString
+
+ -- * String deconstruction
+ , fromOsString
+ , fromOsStringEnc
+ , fromOsStringIO
+ , unpackOsString
+
+ -- * Word types
+ , OsChar
+
+ -- * Word construction
+ , unsafeFromChar
+
+ -- * Word deconstruction
+ , toChar
+ )
+where
+
+import System.OsString.Internal
+ ( bsToOsString
+ , unsafeFromChar
+ , toChar
+ , fromOsString
+ , fromOsStringEnc
+ , fromOsStringIO
+ , osstr
+ , packOsString
+ , toOsString
+ , toOsStringIO
+ , unpackOsString
+ )
+import System.OsString.Internal.Types
+ ( OsString, OsChar )
diff --git a/System/OsString/Common.hs b/System/OsString/Common.hs
new file mode 100644
index 0000000..d52ce58
--- /dev/null
+++ b/System/OsString/Common.hs
@@ -0,0 +1,277 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE TypeApplications #-}
+-- This template expects CPP definitions for:
+-- MODULE_NAME = Posix | Windows
+-- IS_WINDOWS = False | True
+
+module System.OsString.MODULE_NAME
+ (
+ -- * Types
+#ifdef WINDOWS
+ WindowsString
+ , WindowsChar
+#else
+ PosixString
+ , PosixChar
+#endif
+
+ -- * String construction
+ , toPlatformString
+ , toPlatformStringIO
+ , bsToPlatformString
+ , pstr
+ , packPlatformString
+
+ -- * String deconstruction
+ , fromPlatformString
+#ifndef WINDOWS
+ , fromPlatformStringEnc
+#endif
+ , fromPlatformStringIO
+ , unpackPlatformString
+
+ -- * Word construction
+ , unsafeFromChar
+
+ -- * Word deconstruction
+ , toChar
+ )
+where
+
+
+import System.OsString.Internal.Types
+#ifdef WINDOWS
+ ( WindowsString
+ , WindowsChar
+ )
+#else
+ ( PosixString
+ , PosixChar
+ )
+#endif
+
+import System.AbstractFilePath.Data.ByteString.Short.Encode
+ (
+#ifdef WINDOWS
+ encodeUtf16LE
+#else
+ encodeUtf8
+#endif
+ )
+import System.AbstractFilePath.Data.ByteString.Short.Decode
+ (
+#ifdef WINDOWS
+ decodeUtf16LE'
+ , decodeUtf16LE''
+#else
+ decodeUtf8'
+#endif
+ )
+import System.OsString.Internal.Types (
+#ifdef WINDOWS
+ WindowsString(..), WindowsChar(..)
+#else
+ PosixString(..), PosixChar(..)
+#endif
+ )
+
+import Data.Char
+import Control.Exception
+ ( throwIO )
+import Control.Monad.Catch
+ ( MonadThrow, throwM )
+import Data.ByteString.Internal
+ ( ByteString )
+#ifndef WINDOWS
+import Control.Exception
+ ( SomeException, try, displayException )
+import Control.DeepSeq ( force )
+import Data.Bifunctor ( first )
+import GHC.IO
+ ( evaluate, unsafePerformIO )
+import GHC.IO.Encoding
+ ( getFileSystemEncoding )
+import qualified GHC.Foreign as GHC
+import System.IO.Error
+ ( catchIOError )
+import System.IO
+ ( TextEncoding )
+import System.AbstractFilePath.Data.ByteString.Short.Decode
+ (
+ UnicodeException (..)
+ )
+#endif
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote
+ ( QuasiQuoter (..) )
+import Language.Haskell.TH.Syntax
+ ( Lift (..), lift )
+
+
+#ifdef WINDOWS
+import System.AbstractFilePath.Data.ByteString.Short.Word16 as BS
+#else
+import System.AbstractFilePath.Data.ByteString.Short as BS
+#endif
+
+
+
+-- | Total Unicode-friendly encoding.
+--
+-- On windows this encodes as UTF16, which is expected.
+-- On unix this encodes as UTF8, which is a good guess.
+toPlatformString :: String -> PLATFORM_STRING
+#ifdef WINDOWS
+toPlatformString = WS . encodeUtf16LE
+#else
+toPlatformString = PS . encodeUtf8
+#endif
+
+-- | Like 'toPlatformString', except on unix this uses the current
+-- locale for encoding instead of always UTF8.
+--
+-- Looking up the locale requires IO. If you're not worried about calls
+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible.
+toPlatformStringIO :: String -> IO PLATFORM_STRING
+#ifdef WINDOWS
+toPlatformStringIO = pure . WS . encodeUtf16LE
+#else
+toPlatformStringIO str = do
+ enc <- getFileSystemEncoding
+ cstr <- GHC.newCString enc str
+ PS <$> BS.packCString cstr
+#endif
+
+
+-- | Partial unicode friendly decoding.
+--
+-- On windows this decodes as UTF16 (which is the expected filename encoding).
+-- On unix this decodes as UTF8 (which is a good guess). Note that
+-- filenames on unix are encoding agnostic char arrays.
+--
+-- Throws a 'UnicodeException' if decoding fails.
+fromPlatformString :: MonadThrow m => PLATFORM_STRING -> m String
+#ifdef WINDOWS
+fromPlatformString (WS ba) = either throwM pure $ decodeUtf16LE' ba
+#else
+fromPlatformString (PS ba) = either throwM pure $ decodeUtf8' ba
+#endif
+
+#ifndef WINDOWS
+-- | Like 'fromPlatformString', except on unix this uses the provided
+-- 'TextEncoding' for decoding.
+fromPlatformStringEnc :: PLATFORM_STRING -> TextEncoding -> Either UnicodeException String
+fromPlatformStringEnc (PS ba) enc = unsafePerformIO $ do
+ r <- try @SomeException $ BS.useAsCString ba $ \fp -> GHC.peekCString enc fp
+ r' <- evaluate $ force $ first (flip DecodeError Nothing . displayException) $ r
+ pure r'
+#endif
+
+
+-- | Like 'fromPlatformString', except on unix this uses the current
+-- locale for decoding instead of always UTF8.
+--
+-- Looking up the locale requires IO. If you're not worried about calls
+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible.
+--
+-- Throws 'UnicodeException' if decoding fails.
+fromPlatformStringIO :: PLATFORM_STRING -> IO String
+#ifdef WINDOWS
+
+fromPlatformStringIO (WS ba) = either throwIO pure $ decodeUtf16LE' ba
+#else
+fromPlatformStringIO (PS ba) = flip catchIOError (\_ -> throwIO (DecodeError "fromAbstractFilePath' failed" Nothing))
+ $ BS.useAsCString ba $ \fp -> getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp
+#endif
+
+
+-- | Constructs an platform string from a ByteString.
+--
+-- On windows, this ensures valid UTF16, on unix it is passed unchanged/unchecked.
+--
+-- Throws 'UnicodeException' on invalid UTF16 on windows.
+bsToPlatformString :: MonadThrow m
+ => ByteString
+ -> m PLATFORM_STRING
+#ifdef WINDOWS
+bsToPlatformString bs =
+ either throwM (const . pure . WS . toShort $ bs) $ decodeUtf16LE'' bs
+#else
+bsToPlatformString = pure . PS . toShort
+#endif
+
+
+qq :: (ByteString -> Q Exp) -> QuasiQuoter
+qq quoteExp' =
+ QuasiQuoter
+#ifdef WINDOWS
+ { quoteExp = (\s -> quoteExp' . fromShort . encodeUtf16LE $ s)
+ , quotePat = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
+ , quoteType = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a type)"
+ , quoteDec = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"
+ }
+#else
+ { quoteExp = (\s -> quoteExp' . fromShort . encodeUtf8 $ s)
+ , quotePat = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
+ , quoteType = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a type)"
+ , quoteDec = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"
+ }
+#endif
+
+mkPlatformString :: ByteString -> Q Exp
+mkPlatformString bs =
+ case bsToPlatformString bs of
+ Just afp -> lift afp
+ Nothing -> error "invalid encoding"
+
+#ifdef WINDOWS
+-- | QuasiQuote a 'WindowsString'. This accepts Unicode characters
+-- and encodes as UTF-16 on windows.
+#else
+-- | QuasiQuote a 'PosixString'. This accepts Unicode characters
+-- and encodes as UTF-8 on unix.
+#endif
+pstr :: QuasiQuoter
+pstr = qq mkPlatformString
+
+
+unpackPlatformString :: PLATFORM_STRING -> [PLATFORM_WORD]
+#ifdef WINDOWS
+unpackPlatformString (WS ba) = fmap WW $ BS.unpack ba
+#else
+unpackPlatformString (PS ba) = fmap PW $ BS.unpack ba
+#endif
+
+
+packPlatformString :: [PLATFORM_WORD] -> PLATFORM_STRING
+#ifdef WINDOWS
+packPlatformString ws = WS . BS.pack . fmap (\(WW w) -> w) $ ws
+#else
+packPlatformString ws = PS . BS.pack . fmap (\(PW w) -> w) $ ws
+#endif
+
+
+#ifdef WINDOWS
+-- | Truncates to 2 octets.
+unsafeFromChar :: Char -> PLATFORM_WORD
+unsafeFromChar = WW . fromIntegral . fromEnum
+#else
+-- | Truncates to 1 octet.
+unsafeFromChar :: Char -> PLATFORM_WORD
+unsafeFromChar = PW . fromIntegral . fromEnum
+#endif
+
+-- | Converts back to a unicode codepoint (total).
+toChar :: PLATFORM_WORD -> Char
+#ifdef WINDOWS
+toChar (WW w) = chr $ fromIntegral w
+#else
+toChar (PW w) = chr $ fromIntegral w
+#endif
diff --git a/System/OsString/Internal.hs b/System/OsString/Internal.hs
new file mode 100644
index 0000000..afb66fa
--- /dev/null
+++ b/System/OsString/Internal.hs
@@ -0,0 +1,159 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+
+module System.OsString.Internal where
+
+import System.OsString.Internal.Types
+
+import Control.Monad.Catch
+ ( MonadThrow )
+import Data.ByteString
+ ( ByteString )
+import Data.ByteString.Short
+ ( fromShort )
+import System.AbstractFilePath.Data.ByteString.Short.Encode
+import Data.Char
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote
+ ( QuasiQuoter (..) )
+import Language.Haskell.TH.Syntax
+ ( Lift (..), lift )
+import System.IO
+ ( TextEncoding )
+#ifndef WINDOWS
+import System.AbstractFilePath.Data.ByteString.Short.Decode
+ (
+ UnicodeException (..)
+ )
+#endif
+
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+import System.AbstractFilePath.Data.ByteString.Short.Decode
+ ( decodeUtf16LE' )
+import System.OsString.Windows
+import qualified System.OsString.Windows as PF
+#else
+import System.OsString.Posix
+import qualified System.OsString.Posix as PF
+#endif
+
+
+
+
+-- | Total Unicode-friendly encoding.
+--
+-- On windows this encodes as UTF16, which is expected.
+-- On unix this encodes as UTF8, which is a good guess.
+toOsString :: String -> OsString
+toOsString = OsString . toPlatformString
+
+-- | Like 'toOsString', except on unix this uses the current
+-- locale for encoding instead of always UTF8.
+--
+-- Looking up the locale requires IO. If you're not worried about calls
+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible.
+toOsStringIO :: String -> IO OsString
+toOsStringIO = fmap OsString . toPlatformStringIO
+
+
+-- | Partial unicode friendly decoding.
+--
+-- On windows this decodes as UTF16 (which is the expected filename encoding).
+-- On unix this decodes as UTF8 (which is a good guess). Note that
+-- filenames on unix are encoding agnostic char arrays.
+--
+-- Throws a 'UnicodeException' if decoding fails.
+fromOsString :: MonadThrow m => OsString -> m String
+fromOsString (OsString x) = fromPlatformString x
+
+-- | Like 'fromOsString', except on unix this uses the provided
+-- 'TextEncoding' for decoding.
+--
+-- On windows, the TextEncoding parameter is ignored.
+fromOsStringEnc :: OsString -> TextEncoding -> Either UnicodeException String
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+fromOsStringEnc (OsString (WS ba)) _ = decodeUtf16LE' ba
+#else
+fromOsStringEnc (OsString x) = fromPlatformStringEnc x
+#endif
+
+
+-- | Like 'fromOsString', except on unix this uses the current
+-- locale for decoding instead of always UTF8.
+--
+-- Looking up the locale requires IO. If you're not worried about calls
+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible.
+--
+-- Throws 'UnicodeException' if decoding fails.
+fromOsStringIO :: OsString -> IO String
+fromOsStringIO (OsString x) = fromPlatformStringIO x
+
+
+-- | Constructs an @OsString@ from a ByteString.
+--
+-- On windows, this ensures valid UTF16, on unix it is passed unchanged/unchecked.
+--
+-- Throws 'UnicodeException' on invalid UTF16 on windows.
+bsToOsString :: MonadThrow m
+ => ByteString
+ -> m OsString
+bsToOsString = fmap OsString . bsToPlatformString
+
+
+qq :: (ByteString -> Q Exp) -> QuasiQuoter
+qq quoteExp' =
+ QuasiQuoter
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+ { quoteExp = (\s -> quoteExp' . fromShort . encodeUtf16LE $ s)
+ , quotePat = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
+ , quoteType = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a type)"
+ , quoteDec = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"
+ }
+#else
+ { quoteExp = (\s -> quoteExp' . fromShort . encodeUtf8 $ s)
+ , quotePat = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
+ , quoteType = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a type)"
+ , quoteDec = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"
+ }
+#endif
+
+mkOsString :: ByteString -> Q Exp
+mkOsString bs =
+ case bsToOsString bs of
+ Just afp -> lift afp
+ Nothing -> error "invalid encoding"
+
+-- | QuasiQuote an 'OsString'. This accepts Unicode characters
+-- and encodes as UTF-8 on unix and UTF-16 on windows.
+osstr :: QuasiQuoter
+osstr = qq mkOsString
+
+
+unpackOsString :: OsString -> [OsChar]
+unpackOsString (OsString x) = fmap OsChar $ unpackPlatformString x
+
+
+packOsString :: [OsChar] -> OsString
+packOsString = OsString . packPlatformString . fmap (\(OsChar x) -> x)
+
+
+-- | Truncates on unix to 1 and on Windows to 2 octets.
+unsafeFromChar :: Char -> OsChar
+unsafeFromChar = OsChar . PF.unsafeFromChar
+
+-- | Converts back to a unicode codepoint (total).
+toChar :: OsChar -> Char
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+toChar (OsChar (WW w)) = chr $ fromIntegral w
+#else
+toChar (OsChar (PW w)) = chr $ fromIntegral w
+#endif
+
diff --git a/System/OsString/Internal/Types.hs b/System/OsString/Internal/Types.hs
new file mode 100644
index 0000000..cbe892c
--- /dev/null
+++ b/System/OsString/Internal/Types.hs
@@ -0,0 +1,233 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module System.OsString.Internal.Types
+ (
+ WindowsString(..)
+ , PosixString(..)
+ , PlatformString
+ , WindowsChar(..)
+ , PosixChar(..)
+ , PlatformChar
+ , OsString(..)
+ , OsChar(..)
+ )
+where
+
+
+import Control.DeepSeq
+import Data.Data
+import Data.Word
+import GHC.Exts
+ ( IsString (..) )
+import Language.Haskell.TH.Syntax
+ ( Lift (..), lift )
+#if !MIN_VERSION_base(4,11,0)
+import Data.Semigroup
+#endif
+import GHC.Generics (Generic)
+
+import System.AbstractFilePath.Data.ByteString.Short.Decode
+import System.AbstractFilePath.Data.ByteString.Short.Encode
+
+import qualified Data.ByteString.Short as BS
+#if MIN_VERSION_template_haskell(2,16,0)
+import qualified Language.Haskell.TH.Syntax as TH
+#endif
+
+-- Using unpinned bytearrays to avoid Heap fragmentation and
+-- which are reasonably cheap to pass to FFI calls
+-- wrapped with typeclass-friendly types allowing to avoid CPP
+--
+-- Note that, while unpinned bytearrays incur a memcpy on each
+-- FFI call, this overhead is generally much preferable to
+-- the memory fragmentation of pinned bytearrays
+
+-- | Commonly used windows string as UTF16 bytes.
+newtype WindowsString = WS { unWFP :: BS.ShortByteString }
+ deriving (Eq, Ord, Semigroup, Monoid, Typeable, Generic, NFData)
+
+instance Lift WindowsString where
+ lift (WS bs)
+ = [| (WS (BS.pack $(lift $ BS.unpack bs))) :: WindowsString |]
+#if MIN_VERSION_template_haskell(2,17,0)
+ liftTyped = TH.unsafeCodeCoerce . TH.lift
+#elif MIN_VERSION_template_haskell(2,16,0)
+ liftTyped = TH.unsafeTExpCoerce . TH.lift
+#endif
+
+-- | Commonly used Posix string as uninterpreted @char[]@
+-- array.
+newtype PosixString = PS { unPFP :: BS.ShortByteString }
+ deriving (Eq, Ord, Semigroup, Monoid, Typeable, Generic, NFData)
+
+instance Lift PosixString where
+ lift (PS bs)
+ = [| (PS (BS.pack $(lift $ BS.unpack bs))) :: PosixString |]
+#if MIN_VERSION_template_haskell(2,17,0)
+ liftTyped = TH.unsafeCodeCoerce . TH.lift
+#elif MIN_VERSION_template_haskell(2,16,0)
+ liftTyped = TH.unsafeTExpCoerce . TH.lift
+#endif
+
+-- | Decodes as UTF-16LE.
+instance Show WindowsString where
+ show (WS bs) = ('\"': decodeUtf16LEWith lenientDecode bs) <> "\""
+
+-- | Encodes as UTF-16LE.
+instance Read WindowsString where
+ readsPrec p str = [ (WS $ encodeUtf16LE x, y) | (x, y) <- readsPrec p str ]
+
+-- | Decodes as UTF-8 and replaces invalid chars with unicode replacement
+-- char U+FFFD.
+instance Show PosixString where
+ show (PS bs) = ('\"': decodeUtf8With lenientDecode bs) <> "\""
+
+-- | Encodes as UTF-8.
+instance Read PosixString where
+ readsPrec p str = [ (PS $ encodeUtf8 x, y) | (x, y) <- readsPrec p str ]
+
+instance IsString WindowsString where
+ fromString = WS . encodeUtf16LE
+
+instance IsString PosixString where
+ fromString = PS . encodeUtf8
+
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+type PlatformString = WindowsString
+#else
+type PlatformString = PosixString
+#endif
+
+newtype WindowsChar = WW { unWW :: Word16 }
+ deriving (Eq, Ord, Show, Typeable, Generic, NFData)
+newtype PosixChar = PW { unPW :: Word8 }
+ deriving (Eq, Ord, Show, Typeable, Generic, NFData)
+
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+type PlatformChar = WindowsChar
+#else
+type PlatformChar = PosixChar
+#endif
+
+
+-- | Newtype representing short operating system specific strings.
+--
+-- Internally this is either 'WindowsString' or 'PosixString',
+-- depending on the platform. Both use unpinned
+-- 'ShortByteString' for efficiency.
+--
+-- The constructor is only exported via "System.OsString.Internal.Types", since
+-- dealing with the internals isn't generally recommended, but supported
+-- in case you need to write platform specific code.
+newtype OsString = OsString PlatformString
+ deriving (Typeable, Generic, NFData)
+
+-- | Byte equality of the internal representation.
+instance Eq OsString where
+ (OsString a) == (OsString b) = a == b
+
+-- | Byte ordering of the internal representation.
+instance Ord OsString where
+ compare (OsString a) (OsString b) = compare a b
+
+-- | Encodes as UTF16 on windows and UTF8 on unix.
+instance IsString OsString where
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+ fromString = OsString . WS . encodeUtf16LE
+#else
+ fromString = OsString . PS . encodeUtf8
+#endif
+
+
+-- | \"String-Concatenation\" for 'OsString. This is __not__ the same
+-- as '(</>)'.
+instance Monoid OsString where
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+ mempty = OsString (WS BS.empty)
+#if MIN_VERSION_base(4,16,0)
+ mappend = (<>)
+#else
+ mappend (OsString (WS a)) (OsString (WS b))
+ = OsString (WS (mappend a b))
+#endif
+#else
+ mempty = OsString (PS BS.empty)
+#if MIN_VERSION_base(4,16,0)
+ mappend = (<>)
+#else
+ mappend (OsString (PS a)) (OsString (PS b))
+ = OsString (PS (mappend a b))
+#endif
+#endif
+#if MIN_VERSION_base(4,11,0)
+instance Semigroup OsString where
+#if MIN_VERSION_base(4,16,0)
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+ (<>) (OsString (WS a)) (OsString (WS b))
+ = OsString (WS (mappend a b))
+#else
+ (<>) (OsString (PS a)) (OsString (PS b))
+ = OsString (PS (mappend a b))
+#endif
+#else
+ (<>) = mappend
+#endif
+#endif
+
+
+instance Lift OsString where
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+ lift (OsString (WS bs))
+ = [| OsString (WS (BS.pack $(lift $ BS.unpack bs))) :: OsString |]
+#else
+ lift (OsString (PS bs))
+ = [| OsString (PS (BS.pack $(lift $ BS.unpack bs))) :: OsString |]
+#endif
+#if MIN_VERSION_template_haskell(2,17,0)
+ liftTyped = TH.unsafeCodeCoerce . TH.lift
+#elif MIN_VERSION_template_haskell(2,16,0)
+ liftTyped = TH.unsafeTExpCoerce . TH.lift
+#endif
+
+-- | Decodes as UTF-16 on windows.
+--
+-- Decodes as UTF-8 on unix and replaces invalid chars with unicode replacement
+-- char U+FFFD.
+instance Show OsString where
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+ show (OsString (WS bs)) = ('\"': decodeUtf16LEWith lenientDecode bs) <> "\""
+#else
+ show (OsString (PS bs)) = ('\"': decodeUtf8With lenientDecode bs) <> "\""
+#endif
+
+-- | Encodes as UTF-8 on unix and UTF-16LE on windows.
+instance Read OsString where
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+ readsPrec p str = [ (OsString $ WS $ encodeUtf16LE x, y) | (x, y) <- readsPrec p str ]
+#else
+ readsPrec p str = [ (OsString $ PS $ encodeUtf8 x, y) | (x, y) <- readsPrec p str ]
+#endif
+
+
+-- | Newtype representing a code unit.
+--
+-- On Windows, this is restricted to two-octet codepoints 'Word16',
+-- on POSIX one-octet ('Word8').
+newtype OsChar = OsChar PlatformChar
+ deriving (Show, Typeable, Generic, NFData)
+
+-- | Byte equality of the internal representation.
+instance Eq OsChar where
+ (OsChar a) == (OsChar b) = a == b
+
+-- | Byte ordering of the internal representation.
+instance Ord OsChar where
+ compare (OsChar a) (OsChar b) = compare a b
+
+
+
diff --git a/System/OsString/Posix.hs b/System/OsString/Posix.hs
new file mode 100644
index 0000000..33b4d84
--- /dev/null
+++ b/System/OsString/Posix.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE CPP #-}
+#undef WINDOWS
+#define MODULE_NAME Posix
+#define PLATFORM_STRING PosixString
+#define PLATFORM_WORD PosixChar
+#define IS_WINDOWS False
+#include "Common.hs"
diff --git a/System/OsString/Types.hs b/System/OsString/Types.hs
new file mode 100644
index 0000000..896c3b2
--- /dev/null
+++ b/System/OsString/Types.hs
@@ -0,0 +1,14 @@
+module System.OsString.Types
+ (
+ WindowsString
+ , PosixString
+ , PlatformString
+ , WindowsChar
+ , PosixChar
+ , PlatformChar
+ , OsString
+ , OsChar
+ )
+where
+
+import System.OsString.Internal.Types
diff --git a/System/OsString/Windows.hs b/System/OsString/Windows.hs
new file mode 100644
index 0000000..1f15653
--- /dev/null
+++ b/System/OsString/Windows.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE CPP #-}
+#undef POSIX
+#define MODULE_NAME Windows
+#define PLATFORM_STRING WindowsString
+#define PLATFORM_WORD WindowsChar
+#define IS_WINDOWS True
+#define WINDOWS
+#include "Common.hs"
+#undef MODULE_NAME
+#undef FILEPATH_NAME
+#undef OSSTRING_NAME
+#undef IS_WINDOWS
+#undef WINDOWS
diff --git a/cabal.project b/cabal.project
new file mode 100644
index 0000000..6f92079
--- /dev/null
+++ b/cabal.project
@@ -0,0 +1 @@
+packages: ./
diff --git a/changelog.md b/changelog.md
index f5c477e..eddd430 100644
--- a/changelog.md
+++ b/changelog.md
@@ -2,6 +2,11 @@
_Note: below all `FilePath` values are unquoted, so `\\` really means two backslashes._
+## 2.0.0.0 ????
+
+Implementation of the [Abstract FilePath Proposal](https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/abstract-file-path)
+in user-space as a separate type.
+
## 1.4.2.2 *Dec 2021*
This release is purely a documentation release, fixing the broken haddock links.
diff --git a/filepath.cabal b/filepath.cabal
index b4adf01..88849aa 100644
--- a/filepath.cabal
+++ b/filepath.cabal
@@ -1,68 +1,160 @@
-cabal-version: 1.18
-name: filepath
-version: 1.4.2.2
+cabal-version: 2.0
+name: filepath
+version: 2.0.0.0
+
-- NOTE: Don't forget to update ./changelog.md
-license: BSD3
-license-file: LICENSE
-author: Neil Mitchell <ndmitchell@gmail.com>
-maintainer: Julian Ospald <hasufell@posteo.de>
-copyright: Neil Mitchell 2005-2020
-bug-reports: https://github.com/haskell/filepath/issues
-homepage: https://github.com/haskell/filepath#readme
-category: System
-build-type: Simple
-synopsis: Library for manipulating FilePaths in a cross platform way.
-tested-with: GHC==9.2.1, GHC==9.0.1, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2
+license: BSD3
+license-file: LICENSE
+author: Neil Mitchell <ndmitchell@gmail.com>
+maintainer: Julian Ospald <hasufell@posteo.de>
+copyright: Neil Mitchell 2005-2020
+bug-reports: https://github.com/haskell/filepath/issues
+homepage: https://github.com/haskell/filepath#readme
+category: System
+build-type: Simple
+synopsis: Library for manipulating FilePaths in a cross platform way.
+tested-with:
+ GHC ==8.0.2
+ || ==8.2.2
+ || ==8.4.4
+ || ==8.6.5
+ || ==8.8.4
+ || ==8.10.7
+ || ==9.0.2
+ || ==9.2.2
+
description:
- This package provides functionality for manipulating @FilePath@ values, and is shipped with both <https://www.haskell.org/ghc/ GHC> and the <https://www.haskell.org/platform/ Haskell Platform>. It provides three modules:
- .
- * "System.FilePath.Posix" manipulates POSIX\/Linux style @FilePath@ values (with @\/@ as the path separator).
- .
- * "System.FilePath.Windows" manipulates Windows style @FilePath@ values (with either @\\@ or @\/@ as the path separator, and deals with drives).
- .
- * "System.FilePath" is an alias for the module appropriate to your platform.
- .
- All three modules provide the same API, and the same documentation (calling out differences in the different variants).
+ This package provides functionality for manipulating @FilePath@ values, and is shipped with <https://www.haskell.org/ghc/ GHC>. It provides two variants for filepaths:
+ .
+ 1. legacy filepaths: @type FilePath = String@
+ .
+ 2. abstract filepaths: internally unpinned @ShortByteString@ (platform-dependent encoding)
+ .
+ It is recommended to use @AbstractFilePath@ when possible, because it is more correct.
+ .
+ For each variant there are three main modules:
+ .
+ * "System.FilePath.Posix" / "System.AbstractFilePath.Posix" manipulates POSIX\/Linux style @FilePath@ values (with @\/@ as the path separator).
+ .
+ * "System.FilePath.Windows" / "System.AbstractFilePath.Windows" manipulates Windows style @FilePath@ values (with either @\\@ or @\/@ as the path separator, and deals with drives).
+ .
+ * "System.FilePath" / "System.AbstractFilePath" for dealing with current platform-specific filepath
+ .
+ "System.OsString" is like "System.AbstractFilePath", but more general purpose. Refer to the documentation of
+ those modules for more information.
extra-source-files:
- System/FilePath/Internal.hs
- Makefile
+ Makefile
+ System/AbstractFilePath/Common.hs
+ System/FilePath/Internal.hs
+ System/OsString/Common.hs
+ tests/Properties/Common.hs
+
extra-doc-files:
- README.md
- HACKING.md
- changelog.md
+ changelog.md
+ HACKING.md
+ README.md
+
+flag cpphs
+ description: Use cpphs (fixes haddock source links)
+ default: False
+ manual: True
source-repository head
- type: git
- location: https://github.com/haskell/filepath.git
+ type: git
+ location: https://github.com/haskell/filepath.git
library
- default-language: Haskell2010
- other-extensions:
- CPP
- PatternGuards
- if impl(GHC >= 7.2)
- other-extensions: Safe
+ default-language: Haskell2010
+ other-extensions:
+ CPP
+ PatternGuards
+
+ if impl(ghc >=7.2)
+ other-extensions: Safe
+
+ exposed-modules:
+ System.AbstractFilePath
+ System.AbstractFilePath.Data.ByteString.Short
+ System.AbstractFilePath.Data.ByteString.Short.Decode
+ System.AbstractFilePath.Data.ByteString.Short.Encode
+ System.AbstractFilePath.Data.ByteString.Short.Internal
+ System.AbstractFilePath.Data.ByteString.Short.Word16
+ System.AbstractFilePath.Internal
+ System.AbstractFilePath.Posix
+ System.AbstractFilePath.Posix.Internal
+ System.AbstractFilePath.Types
+ System.AbstractFilePath.Windows
+ System.AbstractFilePath.Windows.Internal
+ System.FilePath
+ System.FilePath.Posix
+ System.FilePath.Windows
+ System.OsString
+ System.OsString.Internal
+ System.OsString.Internal.Types
+ System.OsString.Posix
+ System.OsString.Windows
- exposed-modules:
- System.FilePath
- System.FilePath.Posix
- System.FilePath.Windows
+ build-depends:
+ base >=4.9 && <4.18
+ , bytestring
+ , deepseq
+ , exceptions
+ , template-haskell
- build-depends:
- base >= 4.9 && < 4.18
+ ghc-options: -Wall
- ghc-options: -Wall
+ if flag(cpphs)
+ ghc-options: -pgmPcpphs -optP--cpp
+ build-tool-depends: cpphs:cpphs -any
test-suite filepath-tests
- type: exitcode-stdio-1.0
- default-language: Haskell2010
- main-is: Test.hs
- hs-source-dirs: tests
- other-modules:
- TestGen
- TestUtil
- build-depends:
- filepath,
- base,
- QuickCheck >= 2.7 && < 2.15
+ type: exitcode-stdio-1.0
+ default-language: Haskell2010
+ main-is: Test.hs
+ hs-source-dirs: tests
+ other-modules:
+ TestGen
+ TestUtil
+
+ build-depends:
+ base
+ , bytestring
+ , filepath
+ , QuickCheck >=2.7 && <2.15
+
+test-suite bytestring-tests
+ type: exitcode-stdio-1.0
+ default-language: Haskell2010
+ main-is: Main.hs
+ hs-source-dirs: tests
+ other-modules:
+ Properties
+ Properties.ShortByteString
+ Properties.ShortByteString.Word16
+
+ build-depends:
+ base
+ , bytestring
+ , filepath
+ , QuickCheck >=2.7 && <2.15
+ , tasty
+ , tasty-quickcheck
+
+test-suite abstract-filepath
+ type: exitcode-stdio-1.0
+ main-is: Test.hs
+ build-tool-depends: hspec-discover:hspec-discover -any
+ hs-source-dirs: tests/afpp
+ other-modules:
+ AbstractFilePathSpec
+ Arbitrary
+
+ default-language: Haskell2010
+ build-depends:
+ base
+ , checkers ^>=0.5.6
+ , filepath
+ , QuickCheck >=2.7 && <2.15
+ , tasty
+ , tasty-quickcheck
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 0000000..5344b46
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,3 @@
+resolver: lts-18.28
+packages:
+- .
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
index 0000000..be07688
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,10 @@
+module Main (main) where
+
+import Test.Tasty
+
+import qualified Properties
+
+main :: IO ()
+main = defaultMain $ testGroup "All"
+ [ Properties.testSuite
+ ]
diff --git a/tests/Properties.hs b/tests/Properties.hs
new file mode 100644
index 0000000..41cb73d
--- /dev/null
+++ b/tests/Properties.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Properties (testSuite) where
+
+import Test.Tasty
+
+import qualified Properties.ShortByteString as PropSBS
+import qualified Properties.ShortByteString.Word16 as PropSBSW16
+
+
+------------------------------------------------------------------------
+-- The entry point
+
+testSuite :: TestTree
+testSuite = testGroup "Properties"
+ [ testGroup "ShortByteString" PropSBS.tests
+ , testGroup "ShortByteString.Word16" PropSBSW16.tests
+ ]
+
diff --git a/tests/Properties/Common.hs b/tests/Properties/Common.hs
new file mode 100644
index 0000000..c2d03a5
--- /dev/null
+++ b/tests/Properties/Common.hs
@@ -0,0 +1,422 @@
+-- |
+-- Module : Properties.ShortByteString
+-- Copyright : (c) Andrew Lelechenko 2021
+-- License : BSD-style
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+-- We are happy to sacrifice optimizations in exchange for faster compilation,
+-- but need to test rewrite rules. As one can check using -ddump-rule-firings,
+-- rewrite rules do not fire in -O0 mode, so we use -O1, but disable almost all
+-- optimizations. It roughly halves compilation time.
+{-# OPTIONS_GHC -O1 -fenable-rewrite-rules
+ -fmax-simplifier-iterations=1 -fsimplifier-phases=0
+ -fno-call-arity -fno-case-merge -fno-cmm-elim-common-blocks -fno-cmm-sink
+ -fno-cpr-anal -fno-cse -fno-do-eta-reduction -fno-float-in -fno-full-laziness
+ -fno-loopification -fno-specialise -fno-strictness #-}
+
+#ifdef WORD16
+module Properties.ShortByteString.Word16 (tests) where
+import System.AbstractFilePath.Data.ByteString.Short.Internal (_nul, isSpace)
+import qualified System.AbstractFilePath.Data.ByteString.Short.Word16 as B
+#else
+module Properties.ShortByteString (tests) where
+import qualified System.AbstractFilePath.Data.ByteString.Short as B
+import qualified Data.Char as C
+#endif
+import Data.ByteString.Short (ShortByteString)
+
+import Data.Word
+
+import Control.Arrow
+import Data.Foldable
+import Data.List as L
+import Data.Semigroup
+import Data.Tuple
+import Test.Tasty
+import Test.Tasty.QuickCheck
+import Test.QuickCheck.Monadic
+import Text.Show.Functions ()
+
+#ifdef WORD16
+numWord :: ShortByteString -> Int
+numWord = B.numWord16
+
+toElem :: Word16 -> Word16
+toElem = id
+
+swapW :: Word16 -> Word16
+swapW = byteSwap16
+
+sizedByteString :: Int -> Gen ShortByteString
+sizedByteString n = do m <- choose(0, n)
+ fmap B.pack $ vectorOf m arbitrary
+
+instance Arbitrary ShortByteString where
+ arbitrary = do
+ bs <- sized sizedByteString
+ n <- choose (0, 2)
+ return (B.drop n bs) -- to give us some with non-0 offset
+
+instance CoArbitrary ShortByteString where
+ coarbitrary s = coarbitrary (B.unpack s)
+
+#else
+_nul :: Word8
+_nul = 0x00
+
+isSpace :: Word8 -> Bool
+isSpace = C.isSpace . word8ToChar
+
+-- | Total conversion to char.
+word8ToChar :: Word8 -> Char
+word8ToChar = C.chr . fromIntegral
+
+numWord :: ShortByteString -> Int
+numWord = B.length
+
+toElem :: Word8 -> Word8
+toElem = id
+
+swapW :: Word8 -> Word8
+swapW = id
+
+
+sizedByteString :: Int -> Gen ShortByteString
+sizedByteString n = do m <- choose(0, n)
+ fmap B.pack $ vectorOf m arbitrary
+
+instance Arbitrary ShortByteString where
+ arbitrary = do
+ bs <- sized sizedByteString
+ n <- choose (0, 2)
+ return (B.drop n bs) -- to give us some with non-0 offset
+ shrink = map B.pack . shrink . B.unpack
+
+instance CoArbitrary ShortByteString where
+ coarbitrary s = coarbitrary (B.unpack s)
+
+#endif
+
+
+tests :: [TestTree]
+tests =
+ [ testProperty "pack . unpack" $
+ \x -> x === B.pack (B.unpack x)
+ , testProperty "unpack . pack" $
+ \(map toElem -> xs) -> xs === B.unpack (B.pack xs)
+ , testProperty "read . show" $
+ \x -> (x :: ShortByteString) === read (show x)
+
+ , testProperty "==" $
+ \x y -> (x == y) === (B.unpack x == B.unpack y)
+ , testProperty "== refl" $
+ \x -> (x :: ShortByteString) == x
+ , testProperty "== symm" $
+ \x y -> ((x :: ShortByteString) == y) === (y == x)
+ , testProperty "== pack unpack" $
+ \x -> x == B.pack (B.unpack x)
+
+ , testProperty "compare" $
+ \x y -> compare x y === compare (swapW <$> B.unpack x) (swapW <$> B.unpack y)
+ , testProperty "compare EQ" $
+ \x -> compare (x :: ShortByteString) x == EQ
+ , testProperty "compare GT" $
+ \x (toElem -> c) -> compare (B.snoc x c) x == GT
+ , testProperty "compare LT" $
+ \x (toElem -> c) -> compare x (B.snoc x c) == LT
+ , testProperty "compare GT empty" $
+ \x -> not (B.null x) ==> compare x B.empty == GT
+ , testProperty "compare LT empty" $
+ \x -> not (B.null x) ==> compare B.empty x == LT
+ , testProperty "compare GT concat" $
+ \x y -> not (B.null y) ==> compare (x <> y) x == GT
+ , testProperty "compare char" $
+ \(toElem -> c) (toElem -> d) -> compare (swapW c) (swapW d) == compare (B.singleton c) (B.singleton d)
+ , testProperty "compare unsigned" $ once $
+ compare (B.singleton 255) (B.singleton 127) == GT
+
+ , testProperty "null" $
+ \x -> B.null x === null (B.unpack x)
+ , testProperty "empty 0" $ once $
+ numWord B.empty === 0
+ , testProperty "empty []" $ once $
+ B.unpack B.empty === []
+ , testProperty "mempty 0" $ once $
+ numWord mempty === 0
+ , testProperty "mempty []" $ once $
+ B.unpack mempty === []
+
+ , testProperty "mconcat" $
+ \xs -> B.unpack (mconcat xs) === mconcat (map B.unpack xs)
+ , testProperty "mconcat [x,x]" $
+ \x -> B.unpack (mconcat [x, x]) === mconcat [B.unpack x, B.unpack x]
+ , testProperty "mconcat [x,[]]" $
+ \x -> B.unpack (mconcat [x, B.empty]) === mconcat [B.unpack x, []]
+
+ , testProperty "null" $
+ \x -> B.null x === null (B.unpack x)
+ , testProperty "reverse" $
+ \x -> B.unpack (B.reverse x) === reverse (B.unpack x)
+ , testProperty "all" $
+ \f x -> B.all f x === all f (B.unpack x)
+ , testProperty "all ==" $
+ \(toElem -> c) x -> B.all (== c) x === all (== c) (B.unpack x)
+ , testProperty "any" $
+ \f x -> B.any f x === any f (B.unpack x)
+ , testProperty "any ==" $
+ \(toElem -> c) x -> B.any (== c) x === any (== c) (B.unpack x)
+ , testProperty "mappend" $
+ \x y -> B.unpack (mappend x y) === B.unpack x `mappend` B.unpack y
+ , testProperty "<>" $
+ \x y -> B.unpack (x <> y) === B.unpack x <> B.unpack y
+ , testProperty "stimes" $
+ \(Positive n) x -> stimes (n :: Int) (x :: ShortByteString) === mtimesDefault n x
+
+ , testProperty "break" $
+ \f x -> (B.unpack *** B.unpack) (B.break f x) === break f (B.unpack x)
+ , testProperty "break ==" $
+ \(toElem -> c) x -> (B.unpack *** B.unpack) (B.break (== c) x) === break (== c) (B.unpack x)
+ , testProperty "break /=" $
+ \(toElem -> c) x -> (B.unpack *** B.unpack) (B.break (/= c) x) === break (/= c) (B.unpack x)
+ , testProperty "break span" $
+ \f x -> B.break f x === B.span (not . f) x
+ , testProperty "breakEnd" $
+ \f x -> B.breakEnd f x === swap ((B.reverse *** B.reverse) (B.break f (B.reverse x)))
+ , testProperty "breakEnd" $
+ \f x -> B.breakEnd f x === B.spanEnd (not . f) x
+ , testProperty "break isSpace" $
+ \x -> (B.unpack *** B.unpack) (B.break isSpace x) === break isSpace (B.unpack x)
+
+ , testProperty "singleton" $
+ \(toElem -> c) -> B.unpack (B.singleton c) === [c]
+ , testProperty "cons" $
+ \(toElem -> c) x -> B.unpack (B.cons c x) === c : B.unpack x
+ , testProperty "cons []" $
+ \(toElem -> c) -> B.unpack (B.cons c B.empty) === [c]
+ , testProperty "uncons" $
+ \x -> fmap (second B.unpack) (B.uncons x) === L.uncons (B.unpack x)
+ , testProperty "snoc" $
+ \(toElem -> c) x -> B.unpack (B.snoc x c) === B.unpack x ++ [c]
+ , testProperty "snoc []" $
+ \(toElem -> c) -> B.unpack (B.snoc B.empty c) === [c]
+ , testProperty "unsnoc" $
+ \x -> fmap (first B.unpack) (B.unsnoc x) === unsnoc (B.unpack x)
+
+ , testProperty "drop" $
+ \n x -> B.unpack (B.drop n x) === drop (fromIntegral n) (B.unpack x)
+ , testProperty "drop 10" $
+ \x -> B.unpack (B.drop 10 x) === drop 10 (B.unpack x)
+ , testProperty "dropWhile" $
+ \f x -> B.unpack (B.dropWhile f x) === dropWhile f (B.unpack x)
+ , testProperty "dropWhile ==" $
+ \(toElem -> c) x -> B.unpack (B.dropWhile (== c) x) === dropWhile (== c) (B.unpack x)
+ , testProperty "dropWhile /=" $
+ \(toElem -> c) x -> B.unpack (B.dropWhile (/= c) x) === dropWhile (/= c) (B.unpack x)
+ , testProperty "dropWhile isSpace" $
+ \x -> B.unpack (B.dropWhile isSpace x) === dropWhile isSpace (B.unpack x)
+
+ , testProperty "take" $
+ \n x -> B.unpack (B.take n x) === take (fromIntegral n) (B.unpack x)
+ , testProperty "take 10" $
+ \x -> B.unpack (B.take 10 x) === take 10 (B.unpack x)
+ , testProperty "takeWhile" $
+ \f x -> B.unpack (B.takeWhile f x) === takeWhile f (B.unpack x)
+ , testProperty "takeWhile ==" $
+ \(toElem -> c) x -> B.unpack (B.takeWhile (== c) x) === takeWhile (== c) (B.unpack x)
+ , testProperty "takeWhile /=" $
+ \(toElem -> c) x -> B.unpack (B.takeWhile (/= c) x) === takeWhile (/= c) (B.unpack x)
+
+ , testProperty "takeWhile isSpace" $
+ \x -> B.unpack (B.takeWhile isSpace x) === takeWhile isSpace (B.unpack x)
+
+ , testProperty "dropEnd" $
+ \n x -> B.dropEnd n x === B.take (numWord x - n) x
+ , testProperty "dropWhileEnd" $
+ \f x -> B.dropWhileEnd f x === B.reverse (B.dropWhile f (B.reverse x))
+ , testProperty "takeEnd" $
+ \n x -> B.takeEnd n x === B.drop (numWord x - n) x
+ , testProperty "takeWhileEnd" $
+ \f x -> B.takeWhileEnd f x === B.reverse (B.takeWhile f (B.reverse x))
+
+ , testProperty "length" $
+ \x -> numWord x === fromIntegral (length (B.unpack x))
+ , testProperty "count" $
+ \(toElem -> c) x -> B.count c x === fromIntegral (length (elemIndices c (B.unpack x)))
+ , testProperty "filter" $
+ \f x -> B.unpack (B.filter f x) === filter f (B.unpack x)
+ , testProperty "filter compose" $
+ \f g x -> B.filter f (B.filter g x) === B.filter (\c -> f c && g c) x
+ , testProperty "filter ==" $
+ \(toElem -> c) x -> B.unpack (B.filter (== c) x) === filter (== c) (B.unpack x)
+ , testProperty "filter /=" $
+ \(toElem -> c) x -> B.unpack (B.filter (/= c) x) === filter (/= c) (B.unpack x)
+ , testProperty "partition" $
+ \f x -> (B.unpack *** B.unpack) (B.partition f x) === partition f (B.unpack x)
+
+ , testProperty "find" $
+ \f x -> B.find f x === find f (B.unpack x)
+ , testProperty "findIndex" $
+ \f x -> B.findIndex f x === fmap fromIntegral (findIndex f (B.unpack x))
+ , testProperty "findIndices" $
+ \f x -> B.findIndices f x === fmap fromIntegral (findIndices f (B.unpack x))
+ , testProperty "findIndices ==" $
+ \(toElem -> c) x -> B.findIndices (== c) x === fmap fromIntegral (findIndices (== c) (B.unpack x))
+
+ , testProperty "elem" $
+ \(toElem -> c) x -> B.elem c x === elem c (B.unpack x)
+ , testProperty "not elem" $
+ \(toElem -> c) x -> not (B.elem c x) === notElem c (B.unpack x)
+ , testProperty "elemIndex" $
+ \(toElem -> c) x -> B.elemIndex c x === fmap fromIntegral (elemIndex c (B.unpack x))
+ , testProperty "elemIndices" $
+ \(toElem -> c) x -> B.elemIndices c x === fmap fromIntegral (elemIndices c (B.unpack x))
+
+
+ , testProperty "map" $
+ \f x -> B.unpack (B.map (toElem . f) x) === map (toElem . f) (B.unpack x)
+ , testProperty "map compose" $
+ \f g x -> B.map (toElem . f) (B.map (toElem . g) x) === B.map (toElem . f . toElem . g) x
+ , testProperty "replicate" $
+ \n (toElem -> c) -> B.unpack (B.replicate (fromIntegral n) c) === replicate n c
+ , testProperty "replicate 0" $
+ \(toElem -> c) -> B.unpack (B.replicate 0 c) === replicate 0 c
+
+ , testProperty "span" $
+ \f x -> (B.unpack *** B.unpack) (B.span f x) === span f (B.unpack x)
+ , testProperty "span ==" $
+ \(toElem -> c) x -> (B.unpack *** B.unpack) (B.span (== c) x) === span (== c) (B.unpack x)
+ , testProperty "span /=" $
+ \(toElem -> c) x -> (B.unpack *** B.unpack) (B.span (/= c) x) === span (/= c) (B.unpack x)
+ , testProperty "spanEnd" $
+ \f x -> B.spanEnd f x === swap ((B.reverse *** B.reverse) (B.span f (B.reverse x)))
+ , testProperty "split" $
+ \(toElem -> c) x -> map B.unpack (B.split c x) === split c (B.unpack x)
+ , testProperty "split empty" $
+ \(toElem -> c) -> B.split c B.empty === []
+ , testProperty "splitWith" $
+ \f x -> map B.unpack (B.splitWith f x) === splitWith f (B.unpack x)
+ , testProperty "splitWith split" $
+ \(toElem -> c) x -> B.splitWith (== c) x === B.split c x
+ , testProperty "splitWith empty" $
+ \f -> B.splitWith f B.empty === []
+ , testProperty "splitWith length" $
+ \f x -> let splits = B.splitWith f x; l1 = fromIntegral (length splits); l2 = numWord (B.filter f x) in
+ (l1 == l2 || l1 == l2 + 1) && sum (map numWord splits) + l2 == numWord x
+ , testProperty "splitAt" $
+ \n x -> (B.unpack *** B.unpack) (B.splitAt n x) === splitAt (fromIntegral n) (B.unpack x)
+
+ , testProperty "head" $
+ \x -> not (B.null x) ==> B.head x === head (B.unpack x)
+ , testProperty "last" $
+ \x -> not (B.null x) ==> B.last x === last (B.unpack x)
+ , testProperty "tail" $
+ \x -> not (B.null x) ==> B.unpack (B.tail x) === tail (B.unpack x)
+ , testProperty "tail length" $
+ \x -> not (B.null x) ==> numWord x === 1 + numWord (B.tail x)
+ , testProperty "init" $
+ \x -> not (B.null x) ==> B.unpack (B.init x) === init (B.unpack x)
+ , testProperty "init length" $
+ \x -> not (B.null x) ==> numWord x === 1 + numWord (B.init x)
+
+ , testProperty "foldl" $
+ \f (toElem -> c) x -> B.foldl ((toElem .) . f) c x === foldl ((toElem .) . f) c (B.unpack x)
+ , testProperty "foldl'" $
+ \f (toElem -> c) x -> B.foldl' ((toElem .) . f) c x === foldl' ((toElem .) . f) c (B.unpack x)
+ , testProperty "foldr" $
+ \f (toElem -> c) x -> B.foldr ((toElem .) . f) c x === foldr ((toElem .) . f) c (B.unpack x)
+ , testProperty "foldr'" $
+ \f (toElem -> c) x -> B.foldr' ((toElem .) . f) c x === foldr' ((toElem .) . f) c (B.unpack x)
+
+ , testProperty "foldl cons" $
+ \x -> B.foldl (flip B.cons) B.empty x === B.reverse x
+ , testProperty "foldr cons" $
+ \x -> B.foldr B.cons B.empty x === x
+ , testProperty "foldl special" $
+ \x (toElem -> c) -> B.unpack (B.foldl (\acc t -> if t == c then acc else B.cons t acc) B.empty x) ===
+ foldl (\acc t -> if t == c then acc else t : acc) [] (B.unpack x)
+ , testProperty "foldr special" $
+ \x (toElem -> c) -> B.unpack (B.foldr (\t acc -> if t == c then acc else B.cons t acc) B.empty x) ===
+ foldr (\t acc -> if t == c then acc else t : acc) [] (B.unpack x)
+
+ , testProperty "foldl1" $
+ \f x -> not (B.null x) ==> B.foldl1 ((toElem .) . f) x === foldl1 ((toElem .) . f) (B.unpack x)
+ , testProperty "foldl1'" $
+ \f x -> not (B.null x) ==> B.foldl1' ((toElem .) . f) x === foldl1' ((toElem .) . f) (B.unpack x)
+ , testProperty "foldr1" $
+ \f x -> not (B.null x) ==> B.foldr1 ((toElem .) . f) x === foldr1 ((toElem .) . f) (B.unpack x)
+ , testProperty "foldr1'" $ -- there is not Data.List.foldr1'
+ \f x -> not (B.null x) ==> B.foldr1' ((toElem .) . f) x === foldr1 ((toElem .) . f) (B.unpack x)
+
+ , testProperty "foldl1 const" $
+ \x -> not (B.null x) ==> B.foldl1 const x === B.head x
+ , testProperty "foldl1 flip const" $
+ \x -> not (B.null x) ==> B.foldl1 (flip const) x === B.last x
+ , testProperty "foldr1 const" $
+ \x -> not (B.null x) ==> B.foldr1 const x === B.head x
+ , testProperty "foldr1 flip const" $
+ \x -> not (B.null x) ==> B.foldr1 (flip const) x === B.last x
+ , testProperty "foldl1 max" $
+ \x -> not (B.null x) ==> B.foldl1 max x === B.foldl max minBound x
+ , testProperty "foldr1 max" $
+ \x -> not (B.null x) ==> B.foldr1 max x === B.foldr max minBound x
+
+ , testProperty "index" $
+ \(NonNegative n) x -> fromIntegral n < numWord x ==> B.index x (fromIntegral n) === B.unpack x !! n
+ , testProperty "indexMaybe" $
+ \(NonNegative n) x -> fromIntegral n < numWord x ==> B.indexMaybe x (fromIntegral n) === Just (B.unpack x !! n)
+ , testProperty "indexMaybe Nothing" $
+ \n x -> (n :: Int) < 0 || fromIntegral n >= numWord x ==> B.indexMaybe x (fromIntegral n) === Nothing
+ , testProperty "!?" $
+ \n x -> B.indexMaybe x (fromIntegral (n :: Int)) === x B.!? (fromIntegral n)
+
+ , testProperty "unfoldrN" $
+ \n f (toElem -> c) -> B.unpack (fst (B.unfoldrN n (fmap (first toElem) . f) c)) ===
+ take (fromIntegral n) (unfoldr (fmap (first toElem) . f) c)
+ , testProperty "unfoldrN replicate" $
+ \n (toElem -> c) -> fst (B.unfoldrN n (\t -> Just (t, t)) c) === B.replicate n c
+ , testProperty "unfoldr" $
+ \n a (toElem -> c) -> B.unpack (B.unfoldr (\x -> if x <= 100 * n then Just (c, x + 1 :: Int) else Nothing) a) ===
+ unfoldr (\x -> if x <= 100 * n then Just (c, x + 1) else Nothing) a
+
+ --, testProperty "unfoldr" $
+ -- \n f (toElem -> a) -> B.unpack (B.take (fromIntegral n) (B.unfoldr (fmap (first toElem) . f) a)) ===
+ -- take n (unfoldr (fmap (first toElem) . f) a)
+ --
+#ifdef WORD16
+ , testProperty "useAsCWString str packCWString == str" $
+ \x -> not (B.any (== _nul) x)
+ ==> monadicIO $ run (B.useAsCWString x B.packCWString >>= \x' -> pure (x === x'))
+ , testProperty "useAsCWStringLen str packCWStringLen == str" $
+ \x -> not (B.any (== _nul) x)
+ ==> monadicIO $ run (B.useAsCWStringLen x B.packCWStringLen >>= \x' -> pure (x === x'))
+#else
+ , testProperty "useAsCString str packCString == str" $
+ \x -> not (B.any (== _nul) x)
+ ==> monadicIO $ run (B.useAsCString x B.packCString >>= \x' -> pure (x === x'))
+ , testProperty "useAsCStringLen str packCStringLen == str" $
+ \x -> not (B.any (== _nul) x)
+ ==> monadicIO $ run (B.useAsCStringLen x B.packCStringLen >>= \x' -> pure (x === x'))
+#endif
+ ]
+
+stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
+stripSuffix x y = fmap reverse (stripPrefix (reverse x) (reverse y))
+
+split :: Eq a => a -> [a] -> [[a]]
+split c = splitWith (== c)
+
+splitWith :: (a -> Bool) -> [a] -> [[a]]
+splitWith _ [] = []
+splitWith f ys = go [] ys
+ where
+ go acc [] = [reverse acc]
+ go acc (x : xs)
+ | f x = reverse acc : go [] xs
+ | otherwise = go (x : acc) xs
+
+unsnoc :: [a] -> Maybe ([a], a)
+unsnoc [] = Nothing
+unsnoc xs = Just (init xs, last xs)
diff --git a/tests/Properties/ShortByteString.hs b/tests/Properties/ShortByteString.hs
new file mode 100644
index 0000000..3040dfb
--- /dev/null
+++ b/tests/Properties/ShortByteString.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE CPP #-}
+#undef WORD16
+#include "Common.hs"
diff --git a/tests/Properties/ShortByteString/Word16.hs b/tests/Properties/ShortByteString/Word16.hs
new file mode 100644
index 0000000..aa42639
--- /dev/null
+++ b/tests/Properties/ShortByteString/Word16.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE CPP #-}
+#define WORD16
+#include "../Common.hs"
diff --git a/tests/Test.hs b/tests/Test.hs
index 6c307e8..ef4b0ce 100755
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -11,11 +11,19 @@ import Test.QuickCheck
main :: IO ()
main = do
args <- getArgs
- let count = case args of i:_ -> read i; _ -> 10000
+ let count = case args of i:_ -> read i; _ -> 10000
+ let testNum = case args of
+ _:i:_
+ | let num = read i
+ , num < 0 -> drop (negate num) tests
+ | let num = read i
+ , num > 0 -> take num tests
+ | otherwise -> []
+ _ -> tests
putStrLn $ "Testing with " ++ show count ++ " repetitions"
- let total = length tests
+ let total = length testNum
let showOutput x = show x{output=""} ++ "\n" ++ output x
- bad <- fmap catMaybes $ forM (zip [1..] tests) $ \(i,(msg,prop)) -> do
+ bad <- fmap catMaybes $ forM (zip [1..] testNum) $ \(i,(msg,prop)) -> do
putStrLn $ "Test " ++ show i ++ " of " ++ show total ++ ": " ++ msg
res <- quickCheckWithResult stdArgs{chatty=False, maxSuccess=count} prop
case res of
diff --git a/tests/TestGen.hs b/tests/TestGen.hs
index 62eb18f..ddcfa35 100755
--- a/tests/TestGen.hs
+++ b/tests/TestGen.hs
@@ -1,466 +1,933 @@
-- GENERATED CODE: See ../Generate.hs
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
module TestGen(tests) where
import TestUtil
+import Prelude as P
+import Data.Semigroup
+import qualified Data.Char as C
+import qualified System.AbstractFilePath.Data.ByteString.Short as SBS
+import qualified System.AbstractFilePath.Data.ByteString.Short.Word16 as SBS16
import qualified System.FilePath.Windows as W
import qualified System.FilePath.Posix as P
-{-# ANN module "HLint: ignore" #-}
+import System.AbstractFilePath.Types
+import qualified System.AbstractFilePath.Windows as AFP_W
+import qualified System.AbstractFilePath.Posix as AFP_P
+import System.AbstractFilePath.Data.ByteString.Short.Encode
tests :: [(String, Property)]
tests =
[("W.pathSeparator == '\\\\'", property $ W.pathSeparator == '\\')
+ ,("AFP_W.pathSeparator == (WW . fromIntegral . C.ord $ '\\\\')", property $ AFP_W.pathSeparator == (WW . fromIntegral . C.ord $ '\\'))
,("P.pathSeparator == '/'", property $ P.pathSeparator == '/')
+ ,("AFP_P.pathSeparator == (PW . fromIntegral . C.ord $ '/')", property $ AFP_P.pathSeparator == (PW . fromIntegral . C.ord $ '/'))
,("P.isPathSeparator P.pathSeparator", property $ P.isPathSeparator P.pathSeparator)
,("W.isPathSeparator W.pathSeparator", property $ W.isPathSeparator W.pathSeparator)
+ ,("AFP_P.isPathSeparator AFP_P.pathSeparator", property $ AFP_P.isPathSeparator AFP_P.pathSeparator)
+ ,("AFP_W.isPathSeparator AFP_W.pathSeparator", property $ AFP_W.isPathSeparator AFP_W.pathSeparator)
,("W.pathSeparators == ['\\\\', '/']", property $ W.pathSeparators == ['\\', '/'])
+ ,("AFP_W.pathSeparators == [(WW . fromIntegral . C.ord $ '\\\\'), (WW . fromIntegral . C.ord $ '/')]", property $ AFP_W.pathSeparators == [(WW . fromIntegral . C.ord $ '\\'), (WW . fromIntegral . C.ord $ '/')])
,("P.pathSeparators == ['/']", property $ P.pathSeparators == ['/'])
+ ,("AFP_P.pathSeparators == [(PW . fromIntegral . C.ord $ '/')]", property $ AFP_P.pathSeparators == [(PW . fromIntegral . C.ord $ '/')])
,("P.pathSeparator `elem` P.pathSeparators", property $ P.pathSeparator `elem` P.pathSeparators)
,("W.pathSeparator `elem` W.pathSeparators", property $ W.pathSeparator `elem` W.pathSeparators)
+ ,("AFP_P.pathSeparator `elem` AFP_P.pathSeparators", property $ AFP_P.pathSeparator `elem` AFP_P.pathSeparators)
+ ,("AFP_W.pathSeparator `elem` AFP_W.pathSeparators", property $ AFP_W.pathSeparator `elem` AFP_W.pathSeparators)
,("P.isPathSeparator a == (a `elem` P.pathSeparators)", property $ \a -> P.isPathSeparator a == (a `elem` P.pathSeparators))
,("W.isPathSeparator a == (a `elem` W.pathSeparators)", property $ \a -> W.isPathSeparator a == (a `elem` W.pathSeparators))
+ ,("AFP_P.isPathSeparator a == (a `elem` AFP_P.pathSeparators)", property $ \a -> AFP_P.isPathSeparator a == (a `elem` AFP_P.pathSeparators))
+ ,("AFP_W.isPathSeparator a == (a `elem` AFP_W.pathSeparators)", property $ \a -> AFP_W.isPathSeparator a == (a `elem` AFP_W.pathSeparators))
,("W.searchPathSeparator == ';'", property $ W.searchPathSeparator == ';')
+ ,("AFP_W.searchPathSeparator == (WW . fromIntegral . C.ord $ ';')", property $ AFP_W.searchPathSeparator == (WW . fromIntegral . C.ord $ ';'))
,("P.searchPathSeparator == ':'", property $ P.searchPathSeparator == ':')
+ ,("AFP_P.searchPathSeparator == (PW . fromIntegral . C.ord $ ':')", property $ AFP_P.searchPathSeparator == (PW . fromIntegral . C.ord $ ':'))
,("P.isSearchPathSeparator a == (a == P.searchPathSeparator)", property $ \a -> P.isSearchPathSeparator a == (a == P.searchPathSeparator))
,("W.isSearchPathSeparator a == (a == W.searchPathSeparator)", property $ \a -> W.isSearchPathSeparator a == (a == W.searchPathSeparator))
+ ,("AFP_P.isSearchPathSeparator a == (a == AFP_P.searchPathSeparator)", property $ \a -> AFP_P.isSearchPathSeparator a == (a == AFP_P.searchPathSeparator))
+ ,("AFP_W.isSearchPathSeparator a == (a == AFP_W.searchPathSeparator)", property $ \a -> AFP_W.isSearchPathSeparator a == (a == AFP_W.searchPathSeparator))
,("P.extSeparator == '.'", property $ P.extSeparator == '.')
,("W.extSeparator == '.'", property $ W.extSeparator == '.')
+ ,("AFP_P.extSeparator == (PW . fromIntegral . C.ord $ '.')", property $ AFP_P.extSeparator == (PW . fromIntegral . C.ord $ '.'))
+ ,("AFP_W.extSeparator == (WW . fromIntegral . C.ord $ '.')", property $ AFP_W.extSeparator == (WW . fromIntegral . C.ord $ '.'))
,("P.isExtSeparator a == (a == P.extSeparator)", property $ \a -> P.isExtSeparator a == (a == P.extSeparator))
,("W.isExtSeparator a == (a == W.extSeparator)", property $ \a -> W.isExtSeparator a == (a == W.extSeparator))
+ ,("AFP_P.isExtSeparator a == (a == AFP_P.extSeparator)", property $ \a -> AFP_P.isExtSeparator a == (a == AFP_P.extSeparator))
+ ,("AFP_W.isExtSeparator a == (a == AFP_W.extSeparator)", property $ \a -> AFP_W.isExtSeparator a == (a == AFP_W.extSeparator))
,("P.splitSearchPath \"File1:File2:File3\" == [\"File1\", \"File2\", \"File3\"]", property $ P.splitSearchPath "File1:File2:File3" == ["File1", "File2", "File3"])
+ ,("AFP_P.splitSearchPath (\"File1:File2:File3\") == [(\"File1\"), (\"File2\"), (\"File3\")]", property $ AFP_P.splitSearchPath ("File1:File2:File3") == [("File1"), ("File2"), ("File3")])
,("P.splitSearchPath \"File1::File2:File3\" == [\"File1\", \".\", \"File2\", \"File3\"]", property $ P.splitSearchPath "File1::File2:File3" == ["File1", ".", "File2", "File3"])
+ ,("AFP_P.splitSearchPath (\"File1::File2:File3\") == [(\"File1\"), (\".\"), (\"File2\"), (\"File3\")]", property $ AFP_P.splitSearchPath ("File1::File2:File3") == [("File1"), ("."), ("File2"), ("File3")])
,("W.splitSearchPath \"File1;File2;File3\" == [\"File1\", \"File2\", \"File3\"]", property $ W.splitSearchPath "File1;File2;File3" == ["File1", "File2", "File3"])
+ ,("AFP_W.splitSearchPath (\"File1;File2;File3\") == [(\"File1\"), (\"File2\"), (\"File3\")]", property $ AFP_W.splitSearchPath ("File1;File2;File3") == [("File1"), ("File2"), ("File3")])
,("W.splitSearchPath \"File1;;File2;File3\" == [\"File1\", \"File2\", \"File3\"]", property $ W.splitSearchPath "File1;;File2;File3" == ["File1", "File2", "File3"])
+ ,("AFP_W.splitSearchPath (\"File1;;File2;File3\") == [(\"File1\"), (\"File2\"), (\"File3\")]", property $ AFP_W.splitSearchPath ("File1;;File2;File3") == [("File1"), ("File2"), ("File3")])
,("W.splitSearchPath \"File1;\\\"File2\\\";File3\" == [\"File1\", \"File2\", \"File3\"]", property $ W.splitSearchPath "File1;\"File2\";File3" == ["File1", "File2", "File3"])
+ ,("AFP_W.splitSearchPath (\"File1;\\\"File2\\\";File3\") == [(\"File1\"), (\"File2\"), (\"File3\")]", property $ AFP_W.splitSearchPath ("File1;\"File2\";File3") == [("File1"), ("File2"), ("File3")])
,("P.splitExtension \"/directory/path.ext\" == (\"/directory/path\", \".ext\")", property $ P.splitExtension "/directory/path.ext" == ("/directory/path", ".ext"))
,("W.splitExtension \"/directory/path.ext\" == (\"/directory/path\", \".ext\")", property $ W.splitExtension "/directory/path.ext" == ("/directory/path", ".ext"))
- ,("uncurry (++) (P.splitExtension x) == x", property $ \(QFilePath x) -> uncurry (++) (P.splitExtension x) == x)
- ,("uncurry (++) (W.splitExtension x) == x", property $ \(QFilePath x) -> uncurry (++) (W.splitExtension x) == x)
+ ,("AFP_P.splitExtension (\"/directory/path.ext\") == ((\"/directory/path\"), (\".ext\"))", property $ AFP_P.splitExtension ("/directory/path.ext") == (("/directory/path"), (".ext")))
+ ,("AFP_W.splitExtension (\"/directory/path.ext\") == ((\"/directory/path\"), (\".ext\"))", property $ AFP_W.splitExtension ("/directory/path.ext") == (("/directory/path"), (".ext")))
+ ,("uncurry (<>) (P.splitExtension x) == x", property $ \(QFilePath x) -> uncurry (<>) (P.splitExtension x) == x)
+ ,("uncurry (<>) (W.splitExtension x) == x", property $ \(QFilePath x) -> uncurry (<>) (W.splitExtension x) == x)
+ ,("uncurry (<>) (AFP_P.splitExtension x) == x", property $ \(QFilePathAFP_P x) -> uncurry (<>) (AFP_P.splitExtension x) == x)
+ ,("uncurry (<>) (AFP_W.splitExtension x) == x", property $ \(QFilePathAFP_W x) -> uncurry (<>) (AFP_W.splitExtension x) == x)
,("uncurry P.addExtension (P.splitExtension x) == x", property $ \(QFilePathValidP x) -> uncurry P.addExtension (P.splitExtension x) == x)
,("uncurry W.addExtension (W.splitExtension x) == x", property $ \(QFilePathValidW x) -> uncurry W.addExtension (W.splitExtension x) == x)
+ ,("uncurry AFP_P.addExtension (AFP_P.splitExtension x) == x", property $ \(QFilePathValidAFP_P x) -> uncurry AFP_P.addExtension (AFP_P.splitExtension x) == x)
+ ,("uncurry AFP_W.addExtension (AFP_W.splitExtension x) == x", property $ \(QFilePathValidAFP_W x) -> uncurry AFP_W.addExtension (AFP_W.splitExtension x) == x)
,("P.splitExtension \"file.txt\" == (\"file\", \".txt\")", property $ P.splitExtension "file.txt" == ("file", ".txt"))
,("W.splitExtension \"file.txt\" == (\"file\", \".txt\")", property $ W.splitExtension "file.txt" == ("file", ".txt"))
+ ,("AFP_P.splitExtension (\"file.txt\") == ((\"file\"), (\".txt\"))", property $ AFP_P.splitExtension ("file.txt") == (("file"), (".txt")))
+ ,("AFP_W.splitExtension (\"file.txt\") == ((\"file\"), (\".txt\"))", property $ AFP_W.splitExtension ("file.txt") == (("file"), (".txt")))
,("P.splitExtension \"file\" == (\"file\", \"\")", property $ P.splitExtension "file" == ("file", ""))
,("W.splitExtension \"file\" == (\"file\", \"\")", property $ W.splitExtension "file" == ("file", ""))
+ ,("AFP_P.splitExtension (\"file\") == ((\"file\"), (\"\"))", property $ AFP_P.splitExtension ("file") == (("file"), ("")))
+ ,("AFP_W.splitExtension (\"file\") == ((\"file\"), (\"\"))", property $ AFP_W.splitExtension ("file") == (("file"), ("")))
,("P.splitExtension \"file/file.txt\" == (\"file/file\", \".txt\")", property $ P.splitExtension "file/file.txt" == ("file/file", ".txt"))
,("W.splitExtension \"file/file.txt\" == (\"file/file\", \".txt\")", property $ W.splitExtension "file/file.txt" == ("file/file", ".txt"))
+ ,("AFP_P.splitExtension (\"file/file.txt\") == ((\"file/file\"), (\".txt\"))", property $ AFP_P.splitExtension ("file/file.txt") == (("file/file"), (".txt")))
+ ,("AFP_W.splitExtension (\"file/file.txt\") == ((\"file/file\"), (\".txt\"))", property $ AFP_W.splitExtension ("file/file.txt") == (("file/file"), (".txt")))
,("P.splitExtension \"file.txt/boris\" == (\"file.txt/boris\", \"\")", property $ P.splitExtension "file.txt/boris" == ("file.txt/boris", ""))
,("W.splitExtension \"file.txt/boris\" == (\"file.txt/boris\", \"\")", property $ W.splitExtension "file.txt/boris" == ("file.txt/boris", ""))
+ ,("AFP_P.splitExtension (\"file.txt/boris\") == ((\"file.txt/boris\"), (\"\"))", property $ AFP_P.splitExtension ("file.txt/boris") == (("file.txt/boris"), ("")))
+ ,("AFP_W.splitExtension (\"file.txt/boris\") == ((\"file.txt/boris\"), (\"\"))", property $ AFP_W.splitExtension ("file.txt/boris") == (("file.txt/boris"), ("")))
,("P.splitExtension \"file.txt/boris.ext\" == (\"file.txt/boris\", \".ext\")", property $ P.splitExtension "file.txt/boris.ext" == ("file.txt/boris", ".ext"))
,("W.splitExtension \"file.txt/boris.ext\" == (\"file.txt/boris\", \".ext\")", property $ W.splitExtension "file.txt/boris.ext" == ("file.txt/boris", ".ext"))
+ ,("AFP_P.splitExtension (\"file.txt/boris.ext\") == ((\"file.txt/boris\"), (\".ext\"))", property $ AFP_P.splitExtension ("file.txt/boris.ext") == (("file.txt/boris"), (".ext")))
+ ,("AFP_W.splitExtension (\"file.txt/boris.ext\") == ((\"file.txt/boris\"), (\".ext\"))", property $ AFP_W.splitExtension ("file.txt/boris.ext") == (("file.txt/boris"), (".ext")))
,("P.splitExtension \"file/path.txt.bob.fred\" == (\"file/path.txt.bob\", \".fred\")", property $ P.splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob", ".fred"))
,("W.splitExtension \"file/path.txt.bob.fred\" == (\"file/path.txt.bob\", \".fred\")", property $ W.splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob", ".fred"))
+ ,("AFP_P.splitExtension (\"file/path.txt.bob.fred\") == ((\"file/path.txt.bob\"), (\".fred\"))", property $ AFP_P.splitExtension ("file/path.txt.bob.fred") == (("file/path.txt.bob"), (".fred")))
+ ,("AFP_W.splitExtension (\"file/path.txt.bob.fred\") == ((\"file/path.txt.bob\"), (\".fred\"))", property $ AFP_W.splitExtension ("file/path.txt.bob.fred") == (("file/path.txt.bob"), (".fred")))
,("P.splitExtension \"file/path.txt/\" == (\"file/path.txt/\", \"\")", property $ P.splitExtension "file/path.txt/" == ("file/path.txt/", ""))
,("W.splitExtension \"file/path.txt/\" == (\"file/path.txt/\", \"\")", property $ W.splitExtension "file/path.txt/" == ("file/path.txt/", ""))
+ ,("AFP_P.splitExtension (\"file/path.txt/\") == ((\"file/path.txt/\"), (\"\"))", property $ AFP_P.splitExtension ("file/path.txt/") == (("file/path.txt/"), ("")))
+ ,("AFP_W.splitExtension (\"file/path.txt/\") == ((\"file/path.txt/\"), (\"\"))", property $ AFP_W.splitExtension ("file/path.txt/") == (("file/path.txt/"), ("")))
,("P.takeExtension \"/directory/path.ext\" == \".ext\"", property $ P.takeExtension "/directory/path.ext" == ".ext")
,("W.takeExtension \"/directory/path.ext\" == \".ext\"", property $ W.takeExtension "/directory/path.ext" == ".ext")
+ ,("AFP_P.takeExtension (\"/directory/path.ext\") == (\".ext\")", property $ AFP_P.takeExtension ("/directory/path.ext") == (".ext"))
+ ,("AFP_W.takeExtension (\"/directory/path.ext\") == (\".ext\")", property $ AFP_W.takeExtension ("/directory/path.ext") == (".ext"))
,("P.takeExtension x == snd (P.splitExtension x)", property $ \(QFilePath x) -> P.takeExtension x == snd (P.splitExtension x))
,("W.takeExtension x == snd (W.splitExtension x)", property $ \(QFilePath x) -> W.takeExtension x == snd (W.splitExtension x))
+ ,("AFP_P.takeExtension x == snd (AFP_P.splitExtension x)", property $ \(QFilePathAFP_P x) -> AFP_P.takeExtension x == snd (AFP_P.splitExtension x))
+ ,("AFP_W.takeExtension x == snd (AFP_W.splitExtension x)", property $ \(QFilePathAFP_W x) -> AFP_W.takeExtension x == snd (AFP_W.splitExtension x))
,("P.takeExtension (P.addExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidP x) -> P.takeExtension (P.addExtension x "ext") == ".ext")
,("W.takeExtension (W.addExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidW x) -> W.takeExtension (W.addExtension x "ext") == ".ext")
+ ,("AFP_P.takeExtension (AFP_P.addExtension x (\"ext\")) == (\".ext\")", property $ \(QFilePathValidAFP_P x) -> AFP_P.takeExtension (AFP_P.addExtension x ("ext")) == (".ext"))
+ ,("AFP_W.takeExtension (AFP_W.addExtension x (\"ext\")) == (\".ext\")", property $ \(QFilePathValidAFP_W x) -> AFP_W.takeExtension (AFP_W.addExtension x ("ext")) == (".ext"))
,("P.takeExtension (P.replaceExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidP x) -> P.takeExtension (P.replaceExtension x "ext") == ".ext")
,("W.takeExtension (W.replaceExtension x \"ext\") == \".ext\"", property $ \(QFilePathValidW x) -> W.takeExtension (W.replaceExtension x "ext") == ".ext")
+ ,("AFP_P.takeExtension (AFP_P.replaceExtension x (\"ext\")) == (\".ext\")", property $ \(QFilePathValidAFP_P x) -> AFP_P.takeExtension (AFP_P.replaceExtension x ("ext")) == (".ext"))
+ ,("AFP_W.takeExtension (AFP_W.replaceExtension x (\"ext\")) == (\".ext\")", property $ \(QFilePathValidAFP_W x) -> AFP_W.takeExtension (AFP_W.replaceExtension x ("ext")) == (".ext"))
,("\"/directory/path.txt\" P.-<.> \"ext\" == \"/directory/path.ext\"", property $ "/directory/path.txt" P.-<.> "ext" == "/directory/path.ext")
,("\"/directory/path.txt\" W.-<.> \"ext\" == \"/directory/path.ext\"", property $ "/directory/path.txt" W.-<.> "ext" == "/directory/path.ext")
+ ,("(\"/directory/path.txt\") AFP_P.-<.> (\"ext\") == (\"/directory/path.ext\")", property $ ("/directory/path.txt") AFP_P.-<.> ("ext") == ("/directory/path.ext"))
+ ,("(\"/directory/path.txt\") AFP_W.-<.> (\"ext\") == (\"/directory/path.ext\")", property $ ("/directory/path.txt") AFP_W.-<.> ("ext") == ("/directory/path.ext"))
,("\"/directory/path.txt\" P.-<.> \".ext\" == \"/directory/path.ext\"", property $ "/directory/path.txt" P.-<.> ".ext" == "/directory/path.ext")
,("\"/directory/path.txt\" W.-<.> \".ext\" == \"/directory/path.ext\"", property $ "/directory/path.txt" W.-<.> ".ext" == "/directory/path.ext")
+ ,("(\"/directory/path.txt\") AFP_P.-<.> (\".ext\") == (\"/directory/path.ext\")", property $ ("/directory/path.txt") AFP_P.-<.> (".ext") == ("/directory/path.ext"))
+ ,("(\"/directory/path.txt\") AFP_W.-<.> (\".ext\") == (\"/directory/path.ext\")", property $ ("/directory/path.txt") AFP_W.-<.> (".ext") == ("/directory/path.ext"))
,("\"foo.o\" P.-<.> \"c\" == \"foo.c\"", property $ "foo.o" P.-<.> "c" == "foo.c")
,("\"foo.o\" W.-<.> \"c\" == \"foo.c\"", property $ "foo.o" W.-<.> "c" == "foo.c")
+ ,("(\"foo.o\") AFP_P.-<.> (\"c\") == (\"foo.c\")", property $ ("foo.o") AFP_P.-<.> ("c") == ("foo.c"))
+ ,("(\"foo.o\") AFP_W.-<.> (\"c\") == (\"foo.c\")", property $ ("foo.o") AFP_W.-<.> ("c") == ("foo.c"))
,("P.replaceExtension \"/directory/path.txt\" \"ext\" == \"/directory/path.ext\"", property $ P.replaceExtension "/directory/path.txt" "ext" == "/directory/path.ext")
,("W.replaceExtension \"/directory/path.txt\" \"ext\" == \"/directory/path.ext\"", property $ W.replaceExtension "/directory/path.txt" "ext" == "/directory/path.ext")
+ ,("AFP_P.replaceExtension (\"/directory/path.txt\") (\"ext\") == (\"/directory/path.ext\")", property $ AFP_P.replaceExtension ("/directory/path.txt") ("ext") == ("/directory/path.ext"))
+ ,("AFP_W.replaceExtension (\"/directory/path.txt\") (\"ext\") == (\"/directory/path.ext\")", property $ AFP_W.replaceExtension ("/directory/path.txt") ("ext") == ("/directory/path.ext"))
,("P.replaceExtension \"/directory/path.txt\" \".ext\" == \"/directory/path.ext\"", property $ P.replaceExtension "/directory/path.txt" ".ext" == "/directory/path.ext")
,("W.replaceExtension \"/directory/path.txt\" \".ext\" == \"/directory/path.ext\"", property $ W.replaceExtension "/directory/path.txt" ".ext" == "/directory/path.ext")
+ ,("AFP_P.replaceExtension (\"/directory/path.txt\") (\".ext\") == (\"/directory/path.ext\")", property $ AFP_P.replaceExtension ("/directory/path.txt") (".ext") == ("/directory/path.ext"))
+ ,("AFP_W.replaceExtension (\"/directory/path.txt\") (\".ext\") == (\"/directory/path.ext\")", property $ AFP_W.replaceExtension ("/directory/path.txt") (".ext") == ("/directory/path.ext"))
,("P.replaceExtension \"file.txt\" \".bob\" == \"file.bob\"", property $ P.replaceExtension "file.txt" ".bob" == "file.bob")
,("W.replaceExtension \"file.txt\" \".bob\" == \"file.bob\"", property $ W.replaceExtension "file.txt" ".bob" == "file.bob")
+ ,("AFP_P.replaceExtension (\"file.txt\") (\".bob\") == (\"file.bob\")", property $ AFP_P.replaceExtension ("file.txt") (".bob") == ("file.bob"))
+ ,("AFP_W.replaceExtension (\"file.txt\") (\".bob\") == (\"file.bob\")", property $ AFP_W.replaceExtension ("file.txt") (".bob") == ("file.bob"))
,("P.replaceExtension \"file.txt\" \"bob\" == \"file.bob\"", property $ P.replaceExtension "file.txt" "bob" == "file.bob")
,("W.replaceExtension \"file.txt\" \"bob\" == \"file.bob\"", property $ W.replaceExtension "file.txt" "bob" == "file.bob")
+ ,("AFP_P.replaceExtension (\"file.txt\") (\"bob\") == (\"file.bob\")", property $ AFP_P.replaceExtension ("file.txt") ("bob") == ("file.bob"))
+ ,("AFP_W.replaceExtension (\"file.txt\") (\"bob\") == (\"file.bob\")", property $ AFP_W.replaceExtension ("file.txt") ("bob") == ("file.bob"))
,("P.replaceExtension \"file\" \".bob\" == \"file.bob\"", property $ P.replaceExtension "file" ".bob" == "file.bob")
,("W.replaceExtension \"file\" \".bob\" == \"file.bob\"", property $ W.replaceExtension "file" ".bob" == "file.bob")
+ ,("AFP_P.replaceExtension (\"file\") (\".bob\") == (\"file.bob\")", property $ AFP_P.replaceExtension ("file") (".bob") == ("file.bob"))
+ ,("AFP_W.replaceExtension (\"file\") (\".bob\") == (\"file.bob\")", property $ AFP_W.replaceExtension ("file") (".bob") == ("file.bob"))
,("P.replaceExtension \"file.txt\" \"\" == \"file\"", property $ P.replaceExtension "file.txt" "" == "file")
,("W.replaceExtension \"file.txt\" \"\" == \"file\"", property $ W.replaceExtension "file.txt" "" == "file")
+ ,("AFP_P.replaceExtension (\"file.txt\") (\"\") == (\"file\")", property $ AFP_P.replaceExtension ("file.txt") ("") == ("file"))
+ ,("AFP_W.replaceExtension (\"file.txt\") (\"\") == (\"file\")", property $ AFP_W.replaceExtension ("file.txt") ("") == ("file"))
,("P.replaceExtension \"file.fred.bob\" \"txt\" == \"file.fred.txt\"", property $ P.replaceExtension "file.fred.bob" "txt" == "file.fred.txt")
,("W.replaceExtension \"file.fred.bob\" \"txt\" == \"file.fred.txt\"", property $ W.replaceExtension "file.fred.bob" "txt" == "file.fred.txt")
+ ,("AFP_P.replaceExtension (\"file.fred.bob\") (\"txt\") == (\"file.fred.txt\")", property $ AFP_P.replaceExtension ("file.fred.bob") ("txt") == ("file.fred.txt"))
+ ,("AFP_W.replaceExtension (\"file.fred.bob\") (\"txt\") == (\"file.fred.txt\")", property $ AFP_W.replaceExtension ("file.fred.bob") ("txt") == ("file.fred.txt"))
,("P.replaceExtension x y == P.addExtension (P.dropExtension x) y", property $ \(QFilePath x) (QFilePath y) -> P.replaceExtension x y == P.addExtension (P.dropExtension x) y)
,("W.replaceExtension x y == W.addExtension (W.dropExtension x) y", property $ \(QFilePath x) (QFilePath y) -> W.replaceExtension x y == W.addExtension (W.dropExtension x) y)
+ ,("AFP_P.replaceExtension x y == AFP_P.addExtension (AFP_P.dropExtension x) y", property $ \(QFilePathAFP_P x) (QFilePathAFP_P y) -> AFP_P.replaceExtension x y == AFP_P.addExtension (AFP_P.dropExtension x) y)
+ ,("AFP_W.replaceExtension x y == AFP_W.addExtension (AFP_W.dropExtension x) y", property $ \(QFilePathAFP_W x) (QFilePathAFP_W y) -> AFP_W.replaceExtension x y == AFP_W.addExtension (AFP_W.dropExtension x) y)
,("\"/directory/path\" P.<.> \"ext\" == \"/directory/path.ext\"", property $ "/directory/path" P.<.> "ext" == "/directory/path.ext")
,("\"/directory/path\" W.<.> \"ext\" == \"/directory/path.ext\"", property $ "/directory/path" W.<.> "ext" == "/directory/path.ext")
+ ,("(\"/directory/path\") AFP_P.<.> (\"ext\") == (\"/directory/path.ext\")", property $ ("/directory/path") AFP_P.<.> ("ext") == ("/directory/path.ext"))
+ ,("(\"/directory/path\") AFP_W.<.> (\"ext\") == (\"/directory/path.ext\")", property $ ("/directory/path") AFP_W.<.> ("ext") == ("/directory/path.ext"))
,("\"/directory/path\" P.<.> \".ext\" == \"/directory/path.ext\"", property $ "/directory/path" P.<.> ".ext" == "/directory/path.ext")
,("\"/directory/path\" W.<.> \".ext\" == \"/directory/path.ext\"", property $ "/directory/path" W.<.> ".ext" == "/directory/path.ext")
+ ,("(\"/directory/path\") AFP_P.<.> (\".ext\") == (\"/directory/path.ext\")", property $ ("/directory/path") AFP_P.<.> (".ext") == ("/directory/path.ext"))
+ ,("(\"/directory/path\") AFP_W.<.> (\".ext\") == (\"/directory/path.ext\")", property $ ("/directory/path") AFP_W.<.> (".ext") == ("/directory/path.ext"))
,("P.dropExtension \"/directory/path.ext\" == \"/directory/path\"", property $ P.dropExtension "/directory/path.ext" == "/directory/path")
,("W.dropExtension \"/directory/path.ext\" == \"/directory/path\"", property $ W.dropExtension "/directory/path.ext" == "/directory/path")
+ ,("AFP_P.dropExtension (\"/directory/path.ext\") == (\"/directory/path\")", property $ AFP_P.dropExtension ("/directory/path.ext") == ("/directory/path"))
+ ,("AFP_W.dropExtension (\"/directory/path.ext\") == (\"/directory/path\")", property $ AFP_W.dropExtension ("/directory/path.ext") == ("/directory/path"))
,("P.dropExtension x == fst (P.splitExtension x)", property $ \(QFilePath x) -> P.dropExtension x == fst (P.splitExtension x))
,("W.dropExtension x == fst (W.splitExtension x)", property $ \(QFilePath x) -> W.dropExtension x == fst (W.splitExtension x))
+ ,("AFP_P.dropExtension x == fst (AFP_P.splitExtension x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropExtension x == fst (AFP_P.splitExtension x))
+ ,("AFP_W.dropExtension x == fst (AFP_W.splitExtension x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropExtension x == fst (AFP_W.splitExtension x))
,("P.addExtension \"/directory/path\" \"ext\" == \"/directory/path.ext\"", property $ P.addExtension "/directory/path" "ext" == "/directory/path.ext")
,("W.addExtension \"/directory/path\" \"ext\" == \"/directory/path.ext\"", property $ W.addExtension "/directory/path" "ext" == "/directory/path.ext")
+ ,("AFP_P.addExtension (\"/directory/path\") (\"ext\") == (\"/directory/path.ext\")", property $ AFP_P.addExtension ("/directory/path") ("ext") == ("/directory/path.ext"))
+ ,("AFP_W.addExtension (\"/directory/path\") (\"ext\") == (\"/directory/path.ext\")", property $ AFP_W.addExtension ("/directory/path") ("ext") == ("/directory/path.ext"))
,("P.addExtension \"file.txt\" \"bib\" == \"file.txt.bib\"", property $ P.addExtension "file.txt" "bib" == "file.txt.bib")
,("W.addExtension \"file.txt\" \"bib\" == \"file.txt.bib\"", property $ W.addExtension "file.txt" "bib" == "file.txt.bib")
+ ,("AFP_P.addExtension (\"file.txt\") (\"bib\") == (\"file.txt.bib\")", property $ AFP_P.addExtension ("file.txt") ("bib") == ("file.txt.bib"))
+ ,("AFP_W.addExtension (\"file.txt\") (\"bib\") == (\"file.txt.bib\")", property $ AFP_W.addExtension ("file.txt") ("bib") == ("file.txt.bib"))
,("P.addExtension \"file.\" \".bib\" == \"file..bib\"", property $ P.addExtension "file." ".bib" == "file..bib")
,("W.addExtension \"file.\" \".bib\" == \"file..bib\"", property $ W.addExtension "file." ".bib" == "file..bib")
+ ,("AFP_P.addExtension (\"file.\") (\".bib\") == (\"file..bib\")", property $ AFP_P.addExtension ("file.") (".bib") == ("file..bib"))
+ ,("AFP_W.addExtension (\"file.\") (\".bib\") == (\"file..bib\")", property $ AFP_W.addExtension ("file.") (".bib") == ("file..bib"))
,("P.addExtension \"file\" \".bib\" == \"file.bib\"", property $ P.addExtension "file" ".bib" == "file.bib")
,("W.addExtension \"file\" \".bib\" == \"file.bib\"", property $ W.addExtension "file" ".bib" == "file.bib")
+ ,("AFP_P.addExtension (\"file\") (\".bib\") == (\"file.bib\")", property $ AFP_P.addExtension ("file") (".bib") == ("file.bib"))
+ ,("AFP_W.addExtension (\"file\") (\".bib\") == (\"file.bib\")", property $ AFP_W.addExtension ("file") (".bib") == ("file.bib"))
,("P.addExtension \"/\" \"x\" == \"/.x\"", property $ P.addExtension "/" "x" == "/.x")
,("W.addExtension \"/\" \"x\" == \"/.x\"", property $ W.addExtension "/" "x" == "/.x")
+ ,("AFP_P.addExtension (\"/\") (\"x\") == (\"/.x\")", property $ AFP_P.addExtension ("/") ("x") == ("/.x"))
+ ,("AFP_W.addExtension (\"/\") (\"x\") == (\"/.x\")", property $ AFP_W.addExtension ("/") ("x") == ("/.x"))
,("P.addExtension x \"\" == x", property $ \(QFilePath x) -> P.addExtension x "" == x)
,("W.addExtension x \"\" == x", property $ \(QFilePath x) -> W.addExtension x "" == x)
+ ,("AFP_P.addExtension x (\"\") == x", property $ \(QFilePathAFP_P x) -> AFP_P.addExtension x ("") == x)
+ ,("AFP_W.addExtension x (\"\") == x", property $ \(QFilePathAFP_W x) -> AFP_W.addExtension x ("") == x)
,("P.takeFileName (P.addExtension (P.addTrailingPathSeparator x) \"ext\") == \".ext\"", property $ \(QFilePathValidP x) -> P.takeFileName (P.addExtension (P.addTrailingPathSeparator x) "ext") == ".ext")
,("W.takeFileName (W.addExtension (W.addTrailingPathSeparator x) \"ext\") == \".ext\"", property $ \(QFilePathValidW x) -> W.takeFileName (W.addExtension (W.addTrailingPathSeparator x) "ext") == ".ext")
+ ,("AFP_P.takeFileName (AFP_P.addExtension (AFP_P.addTrailingPathSeparator x) (\"ext\")) == (\".ext\")", property $ \(QFilePathValidAFP_P x) -> AFP_P.takeFileName (AFP_P.addExtension (AFP_P.addTrailingPathSeparator x) ("ext")) == (".ext"))
+ ,("AFP_W.takeFileName (AFP_W.addExtension (AFP_W.addTrailingPathSeparator x) (\"ext\")) == (\".ext\")", property $ \(QFilePathValidAFP_W x) -> AFP_W.takeFileName (AFP_W.addExtension (AFP_W.addTrailingPathSeparator x) ("ext")) == (".ext"))
,("W.addExtension \"\\\\\\\\share\" \".txt\" == \"\\\\\\\\share\\\\.txt\"", property $ W.addExtension "\\\\share" ".txt" == "\\\\share\\.txt")
+ ,("AFP_W.addExtension (\"\\\\\\\\share\") (\".txt\") == (\"\\\\\\\\share\\\\.txt\")", property $ AFP_W.addExtension ("\\\\share") (".txt") == ("\\\\share\\.txt"))
,("P.hasExtension \"/directory/path.ext\" == True", property $ P.hasExtension "/directory/path.ext" == True)
,("W.hasExtension \"/directory/path.ext\" == True", property $ W.hasExtension "/directory/path.ext" == True)
+ ,("AFP_P.hasExtension (\"/directory/path.ext\") == True", property $ AFP_P.hasExtension ("/directory/path.ext") == True)
+ ,("AFP_W.hasExtension (\"/directory/path.ext\") == True", property $ AFP_W.hasExtension ("/directory/path.ext") == True)
,("P.hasExtension \"/directory/path\" == False", property $ P.hasExtension "/directory/path" == False)
,("W.hasExtension \"/directory/path\" == False", property $ W.hasExtension "/directory/path" == False)
+ ,("AFP_P.hasExtension (\"/directory/path\") == False", property $ AFP_P.hasExtension ("/directory/path") == False)
+ ,("AFP_W.hasExtension (\"/directory/path\") == False", property $ AFP_W.hasExtension ("/directory/path") == False)
,("null (P.takeExtension x) == not (P.hasExtension x)", property $ \(QFilePath x) -> null (P.takeExtension x) == not (P.hasExtension x))
,("null (W.takeExtension x) == not (W.hasExtension x)", property $ \(QFilePath x) -> null (W.takeExtension x) == not (W.hasExtension x))
+ ,("(SBS.null . unPFP) (AFP_P.takeExtension x) == not (AFP_P.hasExtension x)", property $ \(QFilePathAFP_P x) -> (SBS.null . unPFP) (AFP_P.takeExtension x) == not (AFP_P.hasExtension x))
+ ,("(SBS16.null . unWFP) (AFP_W.takeExtension x) == not (AFP_W.hasExtension x)", property $ \(QFilePathAFP_W x) -> (SBS16.null . unWFP) (AFP_W.takeExtension x) == not (AFP_W.hasExtension x))
,("\"png\" `P.isExtensionOf` \"/directory/file.png\" == True", property $ "png" `P.isExtensionOf` "/directory/file.png" == True)
,("\"png\" `W.isExtensionOf` \"/directory/file.png\" == True", property $ "png" `W.isExtensionOf` "/directory/file.png" == True)
+ ,("(\"png\") `AFP_P.isExtensionOf` (\"/directory/file.png\") == True", property $ ("png") `AFP_P.isExtensionOf` ("/directory/file.png") == True)
+ ,("(\"png\") `AFP_W.isExtensionOf` (\"/directory/file.png\") == True", property $ ("png") `AFP_W.isExtensionOf` ("/directory/file.png") == True)
,("\".png\" `P.isExtensionOf` \"/directory/file.png\" == True", property $ ".png" `P.isExtensionOf` "/directory/file.png" == True)
,("\".png\" `W.isExtensionOf` \"/directory/file.png\" == True", property $ ".png" `W.isExtensionOf` "/directory/file.png" == True)
+ ,("(\".png\") `AFP_P.isExtensionOf` (\"/directory/file.png\") == True", property $ (".png") `AFP_P.isExtensionOf` ("/directory/file.png") == True)
+ ,("(\".png\") `AFP_W.isExtensionOf` (\"/directory/file.png\") == True", property $ (".png") `AFP_W.isExtensionOf` ("/directory/file.png") == True)
,("\".tar.gz\" `P.isExtensionOf` \"bar/foo.tar.gz\" == True", property $ ".tar.gz" `P.isExtensionOf` "bar/foo.tar.gz" == True)
,("\".tar.gz\" `W.isExtensionOf` \"bar/foo.tar.gz\" == True", property $ ".tar.gz" `W.isExtensionOf` "bar/foo.tar.gz" == True)
+ ,("(\".tar.gz\") `AFP_P.isExtensionOf` (\"bar/foo.tar.gz\") == True", property $ (".tar.gz") `AFP_P.isExtensionOf` ("bar/foo.tar.gz") == True)
+ ,("(\".tar.gz\") `AFP_W.isExtensionOf` (\"bar/foo.tar.gz\") == True", property $ (".tar.gz") `AFP_W.isExtensionOf` ("bar/foo.tar.gz") == True)
,("\"ar.gz\" `P.isExtensionOf` \"bar/foo.tar.gz\" == False", property $ "ar.gz" `P.isExtensionOf` "bar/foo.tar.gz" == False)
,("\"ar.gz\" `W.isExtensionOf` \"bar/foo.tar.gz\" == False", property $ "ar.gz" `W.isExtensionOf` "bar/foo.tar.gz" == False)
+ ,("(\"ar.gz\") `AFP_P.isExtensionOf` (\"bar/foo.tar.gz\") == False", property $ ("ar.gz") `AFP_P.isExtensionOf` ("bar/foo.tar.gz") == False)
+ ,("(\"ar.gz\") `AFP_W.isExtensionOf` (\"bar/foo.tar.gz\") == False", property $ ("ar.gz") `AFP_W.isExtensionOf` ("bar/foo.tar.gz") == False)
,("\"png\" `P.isExtensionOf` \"/directory/file.png.jpg\" == False", property $ "png" `P.isExtensionOf` "/directory/file.png.jpg" == False)
,("\"png\" `W.isExtensionOf` \"/directory/file.png.jpg\" == False", property $ "png" `W.isExtensionOf` "/directory/file.png.jpg" == False)
+ ,("(\"png\") `AFP_P.isExtensionOf` (\"/directory/file.png.jpg\") == False", property $ ("png") `AFP_P.isExtensionOf` ("/directory/file.png.jpg") == False)
+ ,("(\"png\") `AFP_W.isExtensionOf` (\"/directory/file.png.jpg\") == False", property $ ("png") `AFP_W.isExtensionOf` ("/directory/file.png.jpg") == False)
,("\"csv/table.csv\" `P.isExtensionOf` \"/data/csv/table.csv\" == False", property $ "csv/table.csv" `P.isExtensionOf` "/data/csv/table.csv" == False)
,("\"csv/table.csv\" `W.isExtensionOf` \"/data/csv/table.csv\" == False", property $ "csv/table.csv" `W.isExtensionOf` "/data/csv/table.csv" == False)
+ ,("(\"csv/table.csv\") `AFP_P.isExtensionOf` (\"/data/csv/table.csv\") == False", property $ ("csv/table.csv") `AFP_P.isExtensionOf` ("/data/csv/table.csv") == False)
+ ,("(\"csv/table.csv\") `AFP_W.isExtensionOf` (\"/data/csv/table.csv\") == False", property $ ("csv/table.csv") `AFP_W.isExtensionOf` ("/data/csv/table.csv") == False)
,("P.stripExtension \"hs.o\" \"foo.x.hs.o\" == Just \"foo.x\"", property $ P.stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x")
,("W.stripExtension \"hs.o\" \"foo.x.hs.o\" == Just \"foo.x\"", property $ W.stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x")
+ ,("AFP_P.stripExtension (\"hs.o\") (\"foo.x.hs.o\") == Just (\"foo.x\")", property $ AFP_P.stripExtension ("hs.o") ("foo.x.hs.o") == Just ("foo.x"))
+ ,("AFP_W.stripExtension (\"hs.o\") (\"foo.x.hs.o\") == Just (\"foo.x\")", property $ AFP_W.stripExtension ("hs.o") ("foo.x.hs.o") == Just ("foo.x"))
,("P.stripExtension \"hi.o\" \"foo.x.hs.o\" == Nothing", property $ P.stripExtension "hi.o" "foo.x.hs.o" == Nothing)
,("W.stripExtension \"hi.o\" \"foo.x.hs.o\" == Nothing", property $ W.stripExtension "hi.o" "foo.x.hs.o" == Nothing)
+ ,("AFP_P.stripExtension (\"hi.o\") (\"foo.x.hs.o\") == Nothing", property $ AFP_P.stripExtension ("hi.o") ("foo.x.hs.o") == Nothing)
+ ,("AFP_W.stripExtension (\"hi.o\") (\"foo.x.hs.o\") == Nothing", property $ AFP_W.stripExtension ("hi.o") ("foo.x.hs.o") == Nothing)
,("P.dropExtension x == fromJust (P.stripExtension (P.takeExtension x) x)", property $ \(QFilePath x) -> P.dropExtension x == fromJust (P.stripExtension (P.takeExtension x) x))
,("W.dropExtension x == fromJust (W.stripExtension (W.takeExtension x) x)", property $ \(QFilePath x) -> W.dropExtension x == fromJust (W.stripExtension (W.takeExtension x) x))
+ ,("AFP_P.dropExtension x == fromJust (AFP_P.stripExtension (AFP_P.takeExtension x) x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropExtension x == fromJust (AFP_P.stripExtension (AFP_P.takeExtension x) x))
+ ,("AFP_W.dropExtension x == fromJust (AFP_W.stripExtension (AFP_W.takeExtension x) x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropExtension x == fromJust (AFP_W.stripExtension (AFP_W.takeExtension x) x))
,("P.dropExtensions x == fromJust (P.stripExtension (P.takeExtensions x) x)", property $ \(QFilePath x) -> P.dropExtensions x == fromJust (P.stripExtension (P.takeExtensions x) x))
,("W.dropExtensions x == fromJust (W.stripExtension (W.takeExtensions x) x)", property $ \(QFilePath x) -> W.dropExtensions x == fromJust (W.stripExtension (W.takeExtensions x) x))
+ ,("AFP_P.dropExtensions x == fromJust (AFP_P.stripExtension (AFP_P.takeExtensions x) x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropExtensions x == fromJust (AFP_P.stripExtension (AFP_P.takeExtensions x) x))
+ ,("AFP_W.dropExtensions x == fromJust (AFP_W.stripExtension (AFP_W.takeExtensions x) x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropExtensions x == fromJust (AFP_W.stripExtension (AFP_W.takeExtensions x) x))
,("P.stripExtension \".c.d\" \"a.b.c.d\" == Just \"a.b\"", property $ P.stripExtension ".c.d" "a.b.c.d" == Just "a.b")
,("W.stripExtension \".c.d\" \"a.b.c.d\" == Just \"a.b\"", property $ W.stripExtension ".c.d" "a.b.c.d" == Just "a.b")
+ ,("AFP_P.stripExtension (\".c.d\") (\"a.b.c.d\") == Just (\"a.b\")", property $ AFP_P.stripExtension (".c.d") ("a.b.c.d") == Just ("a.b"))
+ ,("AFP_W.stripExtension (\".c.d\") (\"a.b.c.d\") == Just (\"a.b\")", property $ AFP_W.stripExtension (".c.d") ("a.b.c.d") == Just ("a.b"))
,("P.stripExtension \".c.d\" \"a.b..c.d\" == Just \"a.b.\"", property $ P.stripExtension ".c.d" "a.b..c.d" == Just "a.b.")
,("W.stripExtension \".c.d\" \"a.b..c.d\" == Just \"a.b.\"", property $ W.stripExtension ".c.d" "a.b..c.d" == Just "a.b.")
+ ,("AFP_P.stripExtension (\".c.d\") (\"a.b..c.d\") == Just (\"a.b.\")", property $ AFP_P.stripExtension (".c.d") ("a.b..c.d") == Just ("a.b."))
+ ,("AFP_W.stripExtension (\".c.d\") (\"a.b..c.d\") == Just (\"a.b.\")", property $ AFP_W.stripExtension (".c.d") ("a.b..c.d") == Just ("a.b."))
,("P.stripExtension \"baz\" \"foo.bar\" == Nothing", property $ P.stripExtension "baz" "foo.bar" == Nothing)
,("W.stripExtension \"baz\" \"foo.bar\" == Nothing", property $ W.stripExtension "baz" "foo.bar" == Nothing)
+ ,("AFP_P.stripExtension (\"baz\") (\"foo.bar\") == Nothing", property $ AFP_P.stripExtension ("baz") ("foo.bar") == Nothing)
+ ,("AFP_W.stripExtension (\"baz\") (\"foo.bar\") == Nothing", property $ AFP_W.stripExtension ("baz") ("foo.bar") == Nothing)
,("P.stripExtension \"bar\" \"foobar\" == Nothing", property $ P.stripExtension "bar" "foobar" == Nothing)
,("W.stripExtension \"bar\" \"foobar\" == Nothing", property $ W.stripExtension "bar" "foobar" == Nothing)
+ ,("AFP_P.stripExtension (\"bar\") (\"foobar\") == Nothing", property $ AFP_P.stripExtension ("bar") ("foobar") == Nothing)
+ ,("AFP_W.stripExtension (\"bar\") (\"foobar\") == Nothing", property $ AFP_W.stripExtension ("bar") ("foobar") == Nothing)
,("P.stripExtension \"\" x == Just x", property $ \(QFilePath x) -> P.stripExtension "" x == Just x)
,("W.stripExtension \"\" x == Just x", property $ \(QFilePath x) -> W.stripExtension "" x == Just x)
+ ,("AFP_P.stripExtension (\"\") x == Just x", property $ \(QFilePathAFP_P x) -> AFP_P.stripExtension ("") x == Just x)
+ ,("AFP_W.stripExtension (\"\") x == Just x", property $ \(QFilePathAFP_W x) -> AFP_W.stripExtension ("") x == Just x)
,("P.splitExtensions \"/directory/path.ext\" == (\"/directory/path\", \".ext\")", property $ P.splitExtensions "/directory/path.ext" == ("/directory/path", ".ext"))
,("W.splitExtensions \"/directory/path.ext\" == (\"/directory/path\", \".ext\")", property $ W.splitExtensions "/directory/path.ext" == ("/directory/path", ".ext"))
+ ,("AFP_P.splitExtensions (\"/directory/path.ext\") == ((\"/directory/path\"), (\".ext\"))", property $ AFP_P.splitExtensions ("/directory/path.ext") == (("/directory/path"), (".ext")))
+ ,("AFP_W.splitExtensions (\"/directory/path.ext\") == ((\"/directory/path\"), (\".ext\"))", property $ AFP_W.splitExtensions ("/directory/path.ext") == (("/directory/path"), (".ext")))
,("P.splitExtensions \"file.tar.gz\" == (\"file\", \".tar.gz\")", property $ P.splitExtensions "file.tar.gz" == ("file", ".tar.gz"))
,("W.splitExtensions \"file.tar.gz\" == (\"file\", \".tar.gz\")", property $ W.splitExtensions "file.tar.gz" == ("file", ".tar.gz"))
- ,("uncurry (++) (P.splitExtensions x) == x", property $ \(QFilePath x) -> uncurry (++) (P.splitExtensions x) == x)
- ,("uncurry (++) (W.splitExtensions x) == x", property $ \(QFilePath x) -> uncurry (++) (W.splitExtensions x) == x)
+ ,("AFP_P.splitExtensions (\"file.tar.gz\") == ((\"file\"), (\".tar.gz\"))", property $ AFP_P.splitExtensions ("file.tar.gz") == (("file"), (".tar.gz")))
+ ,("AFP_W.splitExtensions (\"file.tar.gz\") == ((\"file\"), (\".tar.gz\"))", property $ AFP_W.splitExtensions ("file.tar.gz") == (("file"), (".tar.gz")))
+ ,("uncurry (<>) (P.splitExtensions x) == x", property $ \(QFilePath x) -> uncurry (<>) (P.splitExtensions x) == x)
+ ,("uncurry (<>) (W.splitExtensions x) == x", property $ \(QFilePath x) -> uncurry (<>) (W.splitExtensions x) == x)
+ ,("uncurry (<>) (AFP_P.splitExtensions x) == x", property $ \(QFilePathAFP_P x) -> uncurry (<>) (AFP_P.splitExtensions x) == x)
+ ,("uncurry (<>) (AFP_W.splitExtensions x) == x", property $ \(QFilePathAFP_W x) -> uncurry (<>) (AFP_W.splitExtensions x) == x)
,("uncurry P.addExtension (P.splitExtensions x) == x", property $ \(QFilePathValidP x) -> uncurry P.addExtension (P.splitExtensions x) == x)
,("uncurry W.addExtension (W.splitExtensions x) == x", property $ \(QFilePathValidW x) -> uncurry W.addExtension (W.splitExtensions x) == x)
+ ,("uncurry AFP_P.addExtension (AFP_P.splitExtensions x) == x", property $ \(QFilePathValidAFP_P x) -> uncurry AFP_P.addExtension (AFP_P.splitExtensions x) == x)
+ ,("uncurry AFP_W.addExtension (AFP_W.splitExtensions x) == x", property $ \(QFilePathValidAFP_W x) -> uncurry AFP_W.addExtension (AFP_W.splitExtensions x) == x)
,("P.splitExtensions \"file.tar.gz\" == (\"file\", \".tar.gz\")", property $ P.splitExtensions "file.tar.gz" == ("file", ".tar.gz"))
,("W.splitExtensions \"file.tar.gz\" == (\"file\", \".tar.gz\")", property $ W.splitExtensions "file.tar.gz" == ("file", ".tar.gz"))
+ ,("AFP_P.splitExtensions (\"file.tar.gz\") == ((\"file\"), (\".tar.gz\"))", property $ AFP_P.splitExtensions ("file.tar.gz") == (("file"), (".tar.gz")))
+ ,("AFP_W.splitExtensions (\"file.tar.gz\") == ((\"file\"), (\".tar.gz\"))", property $ AFP_W.splitExtensions ("file.tar.gz") == (("file"), (".tar.gz")))
,("P.dropExtensions \"/directory/path.ext\" == \"/directory/path\"", property $ P.dropExtensions "/directory/path.ext" == "/directory/path")
,("W.dropExtensions \"/directory/path.ext\" == \"/directory/path\"", property $ W.dropExtensions "/directory/path.ext" == "/directory/path")
+ ,("AFP_P.dropExtensions (\"/directory/path.ext\") == (\"/directory/path\")", property $ AFP_P.dropExtensions ("/directory/path.ext") == ("/directory/path"))
+ ,("AFP_W.dropExtensions (\"/directory/path.ext\") == (\"/directory/path\")", property $ AFP_W.dropExtensions ("/directory/path.ext") == ("/directory/path"))
,("P.dropExtensions \"file.tar.gz\" == \"file\"", property $ P.dropExtensions "file.tar.gz" == "file")
,("W.dropExtensions \"file.tar.gz\" == \"file\"", property $ W.dropExtensions "file.tar.gz" == "file")
+ ,("AFP_P.dropExtensions (\"file.tar.gz\") == (\"file\")", property $ AFP_P.dropExtensions ("file.tar.gz") == ("file"))
+ ,("AFP_W.dropExtensions (\"file.tar.gz\") == (\"file\")", property $ AFP_W.dropExtensions ("file.tar.gz") == ("file"))
,("not $ P.hasExtension $ P.dropExtensions x", property $ \(QFilePath x) -> not $ P.hasExtension $ P.dropExtensions x)
,("not $ W.hasExtension $ W.dropExtensions x", property $ \(QFilePath x) -> not $ W.hasExtension $ W.dropExtensions x)
+ ,("not $ AFP_P.hasExtension $ AFP_P.dropExtensions x", property $ \(QFilePathAFP_P x) -> not $ AFP_P.hasExtension $ AFP_P.dropExtensions x)
+ ,("not $ AFP_W.hasExtension $ AFP_W.dropExtensions x", property $ \(QFilePathAFP_W x) -> not $ AFP_W.hasExtension $ AFP_W.dropExtensions x)
,("not $ any P.isExtSeparator $ P.takeFileName $ P.dropExtensions x", property $ \(QFilePath x) -> not $ any P.isExtSeparator $ P.takeFileName $ P.dropExtensions x)
,("not $ any W.isExtSeparator $ W.takeFileName $ W.dropExtensions x", property $ \(QFilePath x) -> not $ any W.isExtSeparator $ W.takeFileName $ W.dropExtensions x)
+ ,("not $ (\\f (unPFP -> x) -> SBS.any (f . PW) x) AFP_P.isExtSeparator $ AFP_P.takeFileName $ AFP_P.dropExtensions x", property $ \(QFilePathAFP_P x) -> not $ (\f (unPFP -> x) -> SBS.any (f . PW) x) AFP_P.isExtSeparator $ AFP_P.takeFileName $ AFP_P.dropExtensions x)
+ ,("not $ (\\f (unWFP -> x) -> SBS16.any (f . WW) x) AFP_W.isExtSeparator $ AFP_W.takeFileName $ AFP_W.dropExtensions x", property $ \(QFilePathAFP_W x) -> not $ (\f (unWFP -> x) -> SBS16.any (f . WW) x) AFP_W.isExtSeparator $ AFP_W.takeFileName $ AFP_W.dropExtensions x)
,("P.takeExtensions \"/directory/path.ext\" == \".ext\"", property $ P.takeExtensions "/directory/path.ext" == ".ext")
,("W.takeExtensions \"/directory/path.ext\" == \".ext\"", property $ W.takeExtensions "/directory/path.ext" == ".ext")
+ ,("AFP_P.takeExtensions (\"/directory/path.ext\") == (\".ext\")", property $ AFP_P.takeExtensions ("/directory/path.ext") == (".ext"))
+ ,("AFP_W.takeExtensions (\"/directory/path.ext\") == (\".ext\")", property $ AFP_W.takeExtensions ("/directory/path.ext") == (".ext"))
,("P.takeExtensions \"file.tar.gz\" == \".tar.gz\"", property $ P.takeExtensions "file.tar.gz" == ".tar.gz")
,("W.takeExtensions \"file.tar.gz\" == \".tar.gz\"", property $ W.takeExtensions "file.tar.gz" == ".tar.gz")
+ ,("AFP_P.takeExtensions (\"file.tar.gz\") == (\".tar.gz\")", property $ AFP_P.takeExtensions ("file.tar.gz") == (".tar.gz"))
+ ,("AFP_W.takeExtensions (\"file.tar.gz\") == (\".tar.gz\")", property $ AFP_W.takeExtensions ("file.tar.gz") == (".tar.gz"))
,("P.replaceExtensions \"file.fred.bob\" \"txt\" == \"file.txt\"", property $ P.replaceExtensions "file.fred.bob" "txt" == "file.txt")
,("W.replaceExtensions \"file.fred.bob\" \"txt\" == \"file.txt\"", property $ W.replaceExtensions "file.fred.bob" "txt" == "file.txt")
+ ,("AFP_P.replaceExtensions (\"file.fred.bob\") (\"txt\") == (\"file.txt\")", property $ AFP_P.replaceExtensions ("file.fred.bob") ("txt") == ("file.txt"))
+ ,("AFP_W.replaceExtensions (\"file.fred.bob\") (\"txt\") == (\"file.txt\")", property $ AFP_W.replaceExtensions ("file.fred.bob") ("txt") == ("file.txt"))
,("P.replaceExtensions \"file.fred.bob\" \"tar.gz\" == \"file.tar.gz\"", property $ P.replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz")
,("W.replaceExtensions \"file.fred.bob\" \"tar.gz\" == \"file.tar.gz\"", property $ W.replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz")
- ,("uncurry (++) (P.splitDrive x) == x", property $ \(QFilePath x) -> uncurry (++) (P.splitDrive x) == x)
- ,("uncurry (++) (W.splitDrive x) == x", property $ \(QFilePath x) -> uncurry (++) (W.splitDrive x) == x)
+ ,("AFP_P.replaceExtensions (\"file.fred.bob\") (\"tar.gz\") == (\"file.tar.gz\")", property $ AFP_P.replaceExtensions ("file.fred.bob") ("tar.gz") == ("file.tar.gz"))
+ ,("AFP_W.replaceExtensions (\"file.fred.bob\") (\"tar.gz\") == (\"file.tar.gz\")", property $ AFP_W.replaceExtensions ("file.fred.bob") ("tar.gz") == ("file.tar.gz"))
+ ,("uncurry (<>) (P.splitDrive x) == x", property $ \(QFilePath x) -> uncurry (<>) (P.splitDrive x) == x)
+ ,("uncurry (<>) (W.splitDrive x) == x", property $ \(QFilePath x) -> uncurry (<>) (W.splitDrive x) == x)
+ ,("uncurry (<>) (AFP_P.splitDrive x) == x", property $ \(QFilePathAFP_P x) -> uncurry (<>) (AFP_P.splitDrive x) == x)
+ ,("uncurry (<>) (AFP_W.splitDrive x) == x", property $ \(QFilePathAFP_W x) -> uncurry (<>) (AFP_W.splitDrive x) == x)
,("W.splitDrive \"file\" == (\"\", \"file\")", property $ W.splitDrive "file" == ("", "file"))
+ ,("AFP_W.splitDrive (\"file\") == ((\"\"), (\"file\"))", property $ AFP_W.splitDrive ("file") == ((""), ("file")))
,("W.splitDrive \"c:/file\" == (\"c:/\", \"file\")", property $ W.splitDrive "c:/file" == ("c:/", "file"))
+ ,("AFP_W.splitDrive (\"c:/file\") == ((\"c:/\"), (\"file\"))", property $ AFP_W.splitDrive ("c:/file") == (("c:/"), ("file")))
,("W.splitDrive \"c:\\\\file\" == (\"c:\\\\\", \"file\")", property $ W.splitDrive "c:\\file" == ("c:\\", "file"))
+ ,("AFP_W.splitDrive (\"c:\\\\file\") == ((\"c:\\\\\"), (\"file\"))", property $ AFP_W.splitDrive ("c:\\file") == (("c:\\"), ("file")))
,("W.splitDrive \"\\\\\\\\shared\\\\test\" == (\"\\\\\\\\shared\\\\\", \"test\")", property $ W.splitDrive "\\\\shared\\test" == ("\\\\shared\\", "test"))
+ ,("AFP_W.splitDrive (\"\\\\\\\\shared\\\\test\") == ((\"\\\\\\\\shared\\\\\"), (\"test\"))", property $ AFP_W.splitDrive ("\\\\shared\\test") == (("\\\\shared\\"), ("test")))
,("W.splitDrive \"\\\\\\\\shared\" == (\"\\\\\\\\shared\", \"\")", property $ W.splitDrive "\\\\shared" == ("\\\\shared", ""))
+ ,("AFP_W.splitDrive (\"\\\\\\\\shared\") == ((\"\\\\\\\\shared\"), (\"\"))", property $ AFP_W.splitDrive ("\\\\shared") == (("\\\\shared"), ("")))
,("W.splitDrive \"\\\\\\\\?\\\\UNC\\\\shared\\\\file\" == (\"\\\\\\\\?\\\\UNC\\\\shared\\\\\", \"file\")", property $ W.splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\", "file"))
+ ,("AFP_W.splitDrive (\"\\\\\\\\?\\\\UNC\\\\shared\\\\file\") == ((\"\\\\\\\\?\\\\UNC\\\\shared\\\\\"), (\"file\"))", property $ AFP_W.splitDrive ("\\\\?\\UNC\\shared\\file") == (("\\\\?\\UNC\\shared\\"), ("file")))
,("W.splitDrive \"\\\\\\\\?\\\\UNCshared\\\\file\" == (\"\\\\\\\\?\\\\\", \"UNCshared\\\\file\")", property $ W.splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\", "UNCshared\\file"))
+ ,("AFP_W.splitDrive (\"\\\\\\\\?\\\\UNCshared\\\\file\") == ((\"\\\\\\\\?\\\\\"), (\"UNCshared\\\\file\"))", property $ AFP_W.splitDrive ("\\\\?\\UNCshared\\file") == (("\\\\?\\"), ("UNCshared\\file")))
,("W.splitDrive \"\\\\\\\\?\\\\d:\\\\file\" == (\"\\\\\\\\?\\\\d:\\\\\", \"file\")", property $ W.splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\", "file"))
+ ,("AFP_W.splitDrive (\"\\\\\\\\?\\\\d:\\\\file\") == ((\"\\\\\\\\?\\\\d:\\\\\"), (\"file\"))", property $ AFP_W.splitDrive ("\\\\?\\d:\\file") == (("\\\\?\\d:\\"), ("file")))
,("W.splitDrive \"/d\" == (\"\", \"/d\")", property $ W.splitDrive "/d" == ("", "/d"))
+ ,("AFP_W.splitDrive (\"/d\") == ((\"\"), (\"/d\"))", property $ AFP_W.splitDrive ("/d") == ((""), ("/d")))
,("P.splitDrive \"/test\" == (\"/\", \"test\")", property $ P.splitDrive "/test" == ("/", "test"))
+ ,("AFP_P.splitDrive (\"/test\") == ((\"/\"), (\"test\"))", property $ AFP_P.splitDrive ("/test") == (("/"), ("test")))
,("P.splitDrive \"//test\" == (\"//\", \"test\")", property $ P.splitDrive "//test" == ("//", "test"))
+ ,("AFP_P.splitDrive (\"//test\") == ((\"//\"), (\"test\"))", property $ AFP_P.splitDrive ("//test") == (("//"), ("test")))
,("P.splitDrive \"test/file\" == (\"\", \"test/file\")", property $ P.splitDrive "test/file" == ("", "test/file"))
+ ,("AFP_P.splitDrive (\"test/file\") == ((\"\"), (\"test/file\"))", property $ AFP_P.splitDrive ("test/file") == ((""), ("test/file")))
,("P.splitDrive \"file\" == (\"\", \"file\")", property $ P.splitDrive "file" == ("", "file"))
+ ,("AFP_P.splitDrive (\"file\") == ((\"\"), (\"file\"))", property $ AFP_P.splitDrive ("file") == ((""), ("file")))
,("uncurry P.joinDrive (P.splitDrive x) == x", property $ \(QFilePathValidP x) -> uncurry P.joinDrive (P.splitDrive x) == x)
,("uncurry W.joinDrive (W.splitDrive x) == x", property $ \(QFilePathValidW x) -> uncurry W.joinDrive (W.splitDrive x) == x)
+ ,("uncurry AFP_P.joinDrive (AFP_P.splitDrive x) == x", property $ \(QFilePathValidAFP_P x) -> uncurry AFP_P.joinDrive (AFP_P.splitDrive x) == x)
+ ,("uncurry AFP_W.joinDrive (AFP_W.splitDrive x) == x", property $ \(QFilePathValidAFP_W x) -> uncurry AFP_W.joinDrive (AFP_W.splitDrive x) == x)
,("W.joinDrive \"C:\" \"foo\" == \"C:foo\"", property $ W.joinDrive "C:" "foo" == "C:foo")
+ ,("AFP_W.joinDrive (\"C:\") (\"foo\") == (\"C:foo\")", property $ AFP_W.joinDrive ("C:") ("foo") == ("C:foo"))
,("W.joinDrive \"C:\\\\\" \"bar\" == \"C:\\\\bar\"", property $ W.joinDrive "C:\\" "bar" == "C:\\bar")
+ ,("AFP_W.joinDrive (\"C:\\\\\") (\"bar\") == (\"C:\\\\bar\")", property $ AFP_W.joinDrive ("C:\\") ("bar") == ("C:\\bar"))
,("W.joinDrive \"\\\\\\\\share\" \"foo\" == \"\\\\\\\\share\\\\foo\"", property $ W.joinDrive "\\\\share" "foo" == "\\\\share\\foo")
+ ,("AFP_W.joinDrive (\"\\\\\\\\share\") (\"foo\") == (\"\\\\\\\\share\\\\foo\")", property $ AFP_W.joinDrive ("\\\\share") ("foo") == ("\\\\share\\foo"))
,("W.joinDrive \"/:\" \"foo\" == \"/:\\\\foo\"", property $ W.joinDrive "/:" "foo" == "/:\\foo")
+ ,("AFP_W.joinDrive (\"/:\") (\"foo\") == (\"/:\\\\foo\")", property $ AFP_W.joinDrive ("/:") ("foo") == ("/:\\foo"))
,("P.takeDrive x == fst (P.splitDrive x)", property $ \(QFilePath x) -> P.takeDrive x == fst (P.splitDrive x))
,("W.takeDrive x == fst (W.splitDrive x)", property $ \(QFilePath x) -> W.takeDrive x == fst (W.splitDrive x))
+ ,("AFP_P.takeDrive x == fst (AFP_P.splitDrive x)", property $ \(QFilePathAFP_P x) -> AFP_P.takeDrive x == fst (AFP_P.splitDrive x))
+ ,("AFP_W.takeDrive x == fst (AFP_W.splitDrive x)", property $ \(QFilePathAFP_W x) -> AFP_W.takeDrive x == fst (AFP_W.splitDrive x))
,("P.dropDrive x == snd (P.splitDrive x)", property $ \(QFilePath x) -> P.dropDrive x == snd (P.splitDrive x))
,("W.dropDrive x == snd (W.splitDrive x)", property $ \(QFilePath x) -> W.dropDrive x == snd (W.splitDrive x))
+ ,("AFP_P.dropDrive x == snd (AFP_P.splitDrive x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropDrive x == snd (AFP_P.splitDrive x))
+ ,("AFP_W.dropDrive x == snd (AFP_W.splitDrive x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropDrive x == snd (AFP_W.splitDrive x))
,("not (P.hasDrive x) == null (P.takeDrive x)", property $ \(QFilePath x) -> not (P.hasDrive x) == null (P.takeDrive x))
,("not (W.hasDrive x) == null (W.takeDrive x)", property $ \(QFilePath x) -> not (W.hasDrive x) == null (W.takeDrive x))
+ ,("not (AFP_P.hasDrive x) == (SBS.null . unPFP) (AFP_P.takeDrive x)", property $ \(QFilePathAFP_P x) -> not (AFP_P.hasDrive x) == (SBS.null . unPFP) (AFP_P.takeDrive x))
+ ,("not (AFP_W.hasDrive x) == (SBS16.null . unWFP) (AFP_W.takeDrive x)", property $ \(QFilePathAFP_W x) -> not (AFP_W.hasDrive x) == (SBS16.null . unWFP) (AFP_W.takeDrive x))
,("P.hasDrive \"/foo\" == True", property $ P.hasDrive "/foo" == True)
+ ,("AFP_P.hasDrive (\"/foo\") == True", property $ AFP_P.hasDrive ("/foo") == True)
,("W.hasDrive \"C:\\\\foo\" == True", property $ W.hasDrive "C:\\foo" == True)
+ ,("AFP_W.hasDrive (\"C:\\\\foo\") == True", property $ AFP_W.hasDrive ("C:\\foo") == True)
,("W.hasDrive \"C:foo\" == True", property $ W.hasDrive "C:foo" == True)
+ ,("AFP_W.hasDrive (\"C:foo\") == True", property $ AFP_W.hasDrive ("C:foo") == True)
,("P.hasDrive \"foo\" == False", property $ P.hasDrive "foo" == False)
,("W.hasDrive \"foo\" == False", property $ W.hasDrive "foo" == False)
+ ,("AFP_P.hasDrive (\"foo\") == False", property $ AFP_P.hasDrive ("foo") == False)
+ ,("AFP_W.hasDrive (\"foo\") == False", property $ AFP_W.hasDrive ("foo") == False)
,("P.hasDrive \"\" == False", property $ P.hasDrive "" == False)
,("W.hasDrive \"\" == False", property $ W.hasDrive "" == False)
+ ,("AFP_P.hasDrive (\"\") == False", property $ AFP_P.hasDrive ("") == False)
+ ,("AFP_W.hasDrive (\"\") == False", property $ AFP_W.hasDrive ("") == False)
,("P.isDrive \"/\" == True", property $ P.isDrive "/" == True)
+ ,("AFP_P.isDrive (\"/\") == True", property $ AFP_P.isDrive ("/") == True)
,("P.isDrive \"/foo\" == False", property $ P.isDrive "/foo" == False)
+ ,("AFP_P.isDrive (\"/foo\") == False", property $ AFP_P.isDrive ("/foo") == False)
,("W.isDrive \"C:\\\\\" == True", property $ W.isDrive "C:\\" == True)
+ ,("AFP_W.isDrive (\"C:\\\\\") == True", property $ AFP_W.isDrive ("C:\\") == True)
,("W.isDrive \"C:\\\\foo\" == False", property $ W.isDrive "C:\\foo" == False)
+ ,("AFP_W.isDrive (\"C:\\\\foo\") == False", property $ AFP_W.isDrive ("C:\\foo") == False)
,("P.isDrive \"\" == False", property $ P.isDrive "" == False)
,("W.isDrive \"\" == False", property $ W.isDrive "" == False)
+ ,("AFP_P.isDrive (\"\") == False", property $ AFP_P.isDrive ("") == False)
+ ,("AFP_W.isDrive (\"\") == False", property $ AFP_W.isDrive ("") == False)
,("P.splitFileName \"/directory/file.ext\" == (\"/directory/\", \"file.ext\")", property $ P.splitFileName "/directory/file.ext" == ("/directory/", "file.ext"))
,("W.splitFileName \"/directory/file.ext\" == (\"/directory/\", \"file.ext\")", property $ W.splitFileName "/directory/file.ext" == ("/directory/", "file.ext"))
+ ,("AFP_P.splitFileName (\"/directory/file.ext\") == ((\"/directory/\"), (\"file.ext\"))", property $ AFP_P.splitFileName ("/directory/file.ext") == (("/directory/"), ("file.ext")))
+ ,("AFP_W.splitFileName (\"/directory/file.ext\") == ((\"/directory/\"), (\"file.ext\"))", property $ AFP_W.splitFileName ("/directory/file.ext") == (("/directory/"), ("file.ext")))
,("uncurry (P.</>) (P.splitFileName x) == x || fst (P.splitFileName x) == \"./\"", property $ \(QFilePathValidP x) -> uncurry (P.</>) (P.splitFileName x) == x || fst (P.splitFileName x) == "./")
,("uncurry (W.</>) (W.splitFileName x) == x || fst (W.splitFileName x) == \"./\"", property $ \(QFilePathValidW x) -> uncurry (W.</>) (W.splitFileName x) == x || fst (W.splitFileName x) == "./")
+ ,("uncurry (AFP_P.</>) (AFP_P.splitFileName x) == x || fst (AFP_P.splitFileName x) == (\"./\")", property $ \(QFilePathValidAFP_P x) -> uncurry (AFP_P.</>) (AFP_P.splitFileName x) == x || fst (AFP_P.splitFileName x) == ("./"))
+ ,("uncurry (AFP_W.</>) (AFP_W.splitFileName x) == x || fst (AFP_W.splitFileName x) == (\"./\")", property $ \(QFilePathValidAFP_W x) -> uncurry (AFP_W.</>) (AFP_W.splitFileName x) == x || fst (AFP_W.splitFileName x) == ("./"))
,("P.isValid (fst (P.splitFileName x))", property $ \(QFilePathValidP x) -> P.isValid (fst (P.splitFileName x)))
,("W.isValid (fst (W.splitFileName x))", property $ \(QFilePathValidW x) -> W.isValid (fst (W.splitFileName x)))
+ ,("AFP_P.isValid (fst (AFP_P.splitFileName x))", property $ \(QFilePathValidAFP_P x) -> AFP_P.isValid (fst (AFP_P.splitFileName x)))
+ ,("AFP_W.isValid (fst (AFP_W.splitFileName x))", property $ \(QFilePathValidAFP_W x) -> AFP_W.isValid (fst (AFP_W.splitFileName x)))
,("P.splitFileName \"file/bob.txt\" == (\"file/\", \"bob.txt\")", property $ P.splitFileName "file/bob.txt" == ("file/", "bob.txt"))
,("W.splitFileName \"file/bob.txt\" == (\"file/\", \"bob.txt\")", property $ W.splitFileName "file/bob.txt" == ("file/", "bob.txt"))
+ ,("AFP_P.splitFileName (\"file/bob.txt\") == ((\"file/\"), (\"bob.txt\"))", property $ AFP_P.splitFileName ("file/bob.txt") == (("file/"), ("bob.txt")))
+ ,("AFP_W.splitFileName (\"file/bob.txt\") == ((\"file/\"), (\"bob.txt\"))", property $ AFP_W.splitFileName ("file/bob.txt") == (("file/"), ("bob.txt")))
,("P.splitFileName \"file/\" == (\"file/\", \"\")", property $ P.splitFileName "file/" == ("file/", ""))
,("W.splitFileName \"file/\" == (\"file/\", \"\")", property $ W.splitFileName "file/" == ("file/", ""))
+ ,("AFP_P.splitFileName (\"file/\") == ((\"file/\"), (\"\"))", property $ AFP_P.splitFileName ("file/") == (("file/"), ("")))
+ ,("AFP_W.splitFileName (\"file/\") == ((\"file/\"), (\"\"))", property $ AFP_W.splitFileName ("file/") == (("file/"), ("")))
,("P.splitFileName \"bob\" == (\"./\", \"bob\")", property $ P.splitFileName "bob" == ("./", "bob"))
,("W.splitFileName \"bob\" == (\"./\", \"bob\")", property $ W.splitFileName "bob" == ("./", "bob"))
+ ,("AFP_P.splitFileName (\"bob\") == ((\"./\"), (\"bob\"))", property $ AFP_P.splitFileName ("bob") == (("./"), ("bob")))
+ ,("AFP_W.splitFileName (\"bob\") == ((\"./\"), (\"bob\"))", property $ AFP_W.splitFileName ("bob") == (("./"), ("bob")))
,("P.splitFileName \"/\" == (\"/\", \"\")", property $ P.splitFileName "/" == ("/", ""))
+ ,("AFP_P.splitFileName (\"/\") == ((\"/\"), (\"\"))", property $ AFP_P.splitFileName ("/") == (("/"), ("")))
,("W.splitFileName \"c:\" == (\"c:\", \"\")", property $ W.splitFileName "c:" == ("c:", ""))
+ ,("AFP_W.splitFileName (\"c:\") == ((\"c:\"), (\"\"))", property $ AFP_W.splitFileName ("c:") == (("c:"), ("")))
,("P.replaceFileName \"/directory/other.txt\" \"file.ext\" == \"/directory/file.ext\"", property $ P.replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext")
,("W.replaceFileName \"/directory/other.txt\" \"file.ext\" == \"/directory/file.ext\"", property $ W.replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext")
+ ,("AFP_P.replaceFileName (\"/directory/other.txt\") (\"file.ext\") == (\"/directory/file.ext\")", property $ AFP_P.replaceFileName ("/directory/other.txt") ("file.ext") == ("/directory/file.ext"))
+ ,("AFP_W.replaceFileName (\"/directory/other.txt\") (\"file.ext\") == (\"/directory/file.ext\")", property $ AFP_W.replaceFileName ("/directory/other.txt") ("file.ext") == ("/directory/file.ext"))
,("P.replaceFileName x (P.takeFileName x) == x", property $ \(QFilePathValidP x) -> P.replaceFileName x (P.takeFileName x) == x)
,("W.replaceFileName x (W.takeFileName x) == x", property $ \(QFilePathValidW x) -> W.replaceFileName x (W.takeFileName x) == x)
+ ,("AFP_P.replaceFileName x (AFP_P.takeFileName x) == x", property $ \(QFilePathValidAFP_P x) -> AFP_P.replaceFileName x (AFP_P.takeFileName x) == x)
+ ,("AFP_W.replaceFileName x (AFP_W.takeFileName x) == x", property $ \(QFilePathValidAFP_W x) -> AFP_W.replaceFileName x (AFP_W.takeFileName x) == x)
,("P.dropFileName \"/directory/file.ext\" == \"/directory/\"", property $ P.dropFileName "/directory/file.ext" == "/directory/")
,("W.dropFileName \"/directory/file.ext\" == \"/directory/\"", property $ W.dropFileName "/directory/file.ext" == "/directory/")
+ ,("AFP_P.dropFileName (\"/directory/file.ext\") == (\"/directory/\")", property $ AFP_P.dropFileName ("/directory/file.ext") == ("/directory/"))
+ ,("AFP_W.dropFileName (\"/directory/file.ext\") == (\"/directory/\")", property $ AFP_W.dropFileName ("/directory/file.ext") == ("/directory/"))
,("P.dropFileName x == fst (P.splitFileName x)", property $ \(QFilePath x) -> P.dropFileName x == fst (P.splitFileName x))
,("W.dropFileName x == fst (W.splitFileName x)", property $ \(QFilePath x) -> W.dropFileName x == fst (W.splitFileName x))
+ ,("AFP_P.dropFileName x == fst (AFP_P.splitFileName x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropFileName x == fst (AFP_P.splitFileName x))
+ ,("AFP_W.dropFileName x == fst (AFP_W.splitFileName x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropFileName x == fst (AFP_W.splitFileName x))
,("P.takeFileName \"/directory/file.ext\" == \"file.ext\"", property $ P.takeFileName "/directory/file.ext" == "file.ext")
,("W.takeFileName \"/directory/file.ext\" == \"file.ext\"", property $ W.takeFileName "/directory/file.ext" == "file.ext")
+ ,("AFP_P.takeFileName (\"/directory/file.ext\") == (\"file.ext\")", property $ AFP_P.takeFileName ("/directory/file.ext") == ("file.ext"))
+ ,("AFP_W.takeFileName (\"/directory/file.ext\") == (\"file.ext\")", property $ AFP_W.takeFileName ("/directory/file.ext") == ("file.ext"))
,("P.takeFileName \"test/\" == \"\"", property $ P.takeFileName "test/" == "")
,("W.takeFileName \"test/\" == \"\"", property $ W.takeFileName "test/" == "")
- ,("P.takeFileName x `isSuffixOf` x", property $ \(QFilePath x) -> P.takeFileName x `isSuffixOf` x)
- ,("W.takeFileName x `isSuffixOf` x", property $ \(QFilePath x) -> W.takeFileName x `isSuffixOf` x)
+ ,("AFP_P.takeFileName (\"test/\") == (\"\")", property $ AFP_P.takeFileName ("test/") == (""))
+ ,("AFP_W.takeFileName (\"test/\") == (\"\")", property $ AFP_W.takeFileName ("test/") == (""))
+ ,("isSuffixOf (P.takeFileName x) x", property $ \(QFilePath x) -> isSuffixOf (P.takeFileName x) x)
+ ,("isSuffixOf (W.takeFileName x) x", property $ \(QFilePath x) -> isSuffixOf (W.takeFileName x) x)
+ ,("(\\(unPFP -> x) (unPFP -> y) -> SBS.isSuffixOf x y) (AFP_P.takeFileName x) x", property $ \(QFilePathAFP_P x) -> (\(unPFP -> x) (unPFP -> y) -> SBS.isSuffixOf x y) (AFP_P.takeFileName x) x)
+ ,("(\\(unWFP -> x) (unWFP -> y) -> SBS16.isSuffixOf x y) (AFP_W.takeFileName x) x", property $ \(QFilePathAFP_W x) -> (\(unWFP -> x) (unWFP -> y) -> SBS16.isSuffixOf x y) (AFP_W.takeFileName x) x)
,("P.takeFileName x == snd (P.splitFileName x)", property $ \(QFilePath x) -> P.takeFileName x == snd (P.splitFileName x))
,("W.takeFileName x == snd (W.splitFileName x)", property $ \(QFilePath x) -> W.takeFileName x == snd (W.splitFileName x))
+ ,("AFP_P.takeFileName x == snd (AFP_P.splitFileName x)", property $ \(QFilePathAFP_P x) -> AFP_P.takeFileName x == snd (AFP_P.splitFileName x))
+ ,("AFP_W.takeFileName x == snd (AFP_W.splitFileName x)", property $ \(QFilePathAFP_W x) -> AFP_W.takeFileName x == snd (AFP_W.splitFileName x))
,("P.takeFileName (P.replaceFileName x \"fred\") == \"fred\"", property $ \(QFilePathValidP x) -> P.takeFileName (P.replaceFileName x "fred") == "fred")
,("W.takeFileName (W.replaceFileName x \"fred\") == \"fred\"", property $ \(QFilePathValidW x) -> W.takeFileName (W.replaceFileName x "fred") == "fred")
+ ,("AFP_P.takeFileName (AFP_P.replaceFileName x (\"fred\")) == (\"fred\")", property $ \(QFilePathValidAFP_P x) -> AFP_P.takeFileName (AFP_P.replaceFileName x ("fred")) == ("fred"))
+ ,("AFP_W.takeFileName (AFP_W.replaceFileName x (\"fred\")) == (\"fred\")", property $ \(QFilePathValidAFP_W x) -> AFP_W.takeFileName (AFP_W.replaceFileName x ("fred")) == ("fred"))
,("P.takeFileName (x P.</> \"fred\") == \"fred\"", property $ \(QFilePathValidP x) -> P.takeFileName (x P.</> "fred") == "fred")
,("W.takeFileName (x W.</> \"fred\") == \"fred\"", property $ \(QFilePathValidW x) -> W.takeFileName (x W.</> "fred") == "fred")
+ ,("AFP_P.takeFileName (x AFP_P.</> (\"fred\")) == (\"fred\")", property $ \(QFilePathValidAFP_P x) -> AFP_P.takeFileName (x AFP_P.</> ("fred")) == ("fred"))
+ ,("AFP_W.takeFileName (x AFP_W.</> (\"fred\")) == (\"fred\")", property $ \(QFilePathValidAFP_W x) -> AFP_W.takeFileName (x AFP_W.</> ("fred")) == ("fred"))
,("P.isRelative (P.takeFileName x)", property $ \(QFilePathValidP x) -> P.isRelative (P.takeFileName x))
,("W.isRelative (W.takeFileName x)", property $ \(QFilePathValidW x) -> W.isRelative (W.takeFileName x))
+ ,("AFP_P.isRelative (AFP_P.takeFileName x)", property $ \(QFilePathValidAFP_P x) -> AFP_P.isRelative (AFP_P.takeFileName x))
+ ,("AFP_W.isRelative (AFP_W.takeFileName x)", property $ \(QFilePathValidAFP_W x) -> AFP_W.isRelative (AFP_W.takeFileName x))
,("P.takeBaseName \"/directory/file.ext\" == \"file\"", property $ P.takeBaseName "/directory/file.ext" == "file")
,("W.takeBaseName \"/directory/file.ext\" == \"file\"", property $ W.takeBaseName "/directory/file.ext" == "file")
+ ,("AFP_P.takeBaseName (\"/directory/file.ext\") == (\"file\")", property $ AFP_P.takeBaseName ("/directory/file.ext") == ("file"))
+ ,("AFP_W.takeBaseName (\"/directory/file.ext\") == (\"file\")", property $ AFP_W.takeBaseName ("/directory/file.ext") == ("file"))
,("P.takeBaseName \"file/test.txt\" == \"test\"", property $ P.takeBaseName "file/test.txt" == "test")
,("W.takeBaseName \"file/test.txt\" == \"test\"", property $ W.takeBaseName "file/test.txt" == "test")
+ ,("AFP_P.takeBaseName (\"file/test.txt\") == (\"test\")", property $ AFP_P.takeBaseName ("file/test.txt") == ("test"))
+ ,("AFP_W.takeBaseName (\"file/test.txt\") == (\"test\")", property $ AFP_W.takeBaseName ("file/test.txt") == ("test"))
,("P.takeBaseName \"dave.ext\" == \"dave\"", property $ P.takeBaseName "dave.ext" == "dave")
,("W.takeBaseName \"dave.ext\" == \"dave\"", property $ W.takeBaseName "dave.ext" == "dave")
+ ,("AFP_P.takeBaseName (\"dave.ext\") == (\"dave\")", property $ AFP_P.takeBaseName ("dave.ext") == ("dave"))
+ ,("AFP_W.takeBaseName (\"dave.ext\") == (\"dave\")", property $ AFP_W.takeBaseName ("dave.ext") == ("dave"))
,("P.takeBaseName \"\" == \"\"", property $ P.takeBaseName "" == "")
,("W.takeBaseName \"\" == \"\"", property $ W.takeBaseName "" == "")
+ ,("AFP_P.takeBaseName (\"\") == (\"\")", property $ AFP_P.takeBaseName ("") == (""))
+ ,("AFP_W.takeBaseName (\"\") == (\"\")", property $ AFP_W.takeBaseName ("") == (""))
,("P.takeBaseName \"test\" == \"test\"", property $ P.takeBaseName "test" == "test")
,("W.takeBaseName \"test\" == \"test\"", property $ W.takeBaseName "test" == "test")
+ ,("AFP_P.takeBaseName (\"test\") == (\"test\")", property $ AFP_P.takeBaseName ("test") == ("test"))
+ ,("AFP_W.takeBaseName (\"test\") == (\"test\")", property $ AFP_W.takeBaseName ("test") == ("test"))
,("P.takeBaseName (P.addTrailingPathSeparator x) == \"\"", property $ \(QFilePath x) -> P.takeBaseName (P.addTrailingPathSeparator x) == "")
,("W.takeBaseName (W.addTrailingPathSeparator x) == \"\"", property $ \(QFilePath x) -> W.takeBaseName (W.addTrailingPathSeparator x) == "")
+ ,("AFP_P.takeBaseName (AFP_P.addTrailingPathSeparator x) == (\"\")", property $ \(QFilePathAFP_P x) -> AFP_P.takeBaseName (AFP_P.addTrailingPathSeparator x) == (""))
+ ,("AFP_W.takeBaseName (AFP_W.addTrailingPathSeparator x) == (\"\")", property $ \(QFilePathAFP_W x) -> AFP_W.takeBaseName (AFP_W.addTrailingPathSeparator x) == (""))
,("P.takeBaseName \"file/file.tar.gz\" == \"file.tar\"", property $ P.takeBaseName "file/file.tar.gz" == "file.tar")
,("W.takeBaseName \"file/file.tar.gz\" == \"file.tar\"", property $ W.takeBaseName "file/file.tar.gz" == "file.tar")
+ ,("AFP_P.takeBaseName (\"file/file.tar.gz\") == (\"file.tar\")", property $ AFP_P.takeBaseName ("file/file.tar.gz") == ("file.tar"))
+ ,("AFP_W.takeBaseName (\"file/file.tar.gz\") == (\"file.tar\")", property $ AFP_W.takeBaseName ("file/file.tar.gz") == ("file.tar"))
,("P.replaceBaseName \"/directory/other.ext\" \"file\" == \"/directory/file.ext\"", property $ P.replaceBaseName "/directory/other.ext" "file" == "/directory/file.ext")
,("W.replaceBaseName \"/directory/other.ext\" \"file\" == \"/directory/file.ext\"", property $ W.replaceBaseName "/directory/other.ext" "file" == "/directory/file.ext")
+ ,("AFP_P.replaceBaseName (\"/directory/other.ext\") (\"file\") == (\"/directory/file.ext\")", property $ AFP_P.replaceBaseName ("/directory/other.ext") ("file") == ("/directory/file.ext"))
+ ,("AFP_W.replaceBaseName (\"/directory/other.ext\") (\"file\") == (\"/directory/file.ext\")", property $ AFP_W.replaceBaseName ("/directory/other.ext") ("file") == ("/directory/file.ext"))
,("P.replaceBaseName \"file/test.txt\" \"bob\" == \"file/bob.txt\"", property $ P.replaceBaseName "file/test.txt" "bob" == "file/bob.txt")
,("W.replaceBaseName \"file/test.txt\" \"bob\" == \"file/bob.txt\"", property $ W.replaceBaseName "file/test.txt" "bob" == "file/bob.txt")
+ ,("AFP_P.replaceBaseName (\"file/test.txt\") (\"bob\") == (\"file/bob.txt\")", property $ AFP_P.replaceBaseName ("file/test.txt") ("bob") == ("file/bob.txt"))
+ ,("AFP_W.replaceBaseName (\"file/test.txt\") (\"bob\") == (\"file/bob.txt\")", property $ AFP_W.replaceBaseName ("file/test.txt") ("bob") == ("file/bob.txt"))
,("P.replaceBaseName \"fred\" \"bill\" == \"bill\"", property $ P.replaceBaseName "fred" "bill" == "bill")
,("W.replaceBaseName \"fred\" \"bill\" == \"bill\"", property $ W.replaceBaseName "fred" "bill" == "bill")
+ ,("AFP_P.replaceBaseName (\"fred\") (\"bill\") == (\"bill\")", property $ AFP_P.replaceBaseName ("fred") ("bill") == ("bill"))
+ ,("AFP_W.replaceBaseName (\"fred\") (\"bill\") == (\"bill\")", property $ AFP_W.replaceBaseName ("fred") ("bill") == ("bill"))
,("P.replaceBaseName \"/dave/fred/bob.gz.tar\" \"new\" == \"/dave/fred/new.tar\"", property $ P.replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar")
,("W.replaceBaseName \"/dave/fred/bob.gz.tar\" \"new\" == \"/dave/fred/new.tar\"", property $ W.replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar")
+ ,("AFP_P.replaceBaseName (\"/dave/fred/bob.gz.tar\") (\"new\") == (\"/dave/fred/new.tar\")", property $ AFP_P.replaceBaseName ("/dave/fred/bob.gz.tar") ("new") == ("/dave/fred/new.tar"))
+ ,("AFP_W.replaceBaseName (\"/dave/fred/bob.gz.tar\") (\"new\") == (\"/dave/fred/new.tar\")", property $ AFP_W.replaceBaseName ("/dave/fred/bob.gz.tar") ("new") == ("/dave/fred/new.tar"))
,("P.replaceBaseName x (P.takeBaseName x) == x", property $ \(QFilePathValidP x) -> P.replaceBaseName x (P.takeBaseName x) == x)
,("W.replaceBaseName x (W.takeBaseName x) == x", property $ \(QFilePathValidW x) -> W.replaceBaseName x (W.takeBaseName x) == x)
+ ,("AFP_P.replaceBaseName x (AFP_P.takeBaseName x) == x", property $ \(QFilePathValidAFP_P x) -> AFP_P.replaceBaseName x (AFP_P.takeBaseName x) == x)
+ ,("AFP_W.replaceBaseName x (AFP_W.takeBaseName x) == x", property $ \(QFilePathValidAFP_W x) -> AFP_W.replaceBaseName x (AFP_W.takeBaseName x) == x)
,("P.hasTrailingPathSeparator \"test\" == False", property $ P.hasTrailingPathSeparator "test" == False)
,("W.hasTrailingPathSeparator \"test\" == False", property $ W.hasTrailingPathSeparator "test" == False)
+ ,("AFP_P.hasTrailingPathSeparator (\"test\") == False", property $ AFP_P.hasTrailingPathSeparator ("test") == False)
+ ,("AFP_W.hasTrailingPathSeparator (\"test\") == False", property $ AFP_W.hasTrailingPathSeparator ("test") == False)
,("P.hasTrailingPathSeparator \"test/\" == True", property $ P.hasTrailingPathSeparator "test/" == True)
,("W.hasTrailingPathSeparator \"test/\" == True", property $ W.hasTrailingPathSeparator "test/" == True)
+ ,("AFP_P.hasTrailingPathSeparator (\"test/\") == True", property $ AFP_P.hasTrailingPathSeparator ("test/") == True)
+ ,("AFP_W.hasTrailingPathSeparator (\"test/\") == True", property $ AFP_W.hasTrailingPathSeparator ("test/") == True)
,("P.hasTrailingPathSeparator (P.addTrailingPathSeparator x)", property $ \(QFilePath x) -> P.hasTrailingPathSeparator (P.addTrailingPathSeparator x))
,("W.hasTrailingPathSeparator (W.addTrailingPathSeparator x)", property $ \(QFilePath x) -> W.hasTrailingPathSeparator (W.addTrailingPathSeparator x))
+ ,("AFP_P.hasTrailingPathSeparator (AFP_P.addTrailingPathSeparator x)", property $ \(QFilePathAFP_P x) -> AFP_P.hasTrailingPathSeparator (AFP_P.addTrailingPathSeparator x))
+ ,("AFP_W.hasTrailingPathSeparator (AFP_W.addTrailingPathSeparator x)", property $ \(QFilePathAFP_W x) -> AFP_W.hasTrailingPathSeparator (AFP_W.addTrailingPathSeparator x))
,("P.hasTrailingPathSeparator x ==> P.addTrailingPathSeparator x == x", property $ \(QFilePath x) -> P.hasTrailingPathSeparator x ==> P.addTrailingPathSeparator x == x)
,("W.hasTrailingPathSeparator x ==> W.addTrailingPathSeparator x == x", property $ \(QFilePath x) -> W.hasTrailingPathSeparator x ==> W.addTrailingPathSeparator x == x)
+ ,("AFP_P.hasTrailingPathSeparator x ==> AFP_P.addTrailingPathSeparator x == x", property $ \(QFilePathAFP_P x) -> AFP_P.hasTrailingPathSeparator x ==> AFP_P.addTrailingPathSeparator x == x)
+ ,("AFP_W.hasTrailingPathSeparator x ==> AFP_W.addTrailingPathSeparator x == x", property $ \(QFilePathAFP_W x) -> AFP_W.hasTrailingPathSeparator x ==> AFP_W.addTrailingPathSeparator x == x)
,("P.addTrailingPathSeparator \"test/rest\" == \"test/rest/\"", property $ P.addTrailingPathSeparator "test/rest" == "test/rest/")
+ ,("AFP_P.addTrailingPathSeparator (\"test/rest\") == (\"test/rest/\")", property $ AFP_P.addTrailingPathSeparator ("test/rest") == ("test/rest/"))
,("P.dropTrailingPathSeparator \"file/test/\" == \"file/test\"", property $ P.dropTrailingPathSeparator "file/test/" == "file/test")
,("W.dropTrailingPathSeparator \"file/test/\" == \"file/test\"", property $ W.dropTrailingPathSeparator "file/test/" == "file/test")
+ ,("AFP_P.dropTrailingPathSeparator (\"file/test/\") == (\"file/test\")", property $ AFP_P.dropTrailingPathSeparator ("file/test/") == ("file/test"))
+ ,("AFP_W.dropTrailingPathSeparator (\"file/test/\") == (\"file/test\")", property $ AFP_W.dropTrailingPathSeparator ("file/test/") == ("file/test"))
,("P.dropTrailingPathSeparator \"/\" == \"/\"", property $ P.dropTrailingPathSeparator "/" == "/")
,("W.dropTrailingPathSeparator \"/\" == \"/\"", property $ W.dropTrailingPathSeparator "/" == "/")
+ ,("AFP_P.dropTrailingPathSeparator (\"/\") == (\"/\")", property $ AFP_P.dropTrailingPathSeparator ("/") == ("/"))
+ ,("AFP_W.dropTrailingPathSeparator (\"/\") == (\"/\")", property $ AFP_W.dropTrailingPathSeparator ("/") == ("/"))
,("W.dropTrailingPathSeparator \"\\\\\" == \"\\\\\"", property $ W.dropTrailingPathSeparator "\\" == "\\")
+ ,("AFP_W.dropTrailingPathSeparator (\"\\\\\") == (\"\\\\\")", property $ AFP_W.dropTrailingPathSeparator ("\\") == ("\\"))
,("not (P.hasTrailingPathSeparator (P.dropTrailingPathSeparator x)) || P.isDrive x", property $ \(QFilePath x) -> not (P.hasTrailingPathSeparator (P.dropTrailingPathSeparator x)) || P.isDrive x)
+ ,("not (AFP_P.hasTrailingPathSeparator (AFP_P.dropTrailingPathSeparator x)) || AFP_P.isDrive x", property $ \(QFilePathAFP_P x) -> not (AFP_P.hasTrailingPathSeparator (AFP_P.dropTrailingPathSeparator x)) || AFP_P.isDrive x)
,("P.takeDirectory \"/directory/other.ext\" == \"/directory\"", property $ P.takeDirectory "/directory/other.ext" == "/directory")
,("W.takeDirectory \"/directory/other.ext\" == \"/directory\"", property $ W.takeDirectory "/directory/other.ext" == "/directory")
- ,("P.takeDirectory x `isPrefixOf` x || P.takeDirectory x == \".\"", property $ \(QFilePath x) -> P.takeDirectory x `isPrefixOf` x || P.takeDirectory x == ".")
- ,("W.takeDirectory x `isPrefixOf` x || W.takeDirectory x == \".\"", property $ \(QFilePath x) -> W.takeDirectory x `isPrefixOf` x || W.takeDirectory x == ".")
+ ,("AFP_P.takeDirectory (\"/directory/other.ext\") == (\"/directory\")", property $ AFP_P.takeDirectory ("/directory/other.ext") == ("/directory"))
+ ,("AFP_W.takeDirectory (\"/directory/other.ext\") == (\"/directory\")", property $ AFP_W.takeDirectory ("/directory/other.ext") == ("/directory"))
+ ,("isPrefixOf (P.takeDirectory x) x || P.takeDirectory x == \".\"", property $ \(QFilePath x) -> isPrefixOf (P.takeDirectory x) x || P.takeDirectory x == ".")
+ ,("isPrefixOf (W.takeDirectory x) x || W.takeDirectory x == \".\"", property $ \(QFilePath x) -> isPrefixOf (W.takeDirectory x) x || W.takeDirectory x == ".")
+ ,("(\\(unPFP -> x) (unPFP -> y) -> SBS.isPrefixOf x y) (AFP_P.takeDirectory x) x || AFP_P.takeDirectory x == (\".\")", property $ \(QFilePathAFP_P x) -> (\(unPFP -> x) (unPFP -> y) -> SBS.isPrefixOf x y) (AFP_P.takeDirectory x) x || AFP_P.takeDirectory x == ("."))
+ ,("(\\(unWFP -> x) (unWFP -> y) -> SBS16.isPrefixOf x y) (AFP_W.takeDirectory x) x || AFP_W.takeDirectory x == (\".\")", property $ \(QFilePathAFP_W x) -> (\(unWFP -> x) (unWFP -> y) -> SBS16.isPrefixOf x y) (AFP_W.takeDirectory x) x || AFP_W.takeDirectory x == ("."))
,("P.takeDirectory \"foo\" == \".\"", property $ P.takeDirectory "foo" == ".")
,("W.takeDirectory \"foo\" == \".\"", property $ W.takeDirectory "foo" == ".")
+ ,("AFP_P.takeDirectory (\"foo\") == (\".\")", property $ AFP_P.takeDirectory ("foo") == ("."))
+ ,("AFP_W.takeDirectory (\"foo\") == (\".\")", property $ AFP_W.takeDirectory ("foo") == ("."))
,("P.takeDirectory \"/\" == \"/\"", property $ P.takeDirectory "/" == "/")
,("W.takeDirectory \"/\" == \"/\"", property $ W.takeDirectory "/" == "/")
+ ,("AFP_P.takeDirectory (\"/\") == (\"/\")", property $ AFP_P.takeDirectory ("/") == ("/"))
+ ,("AFP_W.takeDirectory (\"/\") == (\"/\")", property $ AFP_W.takeDirectory ("/") == ("/"))
,("P.takeDirectory \"/foo\" == \"/\"", property $ P.takeDirectory "/foo" == "/")
,("W.takeDirectory \"/foo\" == \"/\"", property $ W.takeDirectory "/foo" == "/")
+ ,("AFP_P.takeDirectory (\"/foo\") == (\"/\")", property $ AFP_P.takeDirectory ("/foo") == ("/"))
+ ,("AFP_W.takeDirectory (\"/foo\") == (\"/\")", property $ AFP_W.takeDirectory ("/foo") == ("/"))
,("P.takeDirectory \"/foo/bar/baz\" == \"/foo/bar\"", property $ P.takeDirectory "/foo/bar/baz" == "/foo/bar")
,("W.takeDirectory \"/foo/bar/baz\" == \"/foo/bar\"", property $ W.takeDirectory "/foo/bar/baz" == "/foo/bar")
+ ,("AFP_P.takeDirectory (\"/foo/bar/baz\") == (\"/foo/bar\")", property $ AFP_P.takeDirectory ("/foo/bar/baz") == ("/foo/bar"))
+ ,("AFP_W.takeDirectory (\"/foo/bar/baz\") == (\"/foo/bar\")", property $ AFP_W.takeDirectory ("/foo/bar/baz") == ("/foo/bar"))
,("P.takeDirectory \"/foo/bar/baz/\" == \"/foo/bar/baz\"", property $ P.takeDirectory "/foo/bar/baz/" == "/foo/bar/baz")
,("W.takeDirectory \"/foo/bar/baz/\" == \"/foo/bar/baz\"", property $ W.takeDirectory "/foo/bar/baz/" == "/foo/bar/baz")
+ ,("AFP_P.takeDirectory (\"/foo/bar/baz/\") == (\"/foo/bar/baz\")", property $ AFP_P.takeDirectory ("/foo/bar/baz/") == ("/foo/bar/baz"))
+ ,("AFP_W.takeDirectory (\"/foo/bar/baz/\") == (\"/foo/bar/baz\")", property $ AFP_W.takeDirectory ("/foo/bar/baz/") == ("/foo/bar/baz"))
,("P.takeDirectory \"foo/bar/baz\" == \"foo/bar\"", property $ P.takeDirectory "foo/bar/baz" == "foo/bar")
,("W.takeDirectory \"foo/bar/baz\" == \"foo/bar\"", property $ W.takeDirectory "foo/bar/baz" == "foo/bar")
+ ,("AFP_P.takeDirectory (\"foo/bar/baz\") == (\"foo/bar\")", property $ AFP_P.takeDirectory ("foo/bar/baz") == ("foo/bar"))
+ ,("AFP_W.takeDirectory (\"foo/bar/baz\") == (\"foo/bar\")", property $ AFP_W.takeDirectory ("foo/bar/baz") == ("foo/bar"))
,("W.takeDirectory \"foo\\\\bar\" == \"foo\"", property $ W.takeDirectory "foo\\bar" == "foo")
+ ,("AFP_W.takeDirectory (\"foo\\\\bar\") == (\"foo\")", property $ AFP_W.takeDirectory ("foo\\bar") == ("foo"))
,("W.takeDirectory \"foo\\\\bar\\\\\\\\\" == \"foo\\\\bar\"", property $ W.takeDirectory "foo\\bar\\\\" == "foo\\bar")
+ ,("AFP_W.takeDirectory (\"foo\\\\bar\\\\\\\\\") == (\"foo\\\\bar\")", property $ AFP_W.takeDirectory ("foo\\bar\\\\") == ("foo\\bar"))
,("W.takeDirectory \"C:\\\\\" == \"C:\\\\\"", property $ W.takeDirectory "C:\\" == "C:\\")
+ ,("AFP_W.takeDirectory (\"C:\\\\\") == (\"C:\\\\\")", property $ AFP_W.takeDirectory ("C:\\") == ("C:\\"))
,("P.replaceDirectory \"root/file.ext\" \"/directory/\" == \"/directory/file.ext\"", property $ P.replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext")
,("W.replaceDirectory \"root/file.ext\" \"/directory/\" == \"/directory/file.ext\"", property $ W.replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext")
+ ,("AFP_P.replaceDirectory (\"root/file.ext\") (\"/directory/\") == (\"/directory/file.ext\")", property $ AFP_P.replaceDirectory ("root/file.ext") ("/directory/") == ("/directory/file.ext"))
+ ,("AFP_W.replaceDirectory (\"root/file.ext\") (\"/directory/\") == (\"/directory/file.ext\")", property $ AFP_W.replaceDirectory ("root/file.ext") ("/directory/") == ("/directory/file.ext"))
,("P.replaceDirectory x (P.takeDirectory x) `P.equalFilePath` x", property $ \(QFilePathValidP x) -> P.replaceDirectory x (P.takeDirectory x) `P.equalFilePath` x)
,("W.replaceDirectory x (W.takeDirectory x) `W.equalFilePath` x", property $ \(QFilePathValidW x) -> W.replaceDirectory x (W.takeDirectory x) `W.equalFilePath` x)
+ ,("AFP_P.replaceDirectory x (AFP_P.takeDirectory x) `AFP_P.equalFilePath` x", property $ \(QFilePathValidAFP_P x) -> AFP_P.replaceDirectory x (AFP_P.takeDirectory x) `AFP_P.equalFilePath` x)
+ ,("AFP_W.replaceDirectory x (AFP_W.takeDirectory x) `AFP_W.equalFilePath` x", property $ \(QFilePathValidAFP_W x) -> AFP_W.replaceDirectory x (AFP_W.takeDirectory x) `AFP_W.equalFilePath` x)
,("\"/directory\" P.</> \"file.ext\" == \"/directory/file.ext\"", property $ "/directory" P.</> "file.ext" == "/directory/file.ext")
+ ,("(\"/directory\") AFP_P.</> (\"file.ext\") == (\"/directory/file.ext\")", property $ ("/directory") AFP_P.</> ("file.ext") == ("/directory/file.ext"))
,("\"/directory\" W.</> \"file.ext\" == \"/directory\\\\file.ext\"", property $ "/directory" W.</> "file.ext" == "/directory\\file.ext")
+ ,("(\"/directory\") AFP_W.</> (\"file.ext\") == (\"/directory\\\\file.ext\")", property $ ("/directory") AFP_W.</> ("file.ext") == ("/directory\\file.ext"))
,("\"directory\" P.</> \"/file.ext\" == \"/file.ext\"", property $ "directory" P.</> "/file.ext" == "/file.ext")
,("\"directory\" W.</> \"/file.ext\" == \"/file.ext\"", property $ "directory" W.</> "/file.ext" == "/file.ext")
+ ,("(\"directory\") AFP_P.</> (\"/file.ext\") == (\"/file.ext\")", property $ ("directory") AFP_P.</> ("/file.ext") == ("/file.ext"))
+ ,("(\"directory\") AFP_W.</> (\"/file.ext\") == (\"/file.ext\")", property $ ("directory") AFP_W.</> ("/file.ext") == ("/file.ext"))
,("(P.takeDirectory x P.</> P.takeFileName x) `P.equalFilePath` x", property $ \(QFilePathValidP x) -> (P.takeDirectory x P.</> P.takeFileName x) `P.equalFilePath` x)
,("(W.takeDirectory x W.</> W.takeFileName x) `W.equalFilePath` x", property $ \(QFilePathValidW x) -> (W.takeDirectory x W.</> W.takeFileName x) `W.equalFilePath` x)
+ ,("(AFP_P.takeDirectory x AFP_P.</> AFP_P.takeFileName x) `AFP_P.equalFilePath` x", property $ \(QFilePathValidAFP_P x) -> (AFP_P.takeDirectory x AFP_P.</> AFP_P.takeFileName x) `AFP_P.equalFilePath` x)
+ ,("(AFP_W.takeDirectory x AFP_W.</> AFP_W.takeFileName x) `AFP_W.equalFilePath` x", property $ \(QFilePathValidAFP_W x) -> (AFP_W.takeDirectory x AFP_W.</> AFP_W.takeFileName x) `AFP_W.equalFilePath` x)
,("\"/\" P.</> \"test\" == \"/test\"", property $ "/" P.</> "test" == "/test")
+ ,("(\"/\") AFP_P.</> (\"test\") == (\"/test\")", property $ ("/") AFP_P.</> ("test") == ("/test"))
,("\"home\" P.</> \"bob\" == \"home/bob\"", property $ "home" P.</> "bob" == "home/bob")
+ ,("(\"home\") AFP_P.</> (\"bob\") == (\"home/bob\")", property $ ("home") AFP_P.</> ("bob") == ("home/bob"))
,("\"x:\" P.</> \"foo\" == \"x:/foo\"", property $ "x:" P.</> "foo" == "x:/foo")
+ ,("(\"x:\") AFP_P.</> (\"foo\") == (\"x:/foo\")", property $ ("x:") AFP_P.</> ("foo") == ("x:/foo"))
,("\"C:\\\\foo\" W.</> \"bar\" == \"C:\\\\foo\\\\bar\"", property $ "C:\\foo" W.</> "bar" == "C:\\foo\\bar")
+ ,("(\"C:\\\\foo\") AFP_W.</> (\"bar\") == (\"C:\\\\foo\\\\bar\")", property $ ("C:\\foo") AFP_W.</> ("bar") == ("C:\\foo\\bar"))
,("\"home\" W.</> \"bob\" == \"home\\\\bob\"", property $ "home" W.</> "bob" == "home\\bob")
+ ,("(\"home\") AFP_W.</> (\"bob\") == (\"home\\\\bob\")", property $ ("home") AFP_W.</> ("bob") == ("home\\bob"))
,("\"home\" P.</> \"/bob\" == \"/bob\"", property $ "home" P.</> "/bob" == "/bob")
+ ,("(\"home\") AFP_P.</> (\"/bob\") == (\"/bob\")", property $ ("home") AFP_P.</> ("/bob") == ("/bob"))
,("\"home\" W.</> \"C:\\\\bob\" == \"C:\\\\bob\"", property $ "home" W.</> "C:\\bob" == "C:\\bob")
+ ,("(\"home\") AFP_W.</> (\"C:\\\\bob\") == (\"C:\\\\bob\")", property $ ("home") AFP_W.</> ("C:\\bob") == ("C:\\bob"))
,("\"home\" W.</> \"/bob\" == \"/bob\"", property $ "home" W.</> "/bob" == "/bob")
+ ,("(\"home\") AFP_W.</> (\"/bob\") == (\"/bob\")", property $ ("home") AFP_W.</> ("/bob") == ("/bob"))
,("\"home\" W.</> \"\\\\bob\" == \"\\\\bob\"", property $ "home" W.</> "\\bob" == "\\bob")
+ ,("(\"home\") AFP_W.</> (\"\\\\bob\") == (\"\\\\bob\")", property $ ("home") AFP_W.</> ("\\bob") == ("\\bob"))
,("\"C:\\\\home\" W.</> \"\\\\bob\" == \"\\\\bob\"", property $ "C:\\home" W.</> "\\bob" == "\\bob")
+ ,("(\"C:\\\\home\") AFP_W.</> (\"\\\\bob\") == (\"\\\\bob\")", property $ ("C:\\home") AFP_W.</> ("\\bob") == ("\\bob"))
,("\"D:\\\\foo\" W.</> \"C:bar\" == \"C:bar\"", property $ "D:\\foo" W.</> "C:bar" == "C:bar")
+ ,("(\"D:\\\\foo\") AFP_W.</> (\"C:bar\") == (\"C:bar\")", property $ ("D:\\foo") AFP_W.</> ("C:bar") == ("C:bar"))
,("\"C:\\\\foo\" W.</> \"C:bar\" == \"C:bar\"", property $ "C:\\foo" W.</> "C:bar" == "C:bar")
+ ,("(\"C:\\\\foo\") AFP_W.</> (\"C:bar\") == (\"C:bar\")", property $ ("C:\\foo") AFP_W.</> ("C:bar") == ("C:bar"))
,("P.splitPath \"/directory/file.ext\" == [\"/\", \"directory/\", \"file.ext\"]", property $ P.splitPath "/directory/file.ext" == ["/", "directory/", "file.ext"])
,("W.splitPath \"/directory/file.ext\" == [\"/\", \"directory/\", \"file.ext\"]", property $ W.splitPath "/directory/file.ext" == ["/", "directory/", "file.ext"])
+ ,("AFP_P.splitPath (\"/directory/file.ext\") == [(\"/\"), (\"directory/\"), (\"file.ext\")]", property $ AFP_P.splitPath ("/directory/file.ext") == [("/"), ("directory/"), ("file.ext")])
+ ,("AFP_W.splitPath (\"/directory/file.ext\") == [(\"/\"), (\"directory/\"), (\"file.ext\")]", property $ AFP_W.splitPath ("/directory/file.ext") == [("/"), ("directory/"), ("file.ext")])
,("concat (P.splitPath x) == x", property $ \(QFilePath x) -> concat (P.splitPath x) == x)
,("concat (W.splitPath x) == x", property $ \(QFilePath x) -> concat (W.splitPath x) == x)
+ ,("(PS . SBS.concat . fmap unPFP) (AFP_P.splitPath x) == x", property $ \(QFilePathAFP_P x) -> (PS . SBS.concat . fmap unPFP) (AFP_P.splitPath x) == x)
+ ,("(WS . SBS16.concat . fmap unWFP) (AFP_W.splitPath x) == x", property $ \(QFilePathAFP_W x) -> (WS . SBS16.concat . fmap unWFP) (AFP_W.splitPath x) == x)
,("P.splitPath \"test//item/\" == [\"test//\", \"item/\"]", property $ P.splitPath "test//item/" == ["test//", "item/"])
,("W.splitPath \"test//item/\" == [\"test//\", \"item/\"]", property $ W.splitPath "test//item/" == ["test//", "item/"])
+ ,("AFP_P.splitPath (\"test//item/\") == [(\"test//\"), (\"item/\")]", property $ AFP_P.splitPath ("test//item/") == [("test//"), ("item/")])
+ ,("AFP_W.splitPath (\"test//item/\") == [(\"test//\"), (\"item/\")]", property $ AFP_W.splitPath ("test//item/") == [("test//"), ("item/")])
,("P.splitPath \"test/item/file\" == [\"test/\", \"item/\", \"file\"]", property $ P.splitPath "test/item/file" == ["test/", "item/", "file"])
,("W.splitPath \"test/item/file\" == [\"test/\", \"item/\", \"file\"]", property $ W.splitPath "test/item/file" == ["test/", "item/", "file"])
+ ,("AFP_P.splitPath (\"test/item/file\") == [(\"test/\"), (\"item/\"), (\"file\")]", property $ AFP_P.splitPath ("test/item/file") == [("test/"), ("item/"), ("file")])
+ ,("AFP_W.splitPath (\"test/item/file\") == [(\"test/\"), (\"item/\"), (\"file\")]", property $ AFP_W.splitPath ("test/item/file") == [("test/"), ("item/"), ("file")])
,("P.splitPath \"\" == []", property $ P.splitPath "" == [])
,("W.splitPath \"\" == []", property $ W.splitPath "" == [])
+ ,("AFP_P.splitPath (\"\") == []", property $ AFP_P.splitPath ("") == [])
+ ,("AFP_W.splitPath (\"\") == []", property $ AFP_W.splitPath ("") == [])
,("W.splitPath \"c:\\\\test\\\\path\" == [\"c:\\\\\", \"test\\\\\", \"path\"]", property $ W.splitPath "c:\\test\\path" == ["c:\\", "test\\", "path"])
+ ,("AFP_W.splitPath (\"c:\\\\test\\\\path\") == [(\"c:\\\\\"), (\"test\\\\\"), (\"path\")]", property $ AFP_W.splitPath ("c:\\test\\path") == [("c:\\"), ("test\\"), ("path")])
,("P.splitPath \"/file/test\" == [\"/\", \"file/\", \"test\"]", property $ P.splitPath "/file/test" == ["/", "file/", "test"])
+ ,("AFP_P.splitPath (\"/file/test\") == [(\"/\"), (\"file/\"), (\"test\")]", property $ AFP_P.splitPath ("/file/test") == [("/"), ("file/"), ("test")])
,("P.splitDirectories \"/directory/file.ext\" == [\"/\", \"directory\", \"file.ext\"]", property $ P.splitDirectories "/directory/file.ext" == ["/", "directory", "file.ext"])
,("W.splitDirectories \"/directory/file.ext\" == [\"/\", \"directory\", \"file.ext\"]", property $ W.splitDirectories "/directory/file.ext" == ["/", "directory", "file.ext"])
+ ,("AFP_P.splitDirectories (\"/directory/file.ext\") == [(\"/\"), (\"directory\"), (\"file.ext\")]", property $ AFP_P.splitDirectories ("/directory/file.ext") == [("/"), ("directory"), ("file.ext")])
+ ,("AFP_W.splitDirectories (\"/directory/file.ext\") == [(\"/\"), (\"directory\"), (\"file.ext\")]", property $ AFP_W.splitDirectories ("/directory/file.ext") == [("/"), ("directory"), ("file.ext")])
,("P.splitDirectories \"test/file\" == [\"test\", \"file\"]", property $ P.splitDirectories "test/file" == ["test", "file"])
,("W.splitDirectories \"test/file\" == [\"test\", \"file\"]", property $ W.splitDirectories "test/file" == ["test", "file"])
+ ,("AFP_P.splitDirectories (\"test/file\") == [(\"test\"), (\"file\")]", property $ AFP_P.splitDirectories ("test/file") == [("test"), ("file")])
+ ,("AFP_W.splitDirectories (\"test/file\") == [(\"test\"), (\"file\")]", property $ AFP_W.splitDirectories ("test/file") == [("test"), ("file")])
,("P.splitDirectories \"/test/file\" == [\"/\", \"test\", \"file\"]", property $ P.splitDirectories "/test/file" == ["/", "test", "file"])
,("W.splitDirectories \"/test/file\" == [\"/\", \"test\", \"file\"]", property $ W.splitDirectories "/test/file" == ["/", "test", "file"])
+ ,("AFP_P.splitDirectories (\"/test/file\") == [(\"/\"), (\"test\"), (\"file\")]", property $ AFP_P.splitDirectories ("/test/file") == [("/"), ("test"), ("file")])
+ ,("AFP_W.splitDirectories (\"/test/file\") == [(\"/\"), (\"test\"), (\"file\")]", property $ AFP_W.splitDirectories ("/test/file") == [("/"), ("test"), ("file")])
,("W.splitDirectories \"C:\\\\test\\\\file\" == [\"C:\\\\\", \"test\", \"file\"]", property $ W.splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"])
+ ,("AFP_W.splitDirectories (\"C:\\\\test\\\\file\") == [(\"C:\\\\\"), (\"test\"), (\"file\")]", property $ AFP_W.splitDirectories ("C:\\test\\file") == [("C:\\"), ("test"), ("file")])
,("P.joinPath (P.splitDirectories x) `P.equalFilePath` x", property $ \(QFilePathValidP x) -> P.joinPath (P.splitDirectories x) `P.equalFilePath` x)
,("W.joinPath (W.splitDirectories x) `W.equalFilePath` x", property $ \(QFilePathValidW x) -> W.joinPath (W.splitDirectories x) `W.equalFilePath` x)
+ ,("AFP_P.joinPath (AFP_P.splitDirectories x) `AFP_P.equalFilePath` x", property $ \(QFilePathValidAFP_P x) -> AFP_P.joinPath (AFP_P.splitDirectories x) `AFP_P.equalFilePath` x)
+ ,("AFP_W.joinPath (AFP_W.splitDirectories x) `AFP_W.equalFilePath` x", property $ \(QFilePathValidAFP_W x) -> AFP_W.joinPath (AFP_W.splitDirectories x) `AFP_W.equalFilePath` x)
,("P.splitDirectories \"\" == []", property $ P.splitDirectories "" == [])
,("W.splitDirectories \"\" == []", property $ W.splitDirectories "" == [])
+ ,("AFP_P.splitDirectories (\"\") == []", property $ AFP_P.splitDirectories ("") == [])
+ ,("AFP_W.splitDirectories (\"\") == []", property $ AFP_W.splitDirectories ("") == [])
,("W.splitDirectories \"C:\\\\test\\\\\\\\\\\\file\" == [\"C:\\\\\", \"test\", \"file\"]", property $ W.splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"])
+ ,("AFP_W.splitDirectories (\"C:\\\\test\\\\\\\\\\\\file\") == [(\"C:\\\\\"), (\"test\"), (\"file\")]", property $ AFP_W.splitDirectories ("C:\\test\\\\\\file") == [("C:\\"), ("test"), ("file")])
,("P.splitDirectories \"/test///file\" == [\"/\", \"test\", \"file\"]", property $ P.splitDirectories "/test///file" == ["/", "test", "file"])
,("W.splitDirectories \"/test///file\" == [\"/\", \"test\", \"file\"]", property $ W.splitDirectories "/test///file" == ["/", "test", "file"])
- ,("P.joinPath a == foldr (P.</>) \"\" a", property $ \a -> P.joinPath a == foldr (P.</>) "" a)
- ,("W.joinPath a == foldr (W.</>) \"\" a", property $ \a -> W.joinPath a == foldr (W.</>) "" a)
+ ,("AFP_P.splitDirectories (\"/test///file\") == [(\"/\"), (\"test\"), (\"file\")]", property $ AFP_P.splitDirectories ("/test///file") == [("/"), ("test"), ("file")])
+ ,("AFP_W.splitDirectories (\"/test///file\") == [(\"/\"), (\"test\"), (\"file\")]", property $ AFP_W.splitDirectories ("/test///file") == [("/"), ("test"), ("file")])
+ ,("P.joinPath z == foldr (P.</>) \"\" z", property $ \z -> P.joinPath z == foldr (P.</>) "" z)
+ ,("W.joinPath z == foldr (W.</>) \"\" z", property $ \z -> W.joinPath z == foldr (W.</>) "" z)
+ ,("AFP_P.joinPath z == foldr (AFP_P.</>) (\"\") z", property $ \(QFilePathsAFP_P z) -> AFP_P.joinPath z == foldr (AFP_P.</>) ("") z)
+ ,("AFP_W.joinPath z == foldr (AFP_W.</>) (\"\") z", property $ \(QFilePathsAFP_W z) -> AFP_W.joinPath z == foldr (AFP_W.</>) ("") z)
,("P.joinPath [\"/\", \"directory/\", \"file.ext\"] == \"/directory/file.ext\"", property $ P.joinPath ["/", "directory/", "file.ext"] == "/directory/file.ext")
,("W.joinPath [\"/\", \"directory/\", \"file.ext\"] == \"/directory/file.ext\"", property $ W.joinPath ["/", "directory/", "file.ext"] == "/directory/file.ext")
+ ,("AFP_P.joinPath [(\"/\"), (\"directory/\"), (\"file.ext\")] == (\"/directory/file.ext\")", property $ AFP_P.joinPath [("/"), ("directory/"), ("file.ext")] == ("/directory/file.ext"))
+ ,("AFP_W.joinPath [(\"/\"), (\"directory/\"), (\"file.ext\")] == (\"/directory/file.ext\")", property $ AFP_W.joinPath [("/"), ("directory/"), ("file.ext")] == ("/directory/file.ext"))
,("P.joinPath (P.splitPath x) == x", property $ \(QFilePathValidP x) -> P.joinPath (P.splitPath x) == x)
,("W.joinPath (W.splitPath x) == x", property $ \(QFilePathValidW x) -> W.joinPath (W.splitPath x) == x)
+ ,("AFP_P.joinPath (AFP_P.splitPath x) == x", property $ \(QFilePathValidAFP_P x) -> AFP_P.joinPath (AFP_P.splitPath x) == x)
+ ,("AFP_W.joinPath (AFP_W.splitPath x) == x", property $ \(QFilePathValidAFP_W x) -> AFP_W.joinPath (AFP_W.splitPath x) == x)
,("P.joinPath [] == \"\"", property $ P.joinPath [] == "")
,("W.joinPath [] == \"\"", property $ W.joinPath [] == "")
+ ,("AFP_P.joinPath [] == (\"\")", property $ AFP_P.joinPath [] == (""))
+ ,("AFP_W.joinPath [] == (\"\")", property $ AFP_W.joinPath [] == (""))
,("P.joinPath [\"test\", \"file\", \"path\"] == \"test/file/path\"", property $ P.joinPath ["test", "file", "path"] == "test/file/path")
+ ,("AFP_P.joinPath [(\"test\"), (\"file\"), (\"path\")] == (\"test/file/path\")", property $ AFP_P.joinPath [("test"), ("file"), ("path")] == ("test/file/path"))
,("x == y ==> P.equalFilePath x y", property $ \(QFilePath x) (QFilePath y) -> x == y ==> P.equalFilePath x y)
,("x == y ==> W.equalFilePath x y", property $ \(QFilePath x) (QFilePath y) -> x == y ==> W.equalFilePath x y)
+ ,("x == y ==> AFP_P.equalFilePath x y", property $ \(QFilePathAFP_P x) (QFilePathAFP_P y) -> x == y ==> AFP_P.equalFilePath x y)
+ ,("x == y ==> AFP_W.equalFilePath x y", property $ \(QFilePathAFP_W x) (QFilePathAFP_W y) -> x == y ==> AFP_W.equalFilePath x y)
,("P.normalise x == P.normalise y ==> P.equalFilePath x y", property $ \(QFilePath x) (QFilePath y) -> P.normalise x == P.normalise y ==> P.equalFilePath x y)
,("W.normalise x == W.normalise y ==> W.equalFilePath x y", property $ \(QFilePath x) (QFilePath y) -> W.normalise x == W.normalise y ==> W.equalFilePath x y)
+ ,("AFP_P.normalise x == AFP_P.normalise y ==> AFP_P.equalFilePath x y", property $ \(QFilePathAFP_P x) (QFilePathAFP_P y) -> AFP_P.normalise x == AFP_P.normalise y ==> AFP_P.equalFilePath x y)
+ ,("AFP_W.normalise x == AFP_W.normalise y ==> AFP_W.equalFilePath x y", property $ \(QFilePathAFP_W x) (QFilePathAFP_W y) -> AFP_W.normalise x == AFP_W.normalise y ==> AFP_W.equalFilePath x y)
,("P.equalFilePath \"foo\" \"foo/\"", property $ P.equalFilePath "foo" "foo/")
,("W.equalFilePath \"foo\" \"foo/\"", property $ W.equalFilePath "foo" "foo/")
+ ,("AFP_P.equalFilePath (\"foo\") (\"foo/\")", property $ AFP_P.equalFilePath ("foo") ("foo/"))
+ ,("AFP_W.equalFilePath (\"foo\") (\"foo/\")", property $ AFP_W.equalFilePath ("foo") ("foo/"))
,("not (P.equalFilePath \"/a/../c\" \"/c\")", property $ not (P.equalFilePath "/a/../c" "/c"))
,("not (W.equalFilePath \"/a/../c\" \"/c\")", property $ not (W.equalFilePath "/a/../c" "/c"))
+ ,("not (AFP_P.equalFilePath (\"/a/../c\") (\"/c\"))", property $ not (AFP_P.equalFilePath ("/a/../c") ("/c")))
+ ,("not (AFP_W.equalFilePath (\"/a/../c\") (\"/c\"))", property $ not (AFP_W.equalFilePath ("/a/../c") ("/c")))
,("not (P.equalFilePath \"foo\" \"/foo\")", property $ not (P.equalFilePath "foo" "/foo"))
,("not (W.equalFilePath \"foo\" \"/foo\")", property $ not (W.equalFilePath "foo" "/foo"))
+ ,("not (AFP_P.equalFilePath (\"foo\") (\"/foo\"))", property $ not (AFP_P.equalFilePath ("foo") ("/foo")))
+ ,("not (AFP_W.equalFilePath (\"foo\") (\"/foo\"))", property $ not (AFP_W.equalFilePath ("foo") ("/foo")))
,("not (P.equalFilePath \"foo\" \"FOO\")", property $ not (P.equalFilePath "foo" "FOO"))
+ ,("not (AFP_P.equalFilePath (\"foo\") (\"FOO\"))", property $ not (AFP_P.equalFilePath ("foo") ("FOO")))
,("W.equalFilePath \"foo\" \"FOO\"", property $ W.equalFilePath "foo" "FOO")
+ ,("AFP_W.equalFilePath (\"foo\") (\"FOO\")", property $ AFP_W.equalFilePath ("foo") ("FOO"))
,("not (W.equalFilePath \"C:\" \"C:/\")", property $ not (W.equalFilePath "C:" "C:/"))
+ ,("not (AFP_W.equalFilePath (\"C:\") (\"C:/\"))", property $ not (AFP_W.equalFilePath ("C:") ("C:/")))
,("P.makeRelative \"/directory\" \"/directory/file.ext\" == \"file.ext\"", property $ P.makeRelative "/directory" "/directory/file.ext" == "file.ext")
,("W.makeRelative \"/directory\" \"/directory/file.ext\" == \"file.ext\"", property $ W.makeRelative "/directory" "/directory/file.ext" == "file.ext")
+ ,("AFP_P.makeRelative (\"/directory\") (\"/directory/file.ext\") == (\"file.ext\")", property $ AFP_P.makeRelative ("/directory") ("/directory/file.ext") == ("file.ext"))
+ ,("AFP_W.makeRelative (\"/directory\") (\"/directory/file.ext\") == (\"file.ext\")", property $ AFP_W.makeRelative ("/directory") ("/directory/file.ext") == ("file.ext"))
,("P.makeRelative (P.takeDirectory x) x `P.equalFilePath` P.takeFileName x", property $ \(QFilePathValidP x) -> P.makeRelative (P.takeDirectory x) x `P.equalFilePath` P.takeFileName x)
,("W.makeRelative (W.takeDirectory x) x `W.equalFilePath` W.takeFileName x", property $ \(QFilePathValidW x) -> W.makeRelative (W.takeDirectory x) x `W.equalFilePath` W.takeFileName x)
+ ,("AFP_P.makeRelative (AFP_P.takeDirectory x) x `AFP_P.equalFilePath` AFP_P.takeFileName x", property $ \(QFilePathValidAFP_P x) -> AFP_P.makeRelative (AFP_P.takeDirectory x) x `AFP_P.equalFilePath` AFP_P.takeFileName x)
+ ,("AFP_W.makeRelative (AFP_W.takeDirectory x) x `AFP_W.equalFilePath` AFP_W.takeFileName x", property $ \(QFilePathValidAFP_W x) -> AFP_W.makeRelative (AFP_W.takeDirectory x) x `AFP_W.equalFilePath` AFP_W.takeFileName x)
,("P.makeRelative x x == \".\"", property $ \(QFilePath x) -> P.makeRelative x x == ".")
,("W.makeRelative x x == \".\"", property $ \(QFilePath x) -> W.makeRelative x x == ".")
+ ,("AFP_P.makeRelative x x == (\".\")", property $ \(QFilePathAFP_P x) -> AFP_P.makeRelative x x == ("."))
+ ,("AFP_W.makeRelative x x == (\".\")", property $ \(QFilePathAFP_W x) -> AFP_W.makeRelative x x == ("."))
,("P.equalFilePath x y || (P.isRelative x && P.makeRelative y x == x) || P.equalFilePath (y P.</> P.makeRelative y x) x", property $ \(QFilePathValidP x) (QFilePathValidP y) -> P.equalFilePath x y || (P.isRelative x && P.makeRelative y x == x) || P.equalFilePath (y P.</> P.makeRelative y x) x)
,("W.equalFilePath x y || (W.isRelative x && W.makeRelative y x == x) || W.equalFilePath (y W.</> W.makeRelative y x) x", property $ \(QFilePathValidW x) (QFilePathValidW y) -> W.equalFilePath x y || (W.isRelative x && W.makeRelative y x == x) || W.equalFilePath (y W.</> W.makeRelative y x) x)
+ ,("AFP_P.equalFilePath x y || (AFP_P.isRelative x && AFP_P.makeRelative y x == x) || AFP_P.equalFilePath (y AFP_P.</> AFP_P.makeRelative y x) x", property $ \(QFilePathValidAFP_P x) (QFilePathValidAFP_P y) -> AFP_P.equalFilePath x y || (AFP_P.isRelative x && AFP_P.makeRelative y x == x) || AFP_P.equalFilePath (y AFP_P.</> AFP_P.makeRelative y x) x)
+ ,("AFP_W.equalFilePath x y || (AFP_W.isRelative x && AFP_W.makeRelative y x == x) || AFP_W.equalFilePath (y AFP_W.</> AFP_W.makeRelative y x) x", property $ \(QFilePathValidAFP_W x) (QFilePathValidAFP_W y) -> AFP_W.equalFilePath x y || (AFP_W.isRelative x && AFP_W.makeRelative y x == x) || AFP_W.equalFilePath (y AFP_W.</> AFP_W.makeRelative y x) x)
,("W.makeRelative \"C:\\\\Home\" \"c:\\\\home\\\\bob\" == \"bob\"", property $ W.makeRelative "C:\\Home" "c:\\home\\bob" == "bob")
+ ,("AFP_W.makeRelative (\"C:\\\\Home\") (\"c:\\\\home\\\\bob\") == (\"bob\")", property $ AFP_W.makeRelative ("C:\\Home") ("c:\\home\\bob") == ("bob"))
,("W.makeRelative \"C:\\\\Home\" \"c:/home/bob\" == \"bob\"", property $ W.makeRelative "C:\\Home" "c:/home/bob" == "bob")
+ ,("AFP_W.makeRelative (\"C:\\\\Home\") (\"c:/home/bob\") == (\"bob\")", property $ AFP_W.makeRelative ("C:\\Home") ("c:/home/bob") == ("bob"))
,("W.makeRelative \"C:\\\\Home\" \"D:\\\\Home\\\\Bob\" == \"D:\\\\Home\\\\Bob\"", property $ W.makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob")
+ ,("AFP_W.makeRelative (\"C:\\\\Home\") (\"D:\\\\Home\\\\Bob\") == (\"D:\\\\Home\\\\Bob\")", property $ AFP_W.makeRelative ("C:\\Home") ("D:\\Home\\Bob") == ("D:\\Home\\Bob"))
,("W.makeRelative \"C:\\\\Home\" \"C:Home\\\\Bob\" == \"C:Home\\\\Bob\"", property $ W.makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob")
+ ,("AFP_W.makeRelative (\"C:\\\\Home\") (\"C:Home\\\\Bob\") == (\"C:Home\\\\Bob\")", property $ AFP_W.makeRelative ("C:\\Home") ("C:Home\\Bob") == ("C:Home\\Bob"))
,("W.makeRelative \"/Home\" \"/home/bob\" == \"bob\"", property $ W.makeRelative "/Home" "/home/bob" == "bob")
+ ,("AFP_W.makeRelative (\"/Home\") (\"/home/bob\") == (\"bob\")", property $ AFP_W.makeRelative ("/Home") ("/home/bob") == ("bob"))
,("W.makeRelative \"/\" \"//\" == \"//\"", property $ W.makeRelative "/" "//" == "//")
+ ,("AFP_W.makeRelative (\"/\") (\"//\") == (\"//\")", property $ AFP_W.makeRelative ("/") ("//") == ("//"))
,("P.makeRelative \"/Home\" \"/home/bob\" == \"/home/bob\"", property $ P.makeRelative "/Home" "/home/bob" == "/home/bob")
+ ,("AFP_P.makeRelative (\"/Home\") (\"/home/bob\") == (\"/home/bob\")", property $ AFP_P.makeRelative ("/Home") ("/home/bob") == ("/home/bob"))
,("P.makeRelative \"/home/\" \"/home/bob/foo/bar\" == \"bob/foo/bar\"", property $ P.makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar")
+ ,("AFP_P.makeRelative (\"/home/\") (\"/home/bob/foo/bar\") == (\"bob/foo/bar\")", property $ AFP_P.makeRelative ("/home/") ("/home/bob/foo/bar") == ("bob/foo/bar"))
,("P.makeRelative \"/fred\" \"bob\" == \"bob\"", property $ P.makeRelative "/fred" "bob" == "bob")
+ ,("AFP_P.makeRelative (\"/fred\") (\"bob\") == (\"bob\")", property $ AFP_P.makeRelative ("/fred") ("bob") == ("bob"))
,("P.makeRelative \"/file/test\" \"/file/test/fred\" == \"fred\"", property $ P.makeRelative "/file/test" "/file/test/fred" == "fred")
+ ,("AFP_P.makeRelative (\"/file/test\") (\"/file/test/fred\") == (\"fred\")", property $ AFP_P.makeRelative ("/file/test") ("/file/test/fred") == ("fred"))
,("P.makeRelative \"/file/test\" \"/file/test/fred/\" == \"fred/\"", property $ P.makeRelative "/file/test" "/file/test/fred/" == "fred/")
+ ,("AFP_P.makeRelative (\"/file/test\") (\"/file/test/fred/\") == (\"fred/\")", property $ AFP_P.makeRelative ("/file/test") ("/file/test/fred/") == ("fred/"))
,("P.makeRelative \"some/path\" \"some/path/a/b/c\" == \"a/b/c\"", property $ P.makeRelative "some/path" "some/path/a/b/c" == "a/b/c")
+ ,("AFP_P.makeRelative (\"some/path\") (\"some/path/a/b/c\") == (\"a/b/c\")", property $ AFP_P.makeRelative ("some/path") ("some/path/a/b/c") == ("a/b/c"))
,("P.normalise \"/file/\\\\test////\" == \"/file/\\\\test/\"", property $ P.normalise "/file/\\test////" == "/file/\\test/")
+ ,("AFP_P.normalise (\"/file/\\\\test////\") == (\"/file/\\\\test/\")", property $ AFP_P.normalise ("/file/\\test////") == ("/file/\\test/"))
,("P.normalise \"/file/./test\" == \"/file/test\"", property $ P.normalise "/file/./test" == "/file/test")
+ ,("AFP_P.normalise (\"/file/./test\") == (\"/file/test\")", property $ AFP_P.normalise ("/file/./test") == ("/file/test"))
,("P.normalise \"/test/file/../bob/fred/\" == \"/test/file/../bob/fred/\"", property $ P.normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/")
+ ,("AFP_P.normalise (\"/test/file/../bob/fred/\") == (\"/test/file/../bob/fred/\")", property $ AFP_P.normalise ("/test/file/../bob/fred/") == ("/test/file/../bob/fred/"))
,("P.normalise \"../bob/fred/\" == \"../bob/fred/\"", property $ P.normalise "../bob/fred/" == "../bob/fred/")
+ ,("AFP_P.normalise (\"../bob/fred/\") == (\"../bob/fred/\")", property $ AFP_P.normalise ("../bob/fred/") == ("../bob/fred/"))
,("P.normalise \"/a/../c\" == \"/a/../c\"", property $ P.normalise "/a/../c" == "/a/../c")
+ ,("AFP_P.normalise (\"/a/../c\") == (\"/a/../c\")", property $ AFP_P.normalise ("/a/../c") == ("/a/../c"))
,("P.normalise \"./bob/fred/\" == \"bob/fred/\"", property $ P.normalise "./bob/fred/" == "bob/fred/")
+ ,("AFP_P.normalise (\"./bob/fred/\") == (\"bob/fred/\")", property $ AFP_P.normalise ("./bob/fred/") == ("bob/fred/"))
,("W.normalise \"c:\\\\file/bob\\\\\" == \"C:\\\\file\\\\bob\\\\\"", property $ W.normalise "c:\\file/bob\\" == "C:\\file\\bob\\")
+ ,("AFP_W.normalise (\"c:\\\\file/bob\\\\\") == (\"C:\\\\file\\\\bob\\\\\")", property $ AFP_W.normalise ("c:\\file/bob\\") == ("C:\\file\\bob\\"))
,("W.normalise \"c:\\\\\" == \"C:\\\\\"", property $ W.normalise "c:\\" == "C:\\")
+ ,("AFP_W.normalise (\"c:\\\\\") == (\"C:\\\\\")", property $ AFP_W.normalise ("c:\\") == ("C:\\"))
,("W.normalise \"C:.\\\\\" == \"C:\"", property $ W.normalise "C:.\\" == "C:")
+ ,("AFP_W.normalise (\"C:.\\\\\") == (\"C:\")", property $ AFP_W.normalise ("C:.\\") == ("C:"))
,("W.normalise \"\\\\\\\\server\\\\test\" == \"\\\\\\\\server\\\\test\"", property $ W.normalise "\\\\server\\test" == "\\\\server\\test")
+ ,("AFP_W.normalise (\"\\\\\\\\server\\\\test\") == (\"\\\\\\\\server\\\\test\")", property $ AFP_W.normalise ("\\\\server\\test") == ("\\\\server\\test"))
,("W.normalise \"//server/test\" == \"\\\\\\\\server\\\\test\"", property $ W.normalise "//server/test" == "\\\\server\\test")
+ ,("AFP_W.normalise (\"//server/test\") == (\"\\\\\\\\server\\\\test\")", property $ AFP_W.normalise ("//server/test") == ("\\\\server\\test"))
,("W.normalise \"c:/file\" == \"C:\\\\file\"", property $ W.normalise "c:/file" == "C:\\file")
+ ,("AFP_W.normalise (\"c:/file\") == (\"C:\\\\file\")", property $ AFP_W.normalise ("c:/file") == ("C:\\file"))
,("W.normalise \"/file\" == \"\\\\file\"", property $ W.normalise "/file" == "\\file")
+ ,("AFP_W.normalise (\"/file\") == (\"\\\\file\")", property $ AFP_W.normalise ("/file") == ("\\file"))
,("W.normalise \"\\\\\" == \"\\\\\"", property $ W.normalise "\\" == "\\")
+ ,("AFP_W.normalise (\"\\\\\") == (\"\\\\\")", property $ AFP_W.normalise ("\\") == ("\\"))
,("W.normalise \"/./\" == \"\\\\\"", property $ W.normalise "/./" == "\\")
+ ,("AFP_W.normalise (\"/./\") == (\"\\\\\")", property $ AFP_W.normalise ("/./") == ("\\"))
,("P.normalise \".\" == \".\"", property $ P.normalise "." == ".")
,("W.normalise \".\" == \".\"", property $ W.normalise "." == ".")
+ ,("AFP_P.normalise (\".\") == (\".\")", property $ AFP_P.normalise (".") == ("."))
+ ,("AFP_W.normalise (\".\") == (\".\")", property $ AFP_W.normalise (".") == ("."))
,("P.normalise \"./\" == \"./\"", property $ P.normalise "./" == "./")
+ ,("AFP_P.normalise (\"./\") == (\"./\")", property $ AFP_P.normalise ("./") == ("./"))
,("P.normalise \"./.\" == \"./\"", property $ P.normalise "./." == "./")
+ ,("AFP_P.normalise (\"./.\") == (\"./\")", property $ AFP_P.normalise ("./.") == ("./"))
,("P.normalise \"/./\" == \"/\"", property $ P.normalise "/./" == "/")
+ ,("AFP_P.normalise (\"/./\") == (\"/\")", property $ AFP_P.normalise ("/./") == ("/"))
,("P.normalise \"/\" == \"/\"", property $ P.normalise "/" == "/")
+ ,("AFP_P.normalise (\"/\") == (\"/\")", property $ AFP_P.normalise ("/") == ("/"))
,("P.normalise \"bob/fred/.\" == \"bob/fred/\"", property $ P.normalise "bob/fred/." == "bob/fred/")
+ ,("AFP_P.normalise (\"bob/fred/.\") == (\"bob/fred/\")", property $ AFP_P.normalise ("bob/fred/.") == ("bob/fred/"))
,("P.normalise \"//home\" == \"/home\"", property $ P.normalise "//home" == "/home")
+ ,("AFP_P.normalise (\"//home\") == (\"/home\")", property $ AFP_P.normalise ("//home") == ("/home"))
,("P.isValid \"\" == False", property $ P.isValid "" == False)
,("W.isValid \"\" == False", property $ W.isValid "" == False)
+ ,("AFP_P.isValid (\"\") == False", property $ AFP_P.isValid ("") == False)
+ ,("AFP_W.isValid (\"\") == False", property $ AFP_W.isValid ("") == False)
,("P.isValid \"\\0\" == False", property $ P.isValid "\0" == False)
,("W.isValid \"\\0\" == False", property $ W.isValid "\0" == False)
+ ,("AFP_P.isValid (\"\\0\") == False", property $ AFP_P.isValid ("\0") == False)
+ ,("AFP_W.isValid (\"\\0\") == False", property $ AFP_W.isValid ("\0") == False)
,("P.isValid \"/random_ path:*\" == True", property $ P.isValid "/random_ path:*" == True)
+ ,("AFP_P.isValid (\"/random_ path:*\") == True", property $ AFP_P.isValid ("/random_ path:*") == True)
,("P.isValid x == not (null x)", property $ \(QFilePath x) -> P.isValid x == not (null x))
+ ,("AFP_P.isValid x == not ((SBS.null . unPFP) x)", property $ \(QFilePathAFP_P x) -> AFP_P.isValid x == not ((SBS.null . unPFP) x))
,("W.isValid \"c:\\\\test\" == True", property $ W.isValid "c:\\test" == True)
+ ,("AFP_W.isValid (\"c:\\\\test\") == True", property $ AFP_W.isValid ("c:\\test") == True)
,("W.isValid \"c:\\\\test:of_test\" == False", property $ W.isValid "c:\\test:of_test" == False)
+ ,("AFP_W.isValid (\"c:\\\\test:of_test\") == False", property $ AFP_W.isValid ("c:\\test:of_test") == False)
,("W.isValid \"test*\" == False", property $ W.isValid "test*" == False)
+ ,("AFP_W.isValid (\"test*\") == False", property $ AFP_W.isValid ("test*") == False)
,("W.isValid \"c:\\\\test\\\\nul\" == False", property $ W.isValid "c:\\test\\nul" == False)
+ ,("AFP_W.isValid (\"c:\\\\test\\\\nul\") == False", property $ AFP_W.isValid ("c:\\test\\nul") == False)
,("W.isValid \"c:\\\\test\\\\prn.txt\" == False", property $ W.isValid "c:\\test\\prn.txt" == False)
+ ,("AFP_W.isValid (\"c:\\\\test\\\\prn.txt\") == False", property $ AFP_W.isValid ("c:\\test\\prn.txt") == False)
,("W.isValid \"c:\\\\nul\\\\file\" == False", property $ W.isValid "c:\\nul\\file" == False)
+ ,("AFP_W.isValid (\"c:\\\\nul\\\\file\") == False", property $ AFP_W.isValid ("c:\\nul\\file") == False)
,("W.isValid \"\\\\\\\\\" == False", property $ W.isValid "\\\\" == False)
+ ,("AFP_W.isValid (\"\\\\\\\\\") == False", property $ AFP_W.isValid ("\\\\") == False)
,("W.isValid \"\\\\\\\\\\\\foo\" == False", property $ W.isValid "\\\\\\foo" == False)
+ ,("AFP_W.isValid (\"\\\\\\\\\\\\foo\") == False", property $ AFP_W.isValid ("\\\\\\foo") == False)
,("W.isValid \"\\\\\\\\?\\\\D:file\" == False", property $ W.isValid "\\\\?\\D:file" == False)
+ ,("AFP_W.isValid (\"\\\\\\\\?\\\\D:file\") == False", property $ AFP_W.isValid ("\\\\?\\D:file") == False)
,("W.isValid \"foo\\tbar\" == False", property $ W.isValid "foo\tbar" == False)
+ ,("AFP_W.isValid (\"foo\\tbar\") == False", property $ AFP_W.isValid ("foo\tbar") == False)
,("W.isValid \"nul .txt\" == False", property $ W.isValid "nul .txt" == False)
+ ,("AFP_W.isValid (\"nul .txt\") == False", property $ AFP_W.isValid ("nul .txt") == False)
,("W.isValid \" nul.txt\" == True", property $ W.isValid " nul.txt" == True)
+ ,("AFP_W.isValid (\" nul.txt\") == True", property $ AFP_W.isValid (" nul.txt") == True)
,("P.isValid (P.makeValid x)", property $ \(QFilePath x) -> P.isValid (P.makeValid x))
,("W.isValid (W.makeValid x)", property $ \(QFilePath x) -> W.isValid (W.makeValid x))
+ ,("AFP_P.isValid (AFP_P.makeValid x)", property $ \(QFilePathAFP_P x) -> AFP_P.isValid (AFP_P.makeValid x))
+ ,("AFP_W.isValid (AFP_W.makeValid x)", property $ \(QFilePathAFP_W x) -> AFP_W.isValid (AFP_W.makeValid x))
,("P.isValid x ==> P.makeValid x == x", property $ \(QFilePath x) -> P.isValid x ==> P.makeValid x == x)
,("W.isValid x ==> W.makeValid x == x", property $ \(QFilePath x) -> W.isValid x ==> W.makeValid x == x)
+ ,("AFP_P.isValid x ==> AFP_P.makeValid x == x", property $ \(QFilePathAFP_P x) -> AFP_P.isValid x ==> AFP_P.makeValid x == x)
+ ,("AFP_W.isValid x ==> AFP_W.makeValid x == x", property $ \(QFilePathAFP_W x) -> AFP_W.isValid x ==> AFP_W.makeValid x == x)
,("P.makeValid \"\" == \"_\"", property $ P.makeValid "" == "_")
,("W.makeValid \"\" == \"_\"", property $ W.makeValid "" == "_")
+ ,("AFP_P.makeValid (\"\") == (\"_\")", property $ AFP_P.makeValid ("") == ("_"))
+ ,("AFP_W.makeValid (\"\") == (\"_\")", property $ AFP_W.makeValid ("") == ("_"))
,("P.makeValid \"file\\0name\" == \"file_name\"", property $ P.makeValid "file\0name" == "file_name")
,("W.makeValid \"file\\0name\" == \"file_name\"", property $ W.makeValid "file\0name" == "file_name")
+ ,("AFP_P.makeValid (\"file\\0name\") == (\"file_name\")", property $ AFP_P.makeValid ("file\0name") == ("file_name"))
+ ,("AFP_W.makeValid (\"file\\0name\") == (\"file_name\")", property $ AFP_W.makeValid ("file\0name") == ("file_name"))
,("W.makeValid \"c:\\\\already\\\\/valid\" == \"c:\\\\already\\\\/valid\"", property $ W.makeValid "c:\\already\\/valid" == "c:\\already\\/valid")
+ ,("AFP_W.makeValid (\"c:\\\\already\\\\/valid\") == (\"c:\\\\already\\\\/valid\")", property $ AFP_W.makeValid ("c:\\already\\/valid") == ("c:\\already\\/valid"))
,("W.makeValid \"c:\\\\test:of_test\" == \"c:\\\\test_of_test\"", property $ W.makeValid "c:\\test:of_test" == "c:\\test_of_test")
+ ,("AFP_W.makeValid (\"c:\\\\test:of_test\") == (\"c:\\\\test_of_test\")", property $ AFP_W.makeValid ("c:\\test:of_test") == ("c:\\test_of_test"))
,("W.makeValid \"test*\" == \"test_\"", property $ W.makeValid "test*" == "test_")
+ ,("AFP_W.makeValid (\"test*\") == (\"test_\")", property $ AFP_W.makeValid ("test*") == ("test_"))
,("W.makeValid \"c:\\\\test\\\\nul\" == \"c:\\\\test\\\\nul_\"", property $ W.makeValid "c:\\test\\nul" == "c:\\test\\nul_")
+ ,("AFP_W.makeValid (\"c:\\\\test\\\\nul\") == (\"c:\\\\test\\\\nul_\")", property $ AFP_W.makeValid ("c:\\test\\nul") == ("c:\\test\\nul_"))
,("W.makeValid \"c:\\\\test\\\\prn.txt\" == \"c:\\\\test\\\\prn_.txt\"", property $ W.makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt")
+ ,("AFP_W.makeValid (\"c:\\\\test\\\\prn.txt\") == (\"c:\\\\test\\\\prn_.txt\")", property $ AFP_W.makeValid ("c:\\test\\prn.txt") == ("c:\\test\\prn_.txt"))
,("W.makeValid \"c:\\\\test/prn.txt\" == \"c:\\\\test/prn_.txt\"", property $ W.makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt")
+ ,("AFP_W.makeValid (\"c:\\\\test/prn.txt\") == (\"c:\\\\test/prn_.txt\")", property $ AFP_W.makeValid ("c:\\test/prn.txt") == ("c:\\test/prn_.txt"))
,("W.makeValid \"c:\\\\nul\\\\file\" == \"c:\\\\nul_\\\\file\"", property $ W.makeValid "c:\\nul\\file" == "c:\\nul_\\file")
+ ,("AFP_W.makeValid (\"c:\\\\nul\\\\file\") == (\"c:\\\\nul_\\\\file\")", property $ AFP_W.makeValid ("c:\\nul\\file") == ("c:\\nul_\\file"))
,("W.makeValid \"\\\\\\\\\\\\foo\" == \"\\\\\\\\drive\"", property $ W.makeValid "\\\\\\foo" == "\\\\drive")
+ ,("AFP_W.makeValid (\"\\\\\\\\\\\\foo\") == (\"\\\\\\\\drive\")", property $ AFP_W.makeValid ("\\\\\\foo") == ("\\\\drive"))
,("W.makeValid \"\\\\\\\\?\\\\D:file\" == \"\\\\\\\\?\\\\D:\\\\file\"", property $ W.makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file")
+ ,("AFP_W.makeValid (\"\\\\\\\\?\\\\D:file\") == (\"\\\\\\\\?\\\\D:\\\\file\")", property $ AFP_W.makeValid ("\\\\?\\D:file") == ("\\\\?\\D:\\file"))
,("W.makeValid \"nul .txt\" == \"nul _.txt\"", property $ W.makeValid "nul .txt" == "nul _.txt")
+ ,("AFP_W.makeValid (\"nul .txt\") == (\"nul _.txt\")", property $ AFP_W.makeValid ("nul .txt") == ("nul _.txt"))
,("W.isRelative \"path\\\\test\" == True", property $ W.isRelative "path\\test" == True)
+ ,("AFP_W.isRelative (\"path\\\\test\") == True", property $ AFP_W.isRelative ("path\\test") == True)
,("W.isRelative \"c:\\\\test\" == False", property $ W.isRelative "c:\\test" == False)
+ ,("AFP_W.isRelative (\"c:\\\\test\") == False", property $ AFP_W.isRelative ("c:\\test") == False)
,("W.isRelative \"c:test\" == True", property $ W.isRelative "c:test" == True)
+ ,("AFP_W.isRelative (\"c:test\") == True", property $ AFP_W.isRelative ("c:test") == True)
,("W.isRelative \"c:\\\\\" == False", property $ W.isRelative "c:\\" == False)
+ ,("AFP_W.isRelative (\"c:\\\\\") == False", property $ AFP_W.isRelative ("c:\\") == False)
,("W.isRelative \"c:/\" == False", property $ W.isRelative "c:/" == False)
+ ,("AFP_W.isRelative (\"c:/\") == False", property $ AFP_W.isRelative ("c:/") == False)
,("W.isRelative \"c:\" == True", property $ W.isRelative "c:" == True)
+ ,("AFP_W.isRelative (\"c:\") == True", property $ AFP_W.isRelative ("c:") == True)
,("W.isRelative \"\\\\\\\\foo\" == False", property $ W.isRelative "\\\\foo" == False)
+ ,("AFP_W.isRelative (\"\\\\\\\\foo\") == False", property $ AFP_W.isRelative ("\\\\foo") == False)
,("W.isRelative \"\\\\\\\\?\\\\foo\" == False", property $ W.isRelative "\\\\?\\foo" == False)
+ ,("AFP_W.isRelative (\"\\\\\\\\?\\\\foo\") == False", property $ AFP_W.isRelative ("\\\\?\\foo") == False)
,("W.isRelative \"\\\\\\\\?\\\\UNC\\\\foo\" == False", property $ W.isRelative "\\\\?\\UNC\\foo" == False)
+ ,("AFP_W.isRelative (\"\\\\\\\\?\\\\UNC\\\\foo\") == False", property $ AFP_W.isRelative ("\\\\?\\UNC\\foo") == False)
,("W.isRelative \"/foo\" == True", property $ W.isRelative "/foo" == True)
+ ,("AFP_W.isRelative (\"/foo\") == True", property $ AFP_W.isRelative ("/foo") == True)
,("W.isRelative \"\\\\foo\" == True", property $ W.isRelative "\\foo" == True)
+ ,("AFP_W.isRelative (\"\\\\foo\") == True", property $ AFP_W.isRelative ("\\foo") == True)
,("P.isRelative \"test/path\" == True", property $ P.isRelative "test/path" == True)
+ ,("AFP_P.isRelative (\"test/path\") == True", property $ AFP_P.isRelative ("test/path") == True)
,("P.isRelative \"/test\" == False", property $ P.isRelative "/test" == False)
+ ,("AFP_P.isRelative (\"/test\") == False", property $ AFP_P.isRelative ("/test") == False)
,("P.isRelative \"/\" == False", property $ P.isRelative "/" == False)
+ ,("AFP_P.isRelative (\"/\") == False", property $ AFP_P.isRelative ("/") == False)
,("P.isAbsolute x == not (P.isRelative x)", property $ \(QFilePath x) -> P.isAbsolute x == not (P.isRelative x))
,("W.isAbsolute x == not (W.isRelative x)", property $ \(QFilePath x) -> W.isAbsolute x == not (W.isRelative x))
+ ,("AFP_P.isAbsolute x == not (AFP_P.isRelative x)", property $ \(QFilePathAFP_P x) -> AFP_P.isAbsolute x == not (AFP_P.isRelative x))
+ ,("AFP_W.isAbsolute x == not (AFP_W.isRelative x)", property $ \(QFilePathAFP_W x) -> AFP_W.isAbsolute x == not (AFP_W.isRelative x))
]
diff --git a/tests/TestUtil.hs b/tests/TestUtil.hs
index b237acd..1de35bb 100644
--- a/tests/TestUtil.hs
+++ b/tests/TestUtil.hs
@@ -1,17 +1,30 @@
+{-# LANGUAGE CPP #-}
module TestUtil(
- (==>), QFilePath(..), QFilePathValidW(..), QFilePathValidP(..),
+ module TestUtil,
module Test.QuickCheck,
module Data.List,
module Data.Maybe
) where
import Test.QuickCheck hiding ((==>))
+import Data.ByteString.Short (ShortByteString)
import Data.List
import Data.Maybe
import Control.Monad
import qualified System.FilePath.Windows as W
import qualified System.FilePath.Posix as P
+#ifdef GHC_MAKE
+import qualified System.AbstractFilePath.Windows.Internal as AFP_W
+import qualified System.AbstractFilePath.Posix.Internal as AFP_P
+#else
+import qualified System.AbstractFilePath.Windows as AFP_W
+import qualified System.AbstractFilePath.Posix as AFP_P
+import System.AbstractFilePath.Types
+#endif
+import System.AbstractFilePath.Data.ByteString.Short.Decode
+import System.AbstractFilePath.Data.ByteString.Short.Encode
+
infixr 0 ==>
a ==> b = not a || b
@@ -50,3 +63,78 @@ shrinkValid wrap valid o =
| y <- map valid $ shrinkList (\x -> ['a' | x /= 'a']) o
, length y < length o || (length y == length o && countA y > countA o)]
where countA = length . filter (== 'a')
+
+#ifdef GHC_MAKE
+newtype QFilePathValidAFP_W = QFilePathValidAFP_W ShortByteString deriving Show
+
+instance Arbitrary QFilePathValidAFP_W where
+ arbitrary = fmap (QFilePathValidAFP_W . AFP_W.makeValid . encodeUtf16LE) arbitraryFilePath
+ shrink (QFilePathValidAFP_W x) = shrinkValid (QFilePathValidAFP_W . encodeUtf16LE) (decodeUtf16LE . AFP_W.makeValid . encodeUtf16LE) (decodeUtf16LE x)
+
+newtype QFilePathValidAFP_P = QFilePathValidAFP_P ShortByteString deriving Show
+
+instance Arbitrary QFilePathValidAFP_P where
+ arbitrary = fmap (QFilePathValidAFP_P . AFP_P.makeValid . encodeUtf8) arbitraryFilePath
+ shrink (QFilePathValidAFP_P x) = shrinkValid (QFilePathValidAFP_P . encodeUtf8) (decodeUtf8 . AFP_P.makeValid . encodeUtf8) (decodeUtf8 x)
+
+newtype QFilePathAFP_W = QFilePathAFP_W ShortByteString deriving Show
+newtype QFilePathAFP_P = QFilePathAFP_P ShortByteString deriving Show
+
+instance Arbitrary QFilePathAFP_W where
+ arbitrary = fmap (QFilePathAFP_W . encodeUtf16LE) arbitraryFilePath
+ shrink (QFilePathAFP_W x) = shrinkValid (QFilePathAFP_W . encodeUtf16LE) id (decodeUtf16LE x)
+
+instance Arbitrary QFilePathAFP_P where
+ arbitrary = fmap (QFilePathAFP_P . encodeUtf8) arbitraryFilePath
+ shrink (QFilePathAFP_P x) = shrinkValid (QFilePathAFP_P . encodeUtf8) id (decodeUtf8 x)
+
+newtype QFilePathsAFP_W = QFilePathsAFP_W [ShortByteString] deriving Show
+newtype QFilePathsAFP_P = QFilePathsAFP_P [ShortByteString] deriving Show
+
+instance Arbitrary QFilePathsAFP_W where
+ arbitrary = fmap (QFilePathsAFP_W . fmap encodeUtf16LE) (listOf arbitraryFilePath)
+
+instance Arbitrary QFilePathsAFP_P where
+ arbitrary = fmap (QFilePathsAFP_P . fmap encodeUtf8) (listOf arbitraryFilePath)
+
+#else
+
+
+newtype QFilePathValidAFP_W = QFilePathValidAFP_W WindowsFilePath deriving Show
+
+instance Arbitrary QFilePathValidAFP_W where
+ arbitrary = fmap (QFilePathValidAFP_W . AFP_W.makeValid . WS . encodeUtf16LE) arbitraryFilePath
+ shrink (QFilePathValidAFP_W x) = shrinkValid (QFilePathValidAFP_W . WS . encodeUtf16LE) (decodeUtf16LE . unWFP . AFP_W.makeValid . WS . encodeUtf16LE) (decodeUtf16LE . unWFP $ x)
+
+newtype QFilePathValidAFP_P = QFilePathValidAFP_P PosixFilePath deriving Show
+
+instance Arbitrary QFilePathValidAFP_P where
+ arbitrary = fmap (QFilePathValidAFP_P . AFP_P.makeValid . PS . encodeUtf8) arbitraryFilePath
+ shrink (QFilePathValidAFP_P x) = shrinkValid (QFilePathValidAFP_P . PS . encodeUtf8) (decodeUtf8 . unPFP . AFP_P.makeValid . PS . encodeUtf8) (decodeUtf8 . unPFP $ x)
+
+newtype QFilePathAFP_W = QFilePathAFP_W WindowsFilePath deriving Show
+newtype QFilePathAFP_P = QFilePathAFP_P PosixFilePath deriving Show
+
+instance Arbitrary QFilePathAFP_W where
+ arbitrary = fmap (QFilePathAFP_W . WS . encodeUtf16LE) arbitraryFilePath
+ shrink (QFilePathAFP_W x) = shrinkValid (QFilePathAFP_W . WS . encodeUtf16LE) id (decodeUtf16LE . unWFP $ x)
+
+instance Arbitrary QFilePathAFP_P where
+ arbitrary = fmap (QFilePathAFP_P . PS . encodeUtf8) arbitraryFilePath
+ shrink (QFilePathAFP_P x) = shrinkValid (QFilePathAFP_P . PS . encodeUtf8) id (decodeUtf8 . unPFP $ x)
+
+newtype QFilePathsAFP_W = QFilePathsAFP_W [WindowsFilePath] deriving Show
+newtype QFilePathsAFP_P = QFilePathsAFP_P [PosixFilePath] deriving Show
+
+instance Arbitrary QFilePathsAFP_W where
+ arbitrary = fmap (QFilePathsAFP_W . fmap (WS . encodeUtf16LE)) (listOf arbitraryFilePath)
+
+instance Arbitrary QFilePathsAFP_P where
+ arbitrary = fmap (QFilePathsAFP_P . fmap (PS . encodeUtf8)) (listOf arbitraryFilePath)
+
+instance Arbitrary WindowsChar where
+ arbitrary = WW <$> arbitrary
+
+instance Arbitrary PosixChar where
+ arbitrary = PW <$> arbitrary
+#endif
diff --git a/tests/afpp/AbstractFilePathSpec.hs b/tests/afpp/AbstractFilePathSpec.hs
new file mode 100644
index 0000000..ad080ca
--- /dev/null
+++ b/tests/afpp/AbstractFilePathSpec.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module AbstractFilePathSpec where
+
+import System.AbstractFilePath
+import System.OsString.Internal.Types
+import System.AbstractFilePath.Data.ByteString.Short.Decode
+ ( decodeUtf16LE, decodeUtf8 )
+import System.AbstractFilePath.Data.ByteString.Short.Encode
+ ( encodeUtf16LE, encodeUtf8 )
+
+import Arbitrary ()
+import Test.Tasty
+import Test.Tasty.QuickCheck
+import Test.QuickCheck.Monadic
+import Test.QuickCheck
+ ( Testable (property) )
+import Test.QuickCheck.Classes
+import Test.QuickCheck.Checkers
+
+
+tests :: [TestTree]
+tests =
+ [ testProperty "decodeUtf8 . encodeUtf8 == id" $
+ \str -> (decodeUtf8 . encodeUtf8) str == str
+ , testProperty "decodeUtf16LE . encodeUtf16LE == id" $
+ \str -> (decodeUtf16LE . encodeUtf16LE) str == str
+ , testProperty "fromAbstractFilePath . toAbstractFilePath == id" $
+ \str -> (fromAbstractFilePath . toAbstractFilePath) str == Just str
+
+ ] ++ testBatch (ord (\(a :: AbstractFilePath) -> pure a))
+ ++ testBatch (monoid (undefined :: AbstractFilePath))
+
+ ++ testBatch (ord (\(a :: OsString) -> pure a))
+ ++ testBatch (monoid (undefined :: OsString))
+
+ ++ testBatch (ord (\(a :: WindowsString) -> pure a))
+ ++ testBatch (monoid (undefined :: WindowsString))
+
+ ++ testBatch (ord (\(a :: PosixString) -> pure a))
+ ++ testBatch (monoid (undefined :: PosixString))
+
+ ++ testBatch (ord (\(a :: PlatformString) -> pure a))
+ ++ testBatch (monoid (undefined :: PlatformString))
+
+-- | Allows to insert a 'TestBatch' into a Spec.
+testBatch :: TestBatch -> [TestTree]
+testBatch (batchName, tests) =
+ fmap (\(str, prop) -> testProperty str prop) tests
diff --git a/tests/afpp/Arbitrary.hs b/tests/afpp/Arbitrary.hs
new file mode 100644
index 0000000..296d2d5
--- /dev/null
+++ b/tests/afpp/Arbitrary.hs
@@ -0,0 +1,29 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Arbitrary where
+
+import System.OsString
+import System.OsString.Internal.Types
+import qualified System.OsString.Posix as Posix
+import qualified System.OsString.Windows as Windows
+
+import Test.QuickCheck.Arbitrary
+import Test.QuickCheck.Checkers
+
+instance Arbitrary OsString where
+ arbitrary = toOsString <$> arbitrary
+
+instance EqProp OsString where
+ (=-=) = eq
+
+instance Arbitrary PosixString where
+ arbitrary = Posix.toPlatformString <$> arbitrary
+
+instance EqProp PosixString where
+ (=-=) = eq
+
+instance Arbitrary WindowsString where
+ arbitrary = Windows.toPlatformString <$> arbitrary
+
+instance EqProp WindowsString where
+ (=-=) = eq
diff --git a/tests/afpp/Test.hs b/tests/afpp/Test.hs
new file mode 100644
index 0000000..9af6c09
--- /dev/null
+++ b/tests/afpp/Test.hs
@@ -0,0 +1,9 @@
+module Main (main) where
+
+import Test.Tasty
+
+import qualified AbstractFilePathSpec
+
+main :: IO ()
+main = defaultMain $ testGroup "All"
+ AbstractFilePathSpec.tests
--
GitLab