filepath 1.4.2.2 → 1.4.100.0

raw patch · 47 files changed

+10883/−2889 lines, 47 filesdep +bytestringdep +checkersdep +deepseqdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, checkers, deepseq, exceptions, template-haskell

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Generate.hs +205/−0
• Makefile +3/−6
• README.md +22/−13
• System/FilePath/Internal.hs +425/−223
• System/FilePath/Posix.hs +7/−1048
• System/FilePath/Windows.hs +8/−1048
• System/OsPath.hs +63/−0
• System/OsPath.hs-boot +6/−0
• System/OsPath/Common.hs +1437/−0
• System/OsPath/Data/ByteString/Short.hs +175/−0
• System/OsPath/Data/ByteString/Short/Internal.hs +436/−0
• System/OsPath/Data/ByteString/Short/Word16.hs +862/−0
• System/OsPath/Encoding.hs +31/−0
• System/OsPath/Encoding/Internal.hs +349/−0
• System/OsPath/Internal.hs +156/−0
• System/OsPath/Posix.hs +27/−0
• System/OsPath/Posix/Internal.hs +8/−0
• System/OsPath/Types.hs +42/−0
• System/OsPath/Windows.hs +28/−0
• System/OsPath/Windows/Internal.hs +9/−0
• System/OsString.hs +60/−0
• System/OsString/Common.hs +315/−0
• System/OsString/Internal.hs +174/−0
• System/OsString/Internal/Types.hs +246/−0
• System/OsString/Posix.hs +7/−0
• System/OsString/Windows.hs +13/−0
• bench/BenchFilePath.hs +311/−0
• bench/TastyBench.hs +526/−0
• changelog.md +5/−0
• filepath.cabal +189/−54
• tests/Test.hs +0/−30
• tests/TestGen.hs +0/−466
• tests/TestUtil.hs +137/−1
• tests/abstract-filepath/Arbitrary.hs +81/−0
• tests/abstract-filepath/EncodingSpec.hs +161/−0
• tests/abstract-filepath/OsPathSpec.hs +259/−0
• tests/abstract-filepath/Test.hs +8/−0
• tests/bytestring-tests/Main.hs +10/−0
• tests/bytestring-tests/Properties/Common.hs +418/−0
• tests/bytestring-tests/Properties/ShortByteString.hs +3/−0
• tests/bytestring-tests/Properties/ShortByteString/Word16.hs +3/−0
• tests/filepath-equivalent-tests/Legacy/System/FilePath.hs +147/−0
• tests/filepath-equivalent-tests/Legacy/System/FilePath/Posix.hs +1048/−0
• tests/filepath-equivalent-tests/Legacy/System/FilePath/Windows.hs +1048/−0
• tests/filepath-equivalent-tests/TestEquiv.hs +427/−0
• tests/filepath-tests/Test.hs +39/−0
• tests/filepath-tests/TestGen.hs +949/−0

@@ -0,0 +1,205 @@+{-# 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+import System.IO+++main :: IO ()+main = do+    src <- readFile "System/FilePath/Internal.hs"+    let tests = map renderTest $ concatMap parseTest $ lines src+    writeFileBinaryChanged "tests/filepath-tests/TestGen.hs" $ unlines $+        ["-- GENERATED CODE: See ../Generate.hs"+#ifndef GHC_MAKE+        , "{-# LANGUAGE OverloadedStrings #-}"+        , "{-# LANGUAGE ViewPatterns #-}"+#endif+        , "{-# LANGUAGE CPP #-}"+        , "{-# OPTIONS_GHC -Wno-name-shadowing #-}"+        , "{-# OPTIONS_GHC -Wno-orphans #-}"+        ,"module TestGen(tests) where"+        ,"import TestUtil"+        ,"#if !MIN_VERSION_base(4,11,0)"+        ,"import Data.Semigroup"+        ,"#endif"+        ,"import Prelude as P"+        ,"import Data.String"+        ,"import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )"+        ,"import GHC.IO.Encoding.UTF16 ( mkUTF16le )"+        ,"import GHC.IO.Encoding.UTF8 ( mkUTF8 )"+        ,"import System.OsString.Internal.Types"+        ,"import System.OsPath.Encoding.Internal"+        ,"import qualified Data.Char as C"+        ,"import qualified System.OsPath.Data.ByteString.Short as SBS"+        ,"import qualified System.OsPath.Data.ByteString.Short.Word16 as SBS16"+        ,"import qualified System.FilePath.Windows as W"+        ,"import qualified System.FilePath.Posix as P"+#ifdef GHC_MAKE+        ,"import qualified System.OsPath.Windows.Internal as AFP_W"+        ,"import qualified System.OsPath.Posix.Internal as AFP_P"+#else+        ,"import qualified System.OsPath.Windows as AFP_W"+        ,"import qualified System.OsPath.Posix as AFP_P"+#endif+        ,"instance IsString WindowsString where fromString = WS . either (error . show) id . encodeWithTE (mkUTF16le TransliterateCodingFailure)"+        ,"instance IsString PosixString where fromString = PS . either (error . show) id . encodeWithTE (mkUTF8 TransliterateCodingFailure)"+        ,"#if defined(mingw32_HOST_OS) || defined(__MINGW32__)"+        ,"instance IsString OsString where fromString = OsString . WS . either (error . show) id . encodeWithTE (mkUTF16le TransliterateCodingFailure)"+        ,"#else"+        ,"instance IsString OsString where fromString = OsString . PS . either (error . show) id . encodeWithTE (mkUTF8 TransliterateCodingFailure)"+        ,"#endif"+        ,"tests :: [(String, Property)]"+        ,"tests ="] +++        ["    " ++ c ++ "(" ++ show t1 ++ ", " ++ t2 ++ ")" | (c,(t1,t2)) <- zip ("[":repeat ",") tests] +++        ["    ]"]++++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+    ,testBody :: [String]+    }+++parseTest :: String -> [Test]+parseTest (stripPrefix "-- > " -> Just x) = platform $ toLexemes x+    where+        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+        valid p x = free p [] 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"  = ""+                         | v `elem` val = "QFilePathValid" ++ show p+                         | 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 _ = []+++toLexemes :: String -> [String]+toLexemes x = case lex x of+    [("","")] -> []+    [(x,y)] -> x : toLexemes y+    y -> error $ "Generate.toLexemes, " ++ show x ++ " -> " ++ show y+++fromLexemes :: [String] -> String+fromLexemes = unwords . f+    where+        f ("`":x:"`":xs) = ("`" ++ x ++ "`") : f xs+        f (x:y:xs) | x `elem` ["[","("] || y `elem` [",",")","]"] = f $ (x ++ y) : xs+        f (x:xs) = x : f xs+        f [] = []+++renderTest :: Test -> (String, String)+renderTest Test{..} = (body, code)+    where+        code = "property $ " ++ if null testVars then body else "\\" ++ unwords vars ++ " -> " ++ body+        vars = [if null ctor then v else "(" ++ ctor ++ " " ++ v ++ ")" | (ctor,v) <- testVars]++        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)+      = if str `elem` bs then qualifyBS str  else show pw ++ "." ++ str+    | otherwise = encode str+    where+        bs = ["null", "concat", "isPrefixOf", "isSuffixOf", "any"]+        prelude = ["elem","uncurry","snd","fst","not","if","then","else"+                  ,"True","False","Just","Nothing","fromJust","foldr"]+        fpops = ["</>","<.>","-<.>"]+#ifdef GHC_MAKE+        encode v+          | isString' v = case pw of+                            AFP_P -> "(encodeUtf8 " <> v <> ")"+                            AFP_W -> "(encodeUtf16LE " <> v <> ")"+                            _ -> v+          | isChar' v = case pw of+                            AFP_P -> "(fromIntegral . C.ord $ " <> v <> ")"+                            AFP_W -> "(fromIntegral . C.ord $ " <> v <> ")"+                            _ -> v+          | otherwise = v+        isString' xs@('"':_:_) = last xs == '"'+        isString' _ = False+        isChar' xs@('\'':_:_) = last xs == '\''+        isChar' _ = False+        qualifyBS v = case pw of+                        AFP_P -> "SBS." <> v+                        AFP_W -> "SBS16." <> v+                        _ -> v+#else+        encode v+          | isString' v = case pw of+                            AFP_P -> "(" <> v <> ")"+                            AFP_W -> "(" <> v <> ")"+                            _ -> v+          | isChar' v = case pw of+                            AFP_P -> "(PW . fromIntegral . C.ord $ " <> v <> ")"+                            AFP_W -> "(WW . fromIntegral . C.ord $ " <> v <> ")"+                            _ -> v+          | otherwise = v+        isString' xs@('"':_:_) = last xs == '"'+        isString' _ = False+        isChar' xs@('\'':_:_) = last xs == '\''+        isChar' _ = False+        qualifyBS v = case pw of+                        AFP_P+                          | v == "concat" -> "(PS . SBS." <> v <> " . fmap getPosixString)"+                          | v == "any" -> "(\\f (getPosixString -> x) -> SBS." <> v <> " (f . PW) x)"+                          | v == "isPrefixOf" -> "(\\(getPosixString -> x) (getPosixString -> y) -> SBS." <> v <> " x y)"+                          | v == "isSuffixOf" -> "(\\(getPosixString -> x) (getPosixString -> y) -> SBS." <> v <> " x y)"+                          | otherwise -> "(SBS." <> v <> " . getPosixString)"+                        AFP_W+                          | v == "concat" -> "(WS . SBS16." <> v <> " . fmap getWindowsString)"+                          | v == "any" -> "(\\f (getWindowsString -> x) -> SBS16." <> v <> " (f . WW) x)"+                          | v == "isPrefixOf" -> "(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16." <> v <> " x y)"+                          | v == "isSuffixOf" -> "(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16." <> v <> " x y)"+                          | otherwise -> "(SBS16." <> v <> " . getWindowsString)"+                        _ -> v+#endif++++---------------------------------------------------------------------+-- UTILITIES++writeFileBinary :: FilePath -> String -> IO ()+writeFileBinary file x = withBinaryFile file WriteMode $ \h -> hPutStr h x++readFileBinary' :: FilePath -> IO String+readFileBinary' file = withBinaryFile file ReadMode $ \h -> do+    s <- hGetContents h+    evaluate $ length s+    pure s++writeFileBinaryChanged :: FilePath -> String -> IO ()+writeFileBinaryChanged file x = do+    b <- doesFileExist file+    old <- if b then fmap Just $ readFileBinary' file else pure Nothing+    when (Just x /= old) $+        writeFileBinary file x

@@ -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

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

@@ -1,7 +1,5 @@-#if __GLASGOW_HASKELL__ >= 704-{-# LANGUAGE Safe #-}-#endif {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE TypeApplications #-}  -- This template expects CPP definitions for: --     MODULE_NAME = Posix | Windows@@ -61,16 +59,25 @@ -- -- References: -- [1] <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx Naming Files, Paths and Namespaces> (Microsoft MSDN)+#ifndef OS_PATH module System.FilePath.MODULE_NAME+#else+module System.OsPath.MODULE_NAME.Internal+#endif     (     -- * Separator predicates+#ifndef OS_PATH     FilePath,+#endif     pathSeparator, pathSeparators, isPathSeparator,     searchPathSeparator, isSearchPathSeparator,     extSeparator, isExtSeparator,      -- * @$PATH@ methods-    splitSearchPath, getSearchPath,+    splitSearchPath,+#ifndef OS_PATH+    getSearchPath,+#endif      -- * Extension functions     splitExtension,@@ -103,11 +110,50 @@     )     where -import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)+{- HLINT ignore "Use fewer imports" -}+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 OS_PATH+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, 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 Control.Exception ( SomeException, evaluate, try, displayException )+import Data.Bifunctor (first)+import Control.DeepSeq (force)+import GHC.IO (unsafePerformIO)+import qualified Data.Char as C+#ifdef WINDOWS+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )+import GHC.IO.Encoding.UTF16 ( mkUTF16le )+import qualified GHC.Foreign as GHC+import Data.Word ( Word16 )+import System.OsPath.Data.ByteString.Short.Word16+import System.OsPath.Data.ByteString.Short ( packCStringLen )+#define CHAR Word16+#define STRING ShortByteString+#define FILEPATH ShortByteString+#else+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )+import qualified GHC.Foreign as GHC+import GHC.IO.Encoding.UTF8 ( mkUTF8 )+import Data.Word ( Word8 )+import System.OsPath.Data.ByteString.Short+#define CHAR Word8+#define STRING ShortByteString+#define FILEPATH ShortByteString+#endif+#endif    infixr 7  <.>, -<.>@@ -138,51 +184,52 @@ -- > 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 +248,31 @@ -- > 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+    f xs = let (pre, post) = break isSearchPathSeparator xs+           in case uncons post of+             Nothing     -> g pre+             Just (_, t) -> g pre ++ f t -    g "" = ["." | isPosix]-    g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x]-    g x = [x]+    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]  --- | Get a list of 'FilePath's in the $PATH variable.-getSearchPath :: IO [FilePath]+-- TODO for AFPP+#ifndef OS_PATH+-- | Get a list of 'FILEPATH's in the $PATH variable.+getSearchPath :: IO [FILEPATH] getSearchPath = fmap splitSearchPath (getEnv "PATH")+#endif   ---------------------------------------------------------------------@@ -224,7 +281,7 @@ -- | 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 +290,12 @@ -- > 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 +304,7 @@ -- > 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 +312,7 @@ -- > "/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 +325,21 @@ -- > 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 +352,13 @@ -- > 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 +367,7 @@ -- > 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 +379,14 @@ -- > "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+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+-- | 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 +401,22 @@ -- > 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 +427,14 @@ -- > 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 +445,7 @@ -- -- > 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 +455,14 @@  -- | 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 +476,54 @@ -- > 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 +536,19 @@ -- > 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 +559,7 @@ -- > Windows: hasDrive "C:foo" == True -- >          hasDrive "foo" == False -- >          hasDrive "" == False-hasDrive :: FilePath -> Bool+hasDrive :: FILEPATH -> Bool hasDrive = not . null . takeDrive  @@ -502,7 +570,7 @@ -- > 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 +588,31 @@ -- > 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+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+-- 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 +620,7 @@ -- -- > dropFileName "/directory/file.ext" == "/directory/" -- > dropFileName x == fst (splitFileName x)-dropFileName :: FilePath -> FilePath+dropFileName :: FILEPATH -> FILEPATH dropFileName = fst . splitFileName  @@ -557,12 +628,12 @@ -- -- > 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 +645,7 @@ -- > 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 +655,7 @@ -- > 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 +665,16 @@ -- -- > 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 +682,8 @@ -- > 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 +692,18 @@ -- >           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 +713,32 @@ -- > 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 +782,7 @@ -- -- > Windows: "D:\\foo" </> "C:bar" == "C:bar" -- > Windows: "C:\\foo" </> "C:bar" == "C:bar"-(</>) :: FilePath -> FilePath -> FilePath+(</>) :: FILEPATH -> FILEPATH -> FILEPATH (</>) = combine  @@ -720,13 +795,14 @@ -- > 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 +817,20 @@ -- >          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 +840,7 @@ --------------------------------------------------------------------- -- 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 +855,7 @@ -- > 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 +886,26 @@ -- > 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+  | 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 | hasLeadingPathSeparator x && not (hasDrive x) = tail x-        dropAbs x = dropDrive x+    -- on windows, need to drop '/' which is kind of absolute, but not a drive+    dropAbs x | not (null x) && isPathSeparator (head 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+    takeAbs x | not (null x) && 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 +939,71 @@ -- > 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)+normalise :: FILEPATH -> FILEPATH+normalise filepath =+  result <>+  (if addPathSeparator+       then singleton pathSeparator+       else mempty)+  where+    (drv,pth) = splitDrive filepath -        joinDrive' "" "" = "."-        joinDrive' d p = joinDrive d p+    result = joinDrive' (normaliseDrive drv) (f pth) -        addPathSeparator = isDirPath pth-            && not (hasTrailingPathSeparator result)-            && not (isRelativeDrive drv)+    joinDrive' d p+      = if null d && null p+           then singleton _period+           else joinDrive d p -        isDirPath xs = hasTrailingPathSeparator xs-            || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs)+    addPathSeparator = isDirPath filepath+      && not (hasTrailingPathSeparator result)+      && not (isRelativeDrive drv) -        f = joinPath . dropDots . propSep . splitDirectories+    isDirPath xs = hasTrailingPathSeparator xs+        || not (null xs) && last xs == _period+           && hasTrailingPathSeparator (init xs) -        propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs-                       | otherwise = x : xs-        propSep [] = []+    f = joinPath . dropDots . propSep . splitDirectories -        dropDots = filter ("." /=)+    propSep (x:xs)+      | all isPathSeparator x = singleton pathSeparator : xs+      | otherwise                   = x : xs+    propSep [] = [] -normaliseDrive :: FilePath -> FilePath-normaliseDrive "" = ""-normaliseDrive _ | isPosix = [pathSeparator]-normaliseDrive drive = if isJust $ readDriveLetter x2-                       then map toUpper x2-                       else x2-    where-        x2 = map repSlash drive+    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+        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` ":*?><|\""+isBadCHARacter :: CHAR -> Bool+isBadCHARacter x = x >= _nul && x <= _US+  || x `L.elem`+      [ _less+      , _greater+      , _colon+      , _quotedbl+      , _bar+      , _question+      , _asterisk+      ] -badElements :: [FilePath]-badElements =+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 +1023,22 @@ -- > 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,27 +1054,28 @@ -- > 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 -        validChars = map f-        f x = if isBadCharacter x then '_' else x+  where+    (drv,pth) = splitDrive path -        validElements x = joinPath $ map g $ splitPath x-        g x = h a ++ b-            where (a,b) = break isPathSeparator x-        h x = if map toUpper (dropWhileEnd (== ' ') a) `elem` badElements then a ++ "_" <.> b else x-            where (a,b) = splitExtensions x+    validCHARs = map f+    f x = if isBadCHARacter x then _underscore else x +    validElements = joinPath . fmap g . splitPath+    g x = h a <> b+        where (a,b) = break isPathSeparator x+    h x = if map toUpper (dropWhileEnd (== _space) a) `L.elem` badElements then snoc a _underscore  <.> b else x+        where (a,b) = splitExtensions x + -- | Is a path relative, or is it fixed to the root? -- -- > Windows: isRelative "path\\test" == True@@ -1002,7 +1098,7 @@ -- * "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 +1107,7 @@ -- 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 +1115,10 @@ -- | @not . 'isRelative'@ -- -- > isAbsolute x == not (isRelative x)-isAbsolute :: FilePath -> Bool+isAbsolute :: FILEPATH -> Bool isAbsolute = not . isRelative +#ifndef OS_PATH  ----------------------------------------------------------------------------- -- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2])@@ -1045,4 +1142,109 @@ -- Nothing if the list did not end with the suffix given, or Just the list -- before the suffix, if it does. stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]-stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys)+stripSuffix xs ys = reverse P.<$> stripPrefix (reverse xs) (reverse ys)+++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+{- HLINT ignore "Redundant lambda" -}+snoc str = \c -> str <> [c]++#else+#ifdef WINDOWS+fromString :: P.String -> STRING+fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do+  r <- try @SomeException $ GHC.withCStringLen (mkUTF16le ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr+  evaluate $ force $ first displayException r+#else+fromString :: P.String -> STRING+fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do+  r <- try @SomeException $ GHC.withCStringLen (mkUTF8 ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr+  evaluate $ force $ first displayException r+#endif++_a, _z, _A, _Z, _period, _quotedbl, _backslash, _slash, _question, _U, _N, _C, _colon, _semicolon, _US, _less, _greater, _bar, _asterisk, _nul, _space, _underscore :: CHAR+_a = 0x61+_z = 0x7a+_A = 0x41+_Z = 0x5a+_period = 0x2e+_quotedbl = 0x22+_slash = 0x2f+_backslash = 0x5c+_question = 0x3f+_colon = 0x3a+_semicolon = 0x3b+_U = 0x55+_N = 0x4e+_C = 0x43+_US = 0x1f+_less = 0x3c+_greater = 0x3e+_bar = 0x7c+_asterisk = 0x2a+_nul = 0x00+_space = 0x20+_underscore = 0x5f++isAsciiUpper :: CHAR -> Bool+isAsciiUpper w = _A <= w && w <= _Z++isAsciiLower :: CHAR -> Bool+isAsciiLower w = _a <= w && w <= _z++----------------------------------------------------------------++toUpper :: CHAR -> CHAR+-- charToWord16 should be safe here, since C.toUpper doesn't go beyond Word16 maxbound+toUpper = charToWord . C.toUpper . wordToChar++toLower :: CHAR -> CHAR+-- charToWord16 should be safe here, since C.toLower doesn't go beyond Word16 maxbound+toLower = charToWord . C.toLower . wordToChar+++-- | Total conversion to char.+wordToChar :: CHAR -> Char+wordToChar = C.chr . fromIntegral++-- | This is unsafe and clamps at Word16 maxbound.+charToWord :: Char -> CHAR+charToWord = fromIntegral . C.ord++#endif

@@ -1,1048 +1,7 @@----{-# 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)+{-# LANGUAGE CPP #-}++#undef WINDOWS+#define IS_WINDOWS False+#define MODULE_NAME Posix++#include "Internal.hs"

@@ -1,1048 +1,8 @@----{-# 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)+{-# LANGUAGE CPP #-}++#undef POSIX+#define WINDOWS+#define IS_WINDOWS True+#define MODULE_NAME Windows++#include "Internal.hs"

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

@@ -0,0 +1,6 @@+module System.OsPath where++import System.OsPath.Types+    ( OsPath )++isValid :: OsPath -> Bool

@@ -0,0 +1,1437 @@+{-# LANGUAGE TypeApplications #-}+-- This template expects CPP definitions for:+--+--     WINDOWS defined? = no            | yes              | no+--     POSIX   defined? = yes           | no               | no+--+--     FILEPATH_NAME    = PosixPath     | WindowsPath  | OsPath+--     OSSTRING_NAME    = PosixString   | WindowsString    | OsString+--     WORD_NAME        = PosixChar     | WindowsChar      | OsChar++-- For (native) abstract file paths we document both platforms, so people can+-- understand how their code is compiled no matter what. But for the+-- platform-specific types we only want to document the behavior on that+-- platform.+#if defined(WINDOWS)+#define WINDOWS_DOC+#elif defined(POSIX)+#define POSIX_DOC+#endif++#ifdef WINDOWS+module System.OsPath.Windows+#elif defined(POSIX)+module System.OsPath.Posix+#else+module System.OsPath+#endif+  (+  -- * Types+#ifdef WINDOWS+    WindowsString+  , WindowsChar+  , WindowsPath+#elif defined(POSIX)+    PosixString+  , PosixChar+  , PosixPath+#else+    OsPath+  , OsString+  , OsChar+#endif+  -- * Filepath construction+  , PS.encodeUtf+  , PS.encodeWith+  , PS.encodeFS+#if defined(WINDOWS) || defined(POSIX)+  , pstr+#else+  , osp+#endif+  , PS.pack++  -- * Filepath deconstruction+  , PS.decodeUtf+  , PS.decodeWith+  , PS.decodeFS+  , PS.unpack++  -- * 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.OsPath.Types+import System.OsString.Windows as PS+    ( unsafeFromChar+    , toChar+    , decodeUtf+    , decodeWith+    , decodeFS+    , pack+    , encodeUtf+    , encodeWith+    , encodeFS+    , unpack+    )+import Data.Bifunctor ( bimap )+import qualified System.OsPath.Windows.Internal as C+import GHC.IO.Encoding.UTF16 ( mkUTF16le )+import Language.Haskell.TH.Quote+    ( QuasiQuoter (..) )+import Language.Haskell.TH.Syntax+    ( Lift (..), lift )+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )+import Control.Monad ( when )++#elif defined(POSIX)+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )+import Control.Monad ( when )+import Language.Haskell.TH.Quote+    ( QuasiQuoter (..) )+import Language.Haskell.TH.Syntax+    ( Lift (..), lift )++import GHC.IO.Encoding.UTF8 ( mkUTF8 )+import System.OsPath.Types+import System.OsString.Posix as PS+    ( unsafeFromChar+    , toChar+    , decodeUtf+    , decodeWith+    , decodeFS+    , pack+    , encodeUtf+    , encodeWith+    , encodeFS+    , unpack+    )+import Data.Bifunctor ( bimap )+import qualified System.OsPath.Posix.Internal as C++#else++import System.OsPath.Internal as PS+    ( osp+    , decodeUtf+    , decodeWith+    , decodeFS+    , pack+    , encodeUtf+    , encodeWith+    , encodeFS+    , unpack+    )+import System.OsPath.Types+    ( OsPath )+import System.OsString ( unsafeFromChar, toChar )++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+import qualified System.OsPath.Windows as C+#else+import qualified System.OsPath.Posix as C+#endif++import Data.Bifunctor+    ( bimap )+#endif+import System.OsString.Internal.Types+++------------------------+-- Separator predicates+++#ifdef WINDOWS_DOC+-- | The character that separates directories. In the case where more than+--   one character is possible, 'pathSeparator' is the \'ideal\' one.+--+-- > pathSeparator == '\\'S+#elif defined(POSIX_DOC)+-- | The character that separates directories. In the case where more than+--   one character is possible, 'pathSeparator' is the \'ideal\' one.+--+-- > pathSeparator ==  '/'+#else+-- | The character that separates directories. In the case where more than+--   one character is possible, 'pathSeparator' is the \'ideal\' one.+--+-- > Windows: pathSeparator == '\\'S+-- > Posix:   pathSeparator ==  '/'+#endif+pathSeparator :: WORD_NAME+pathSeparator = WORD_NAME C.pathSeparator++#ifdef WINDOWS_DOC+-- | The list of all possible separators.+--+-- > pathSeparators == ['\\', '/']+-- > pathSeparator `elem` pathSeparators+#elif defined(POSIX_DOC)+-- | The list of all possible separators.+--+-- > pathSeparators == ['/']+-- > pathSeparator `elem` pathSeparators+#else+-- | The list of all possible separators.+--+-- > Windows: pathSeparators == ['\\', '/']+-- > Posix:   pathSeparators == ['/']+-- > pathSeparator `elem` pathSeparators+#endif+pathSeparators :: [WORD_NAME]+pathSeparators = WORD_NAME <$> 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 (WORD_NAME w) = C.isPathSeparator w++#ifdef WINDOWS_DOC+-- | The character that is used to separate the entries in the $PATH environment variable.+--+-- > searchPathSeparator == ';'+#elif defined(POSIX_DOC)+-- | The character that is used to separate the entries in the $PATH environment variable.+--+-- > searchPathSeparator == ':'+#else+-- | The character that is used to separate the entries in the $PATH environment variable.+--+-- > Posix:   searchPathSeparator == ':'+-- > Windows: searchPathSeparator == ';'+#endif+searchPathSeparator :: WORD_NAME+searchPathSeparator = WORD_NAME C.searchPathSeparator++-- | Is the character a file separator?+--+-- > isSearchPathSeparator a == (a == searchPathSeparator)+isSearchPathSeparator :: WORD_NAME -> Bool+isSearchPathSeparator (WORD_NAME w) = C.isSearchPathSeparator w+++-- | File extension character+--+-- > extSeparator == '.'+extSeparator :: WORD_NAME+extSeparator = WORD_NAME C.extSeparator+++-- | Is the character an extension character?+--+-- > isExtSeparator a == (a == extSeparator)+isExtSeparator :: WORD_NAME -> Bool+isExtSeparator (WORD_NAME w) = C.isExtSeparator w+++---------------------------------------------------------------------+-- Path methods (environment $PATH)++#ifdef WINDOWS_DOC+-- | Take a string, split it on the 'searchPathSeparator' character.+--+--   Blank items are ignored and path elements are stripped of quotes.+--+-- > splitSearchPath "File1;File2;File3"  == ["File1","File2","File3"]+-- > splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]+-- > splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"]+#elif defined(POSIX_DOC)+-- | Take a string, split it on the 'searchPathSeparator' character.+--+--   Blank items are converted to @.@ on , and quotes are not+--   treated specially.+--+--   Follows the recommendations in+--   <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>+--+-- > splitSearchPath "File1:File2:File3"  == ["File1","File2","File3"]+-- > splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]+#else+-- | Take a string, split it on the 'searchPathSeparator' character.+--+--   On Windows, blank items are ignored on Windows, and path elements are+--   stripped of quotes.+--+--   On Posix, blank items are converted to @.@ on Posix, and quotes are not+--   treated specially.+--+--   Follows the recommendations in+--   <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>+--+-- > Windows: splitSearchPath "File1;File2;File3"  == ["File1","File2","File3"]+-- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]+-- > Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"]+-- > Posix:   splitSearchPath "File1:File2:File3"  == ["File1","File2","File3"]+-- > Posix:   splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]+#endif+splitSearchPath :: OSSTRING_NAME -> [FILEPATH_NAME]+splitSearchPath (OSSTRING_NAME x) = fmap OSSTRING_NAME . 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 (OSSTRING_NAME x) = bimap OSSTRING_NAME OSSTRING_NAME $ 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 (OSSTRING_NAME x) = OSSTRING_NAME $ 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 (OSSTRING_NAME path) (OSSTRING_NAME ext) = OSSTRING_NAME (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 (OSSTRING_NAME x) = OSSTRING_NAME $ 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"++#ifdef WINDOWS_DOC+-- | 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"+-- > addExtension "\\\\share" ".txt" == "\\\\share\\.txt"+#elif defined(POSIX_DOC)+-- | 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"+#else+-- | 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"+#endif+addExtension :: FILEPATH_NAME -> OSSTRING_NAME -> FILEPATH_NAME+addExtension (OSSTRING_NAME bs) (OSSTRING_NAME ext) = OSSTRING_NAME $ 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 (OSSTRING_NAME 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 (OSSTRING_NAME x) (OSSTRING_NAME 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 (OSSTRING_NAME bs) (OSSTRING_NAME x) = OSSTRING_NAME <$> 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 (OSSTRING_NAME x) = bimap OSSTRING_NAME OSSTRING_NAME $ 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 (OSSTRING_NAME x) = OSSTRING_NAME $ C.dropExtensions x+++-- | Get all extensions.+--+-- > takeExtensions "/directory/path.ext" == ".ext"+-- > takeExtensions "file.tar.gz" == ".tar.gz"+takeExtensions :: FILEPATH_NAME -> OSSTRING_NAME+takeExtensions (OSSTRING_NAME x) = OSSTRING_NAME $ 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 (OSSTRING_NAME x) (OSSTRING_NAME y) = OSSTRING_NAME $ C.replaceExtensions x y+++------------------------+-- Drive functions+++#ifdef WINDOWS_DOC+-- | Split a path into a drive and a path.+--+-- > uncurry (<>) (splitDrive x) == x+-- > splitDrive "file" == ("","file")+-- > splitDrive "c:/file" == ("c:/","file")+-- > splitDrive "c:\\file" == ("c:\\","file")+-- > splitDrive "\\\\shared\\test" == ("\\\\shared\\","test")+-- > splitDrive "\\\\shared" == ("\\\\shared","")+-- > splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file")+-- > splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file")+-- > splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file")+-- > splitDrive "/d" == ("","/d")+#elif defined(POSIX_DOC)+-- | Split a path into a drive and a path.+--   \/ is a Drive.+--+-- > uncurry (<>) (splitDrive x) == x+-- > splitDrive "/test" == ("/","test")+-- > splitDrive "//test" == ("//","test")+-- > splitDrive "test/file" == ("","test/file")+-- > splitDrive "file" == ("","file")+#else+-- | 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")+#endif+splitDrive :: FILEPATH_NAME -> (FILEPATH_NAME, FILEPATH_NAME)+splitDrive (OSSTRING_NAME p) = bimap OSSTRING_NAME OSSTRING_NAME $ 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"++#ifdef WINDOWS_DOC+-- | Join a drive and the rest of the path.+--+-- > Valid x => uncurry joinDrive (splitDrive x) == x+-- > joinDrive "C:" "foo" == "C:foo"+-- > joinDrive "C:\\" "bar" == "C:\\bar"+-- > joinDrive "\\\\share" "foo" == "\\\\share\\foo"+-- > joinDrive "/:" "foo" == "/:\\foo"+#elif defined(POSIX_DOC)+-- | Join a drive and the rest of the path.+--+-- > Valid x => uncurry joinDrive (splitDrive x) == x+#else+-- | 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"+#endif+joinDrive :: FILEPATH_NAME -> FILEPATH_NAME -> FILEPATH_NAME+joinDrive (OSSTRING_NAME a) (OSSTRING_NAME b) = OSSTRING_NAME $ C.joinDrive a b+++-- | Get the drive from a filepath.+--+-- > takeDrive x == fst (splitDrive x)+takeDrive :: FILEPATH_NAME -> FILEPATH_NAME+takeDrive (OSSTRING_NAME x) = OSSTRING_NAME $ C.takeDrive x+++-- | Delete the drive, if it exists.+--+-- > dropDrive x == snd (splitDrive x)+dropDrive :: FILEPATH_NAME -> FILEPATH_NAME+dropDrive (OSSTRING_NAME x) = OSSTRING_NAME $ C.dropDrive x+++#ifdef WINDOWS_DOC+-- | Does a path have a drive.+--+-- > not (hasDrive x) == null (takeDrive x)+-- > hasDrive "C:\\foo" == True+-- > hasDrive "C:foo" == True+-- > hasDrive "foo" == False+-- > hasDrive "" == False+--+#elif defined(POSIX_DOC)+-- | Does a path have a drive.+--+-- > not (hasDrive x) == null (takeDrive x)+-- > hasDrive "/foo" == True+-- > hasDrive "foo" == False+-- > hasDrive "" == False+--+#else+-- | 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+--+#endif+hasDrive :: FILEPATH_NAME -> Bool+hasDrive (OSSTRING_NAME x) = C.hasDrive x+++#ifdef WINDOWS_DOC+-- | Is an element a drive+--+-- > isDrive "C:\\" == True+-- > isDrive "C:\\foo" == False+-- > isDrive "" == False+#elif defined(POSIX_DOC)+-- | Is an element a drive+--+-- > isDrive "/" == True+-- > isDrive "/foo" == False+-- > isDrive "" == False+#else+-- | Is an element a drive+--+-- > Posix:   isDrive "/" == True+-- > Posix:   isDrive "/foo" == False+-- > Windows: isDrive "C:\\" == True+-- > Windows: isDrive "C:\\foo" == False+-- >          isDrive "" == False+#endif+isDrive :: FILEPATH_NAME -> Bool+isDrive (OSSTRING_NAME x) = C.isDrive x+++---------------------------------------------------------------------+-- Operations on a filepath, as a list of directories++#ifdef WINDOWS_DOC+-- | 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")+-- > splitFileName "c:" == ("c:","")+#elif defined(POSIX_DOC)+-- | 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")+-- > splitFileName "/" == ("/","")+#else+-- | 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:","")+#endif+splitFileName :: FILEPATH_NAME -> (FILEPATH_NAME, FILEPATH_NAME)+splitFileName (OSSTRING_NAME x) = bimap OSSTRING_NAME OSSTRING_NAME $ 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 (OSSTRING_NAME x) (OSSTRING_NAME y) = OSSTRING_NAME $ 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 (OSSTRING_NAME x) = OSSTRING_NAME $ 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 (OSSTRING_NAME x) = OSSTRING_NAME $ 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 (OSSTRING_NAME x) = OSSTRING_NAME $ 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 (OSSTRING_NAME path) (OSSTRING_NAME name) = OSSTRING_NAME $ 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 (OSSTRING_NAME x) = C.hasTrailingPathSeparator x+++#ifdef WINDOWS_DOC+-- | Add a trailing file path separator if one is not already present.+--+-- > hasTrailingPathSeparator (addTrailingPathSeparator x)+-- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x+#elif defined(POSIX_DOC)+-- | Add a trailing file path separator if one is not already present.+--+-- > hasTrailingPathSeparator (addTrailingPathSeparator x)+-- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x+-- > addTrailingPathSeparator "test/rest" == "test/rest/"+#else+-- | 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/"+#endif+addTrailingPathSeparator :: FILEPATH_NAME -> FILEPATH_NAME+addTrailingPathSeparator (OSSTRING_NAME bs) = OSSTRING_NAME $ C.addTrailingPathSeparator bs+++#ifdef WINDOWS_DOC+-- | Remove any trailing path separators+--+-- > dropTrailingPathSeparator "file/test/" == "file/test"+-- > dropTrailingPathSeparator "/" == "/"+-- > dropTrailingPathSeparator "\\" == "\\"+#elif defined(POSIX_DOC)+-- | Remove any trailing path separators+--+-- > dropTrailingPathSeparator "file/test/" == "file/test"+-- > dropTrailingPathSeparator "/" == "/"+-- > not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x+#else+-- | Remove any trailing path separators+--+-- > dropTrailingPathSeparator "file/test/" == "file/test"+-- >           dropTrailingPathSeparator "/" == "/"+-- > Windows:  dropTrailingPathSeparator "\\" == "\\"+-- > Posix:    not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x+#endif+dropTrailingPathSeparator :: FILEPATH_NAME -> FILEPATH_NAME+dropTrailingPathSeparator (OSSTRING_NAME x) = OSSTRING_NAME $ C.dropTrailingPathSeparator x+++#ifdef WINDOWS_DOC+-- | 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"+-- > takeDirectory "foo\\bar" == "foo"+-- > takeDirectory "foo\\bar\\\\" == "foo\\bar"+-- > takeDirectory "C:\\" == "C:\\"+#elif defined(POSIX_DOC)+-- | 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"+#else+-- | 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:\\"+#endif+takeDirectory :: FILEPATH_NAME -> FILEPATH_NAME+takeDirectory (OSSTRING_NAME x) = OSSTRING_NAME $ 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 (OSSTRING_NAME file) (OSSTRING_NAME dir) = OSSTRING_NAME $ C.replaceDirectory file dir+++-- | An alias for '</>'.+combine :: FILEPATH_NAME -> FILEPATH_NAME -> FILEPATH_NAME+combine (OSSTRING_NAME a) (OSSTRING_NAME b) = OSSTRING_NAME $ C.combine a b++#ifdef WINDOWS_DOC+-- | 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@.+--+-- > "/directory" </> "file.ext" == "/directory\\file.ext"+-- > "directory" </> "/file.ext" == "/file.ext"+-- > Valid x => (takeDirectory x </> takeFileName x) `equalFilePath` x+--+--   Combined:+--+-- > "C:\\foo" </> "bar" == "C:\\foo\\bar"+-- > "home" </> "bob" == "home\\bob"+--+--   Not combined:+--+-- > "home" </> "C:\\bob" == "C:\\bob"+--+--   Not combined (tricky):+--+--   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.+--+-- > "home" </> "/bob" == "/bob"+-- > "home" </> "\\bob" == "\\bob"+-- > "C:\\home" </> "\\bob" == "\\bob"+--+--   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.+--+-- > "D:\\foo" </> "C:bar" == "C:bar"+-- > "C:\\foo" </> "C:bar" == "C:bar"+#elif defined(POSIX_DOC)+-- | 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@.+--+-- > "/directory" </> "file.ext" == "/directory/file.ext"+-- > Valid x => (takeDirectory x </> takeFileName x) `equalFilePath` x+--+--   Combined:+--+-- > "/" </> "test" == "/test"+-- > "home" </> "bob" == "home/bob"+-- > "x:" </> "foo" == "x:/foo"+--+--   Not combined:+--+-- > "home" </> "/bob" == "/bob"+#else+-- | 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"+#endif+(</>) :: FILEPATH_NAME -> FILEPATH_NAME -> FILEPATH_NAME+(</>) = combine+++#ifdef WINDOWS_DOC+-- | 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 "" == []+-- > splitPath "c:\\test\\path" == ["c:\\","test\\","path"]+#elif defined(POSIX_DOC)+-- | 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 "" == []+-- > splitPath "/file/test" == ["/","file/","test"]+#else+-- | 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"]+#endif+splitPath :: FILEPATH_NAME -> [FILEPATH_NAME]+splitPath (OSSTRING_NAME bs) = OSSTRING_NAME <$> C.splitPath bs++#ifdef WINDOWS_DOC+-- | 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"]+-- > splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"]+-- > Valid x => joinPath (splitDirectories x) `equalFilePath` x+-- > splitDirectories "" == []+-- > splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"]+-- > splitDirectories "/test///file" == ["/","test","file"]+#elif defined(POSIX_DOC)+-- | 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"]+-- > Valid x => joinPath (splitDirectories x) `equalFilePath` x+-- > splitDirectories "" == []+-- > splitDirectories "/test///file" == ["/","test","file"]+#else+-- | 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"]+#endif+splitDirectories :: FILEPATH_NAME -> [FILEPATH_NAME]+splitDirectories (OSSTRING_NAME x) = OSSTRING_NAME <$> C.splitDirectories x++#ifdef WINDOWS_DOC+-- | Join path elements back together.+--+-- > joinPath z == foldr (</>) "" z+-- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext"+-- > Valid x => joinPath (splitPath x) == x+-- > joinPath [] == ""+#elif defined(POSIX_DOC)+-- | Join path elements back together.+--+-- > joinPath z == foldr (</>) "" z+-- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext"+-- > Valid x => joinPath (splitPath x) == x+-- > joinPath [] == ""+-- > joinPath ["test","file","path"] == "test/file/path"+#else+-- | 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"+#endif+joinPath :: [FILEPATH_NAME] -> FILEPATH_NAME+joinPath = foldr (</>) (OSSTRING_NAME mempty)++++++++++------------------------+-- File name manipulations+++#ifdef WINDOWS_DOC+-- | Equality of two filepaths.+--   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")+-- > equalFilePath "foo" "FOO"+-- > not (equalFilePath "C:" "C:/")+#elif defined(POSIX_DOC)+-- | Equality of two filepaths.+--   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")+-- > not (equalFilePath "foo" "FOO")+#else+-- | Equality of two filepaths.+--   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:/")+#endif+equalFilePath :: FILEPATH_NAME -> FILEPATH_NAME -> Bool+equalFilePath (OSSTRING_NAME p1) (OSSTRING_NAME p2) = C.equalFilePath p1 p2++#ifdef WINDOWS_DOC+-- | 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+-- > makeRelative "C:\\Home" "c:\\home\\bob" == "bob"+-- > makeRelative "C:\\Home" "c:/home/bob" == "bob"+-- > makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob"+-- > makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob"+-- > makeRelative "/Home" "/home/bob" == "bob"+-- > makeRelative "/" "//" == "//"+#elif defined(POSIX_DOC)+-- | 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+-- > makeRelative "/Home" "/home/bob" == "/home/bob"+-- > makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"+-- > makeRelative "/fred" "bob" == "bob"+-- > makeRelative "/file/test" "/file/test/fred" == "fred"+-- > makeRelative "/file/test" "/file/test/fred/" == "fred/"+-- > makeRelative "some/path" "some/path/a/b/c" == "a/b/c"+#else+-- | 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"+#endif+makeRelative :: FILEPATH_NAME -> FILEPATH_NAME -> FILEPATH_NAME+makeRelative (OSSTRING_NAME root) (OSSTRING_NAME path) = OSSTRING_NAME $ C.makeRelative root path++#ifdef WINDOWS_DOC+-- | Normalise a file+--+-- * \/\/ outside of the drive can be made blank+--+-- * \/ -> 'pathSeparator'+--+-- * .\/ -> \"\"+--+-- Does not remove @".."@, because of symlinks.+--+-- > normalise "c:\\file/bob\\" == "C:\\file\\bob\\"+-- > normalise "c:\\" == "C:\\"+-- > normalise "C:.\\" == "C:"+-- > normalise "\\\\server\\test" == "\\\\server\\test"+-- > normalise "//server/test" == "\\\\server\\test"+-- > normalise "c:/file" == "C:\\file"+-- > normalise "/file" == "\\file"+-- > normalise "\\" == "\\"+-- > normalise "/./" == "\\"+-- > normalise "." == "."+#elif defined(POSIX_DOC)+-- | Normalise a file+--+-- * \/\/ outside of the drive can be made blank+--+-- * \/ -> 'pathSeparator'+--+-- * .\/ -> \"\"+--+-- Does not remove @".."@, because of symlinks.+--+-- > normalise "/file/\\test////" == "/file/\\test/"+-- > normalise "/file/./test" == "/file/test"+-- > normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/"+-- > normalise "../bob/fred/" == "../bob/fred/"+-- > normalise "/a/../c" == "/a/../c"+-- > normalise "./bob/fred/" == "bob/fred/"+-- > normalise "." == "."+-- > normalise "./" == "./"+-- > normalise "./." == "./"+-- > normalise "/./" == "/"+-- > normalise "/" == "/"+-- > normalise "bob/fred/." == "bob/fred/"+-- > normalise "//home" == "/home"+#else+-- | 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"+#endif+normalise :: FILEPATH_NAME -> FILEPATH_NAME+normalise (OSSTRING_NAME filepath) = OSSTRING_NAME $ C.normalise filepath+++#ifdef WINDOWS_DOC+-- | 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+-- > isValid "c:\\test" == True+-- > isValid "c:\\test:of_test" == False+-- > isValid "test*" == False+-- > isValid "c:\\test\\nul" == False+-- > isValid "c:\\test\\prn.txt" == False+-- > isValid "c:\\nul\\file" == False+-- > isValid "\\\\" == False+-- > isValid "\\\\\\foo" == False+-- > isValid "\\\\?\\D:file" == False+-- > isValid "foo\tbar" == False+-- > isValid "nul .txt" == False+-- > isValid " nul.txt" == True+#elif defined(POSIX_DOC)+-- | 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+-- > isValid "/random_ path:*" == True+-- > isValid x == not (null x)+#else+-- | 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+#endif+isValid :: FILEPATH_NAME -> Bool+isValid (OSSTRING_NAME filepath) = C.isValid filepath+++#ifdef WINDOWS_DOC+-- | 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"+-- > makeValid "c:\\already\\/valid" == "c:\\already\\/valid"+-- > makeValid "c:\\test:of_test" == "c:\\test_of_test"+-- > makeValid "test*" == "test_"+-- > makeValid "c:\\test\\nul" == "c:\\test\\nul_"+-- > makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt"+-- > makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"+-- > makeValid "c:\\nul\\file" == "c:\\nul_\\file"+-- > makeValid "\\\\\\foo" == "\\\\drive"+-- > makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file"+-- > makeValid "nul .txt" == "nul _.txt"+#elif defined(POSIX_DOC)+-- | 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"+#else+-- | 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"+#endif+makeValid :: FILEPATH_NAME -> FILEPATH_NAME+makeValid (OSSTRING_NAME path) = OSSTRING_NAME $ C.makeValid path+++#ifdef WINDOWS_DOC+-- | Is a path relative, or is it fixed to the root?+--+-- > isRelative "path\\test" == True+-- > isRelative "c:\\test" == False+-- > isRelative "c:test" == True+-- > isRelative "c:\\" == False+-- > isRelative "c:/" == False+-- > isRelative "c:" == True+-- > isRelative "\\\\foo" == False+-- > isRelative "\\\\?\\foo" == False+-- > isRelative "\\\\?\\UNC\\foo" == False+-- > isRelative "/foo" == True+-- > isRelative "\\foo" == True+--+-- According to [1]:+--+-- * "A UNC name of any format [is never relative]."+--+-- * "You cannot use the "\\?\" prefix with a relative path."+#elif defined(POSIX_DOC)+-- | Is a path relative, or is it fixed to the root?+--+-- > isRelative "test/path" == True+-- > isRelative "/test" == False+-- > isRelative "/" == False+#else+-- | 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."+#endif+isRelative :: FILEPATH_NAME -> Bool+isRelative (OSSTRING_NAME x) = C.isRelative x+++-- | @not . 'isRelative'@+--+-- > isAbsolute x == not (isRelative x)+isAbsolute :: FILEPATH_NAME -> Bool+isAbsolute (OSSTRING_NAME x) = C.isAbsolute x

@@ -0,0 +1,175 @@+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module      : System.OsPath.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.OsPath.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 Data.ByteString.Short.Internal

@@ -0,0 +1,436 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module      :  System.OsPath.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.OsPath.Data.ByteString.Short.Word16',+-- such as byte-array operations and other stuff not meant to be exported from Word16 module.+module System.OsPath.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.OsPath.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 #-}

@@ -0,0 +1,862 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -fno-warn-name-shadowing -fexpose-all-unfoldings #-}++-- |+-- Module      :  System.OsPath.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.OsPath.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.OsPath.Data.ByteString.Short ( append, intercalate, concat, stripSuffix, stripPrefix, isInfixOf, isPrefixOf, isSuffixOf, breakSubstring, length, empty, null, ShortByteString(..), fromShort, toShort )+import System.OsPath.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) (`go` 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 -> splitAt 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)+{- HLINT ignore "Use span" -}+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'+{- HLINT ignore "Use elemIndex" -}+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]+{- HLINT ignore "Use elemIndices" -}+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+

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

@@ -0,0 +1,349 @@+{-# LANGUAGE NoImplicitPrelude+           , BangPatterns+           , TypeApplications+           , MultiWayIf+  #-}+{-# OPTIONS_GHC  -funbox-strict-fields #-}+++module System.OsPath.Encoding.Internal where++import qualified System.OsPath.Data.ByteString.Short as BS8+import qualified System.OsPath.Data.ByteString.Short.Word16 as BS16++import GHC.Base+import GHC.Real+import GHC.Num+-- import GHC.IO+import GHC.IO.Buffer+import GHC.IO.Encoding.Failure+import GHC.IO.Encoding.Types+import Data.Bits+import Control.Exception (SomeException, try, Exception (displayException), evaluate)+import qualified GHC.Foreign as GHC+import Data.Either (Either)+import GHC.IO (unsafePerformIO)+import Control.DeepSeq (force, NFData (rnf))+import Data.Bifunctor (first)+import Data.Data (Typeable)+import GHC.Show (Show (show))+import Numeric (showHex)+import Foreign.C (CStringLen)+import Data.Char (chr)+import Foreign+import Prelude (FilePath)+import GHC.IO.Encoding (getFileSystemEncoding)++-- -----------------------------------------------------------------------------+-- UCS-2 LE+--++ucs2le :: TextEncoding+ucs2le = mkUcs2le ErrorOnCodingFailure++mkUcs2le :: CodingFailureMode -> TextEncoding+mkUcs2le cfm = TextEncoding { textEncodingName = "UCS-2LE",+                              mkTextDecoder = ucs2le_DF cfm,+                              mkTextEncoder = ucs2le_EF cfm }++ucs2le_DF :: CodingFailureMode -> IO (TextDecoder ())+ucs2le_DF cfm =+  return (BufferCodec {+             encode   = ucs2le_decode,+             recover  = recoverDecode cfm,+             close    = return (),+             getState = return (),+             setState = const $ return ()+          })++ucs2le_EF :: CodingFailureMode -> IO (TextEncoder ())+ucs2le_EF cfm =+  return (BufferCodec {+             encode   = ucs2le_encode,+             recover  = recoverEncode cfm,+             close    = return (),+             getState = return (),+             setState = const $ return ()+          })+++ucs2le_decode :: DecodeBuffer+ucs2le_decode+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }+ = let+       loop !ir !ow+         | ow >= os     = done OutputUnderflow ir ow+         | ir >= iw     = done InputUnderflow ir ow+         | ir + 1 == iw = done InputUnderflow ir ow+         | otherwise = do+              c0 <- readWord8Buf iraw ir+              c1 <- readWord8Buf iraw (ir+1)+              let x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0+              ow' <- writeCharBuf oraw ow (unsafeChr x1)+              loop (ir+2) ow'++       -- lambda-lifted, to avoid thunks being built in the inner-loop:+       done why !ir !ow = return (why,+                                  if ir == iw then input{ bufL=0, bufR=0 }+                                              else input{ bufL=ir },+                                  output{ bufR=ow })+    in+    loop ir0 ow0+++ucs2le_encode :: EncodeBuffer+ucs2le_encode+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }+ = let+      done why !ir !ow = return (why,+                                 if ir == iw then input{ bufL=0, bufR=0 }+                                             else input{ bufL=ir },+                                 output{ bufR=ow })+      loop !ir !ow+        | ir >= iw     =  done InputUnderflow ir ow+        | os - ow < 2  =  done OutputUnderflow ir ow+        | otherwise = do+           (c,ir') <- readCharBuf iraw ir+           case ord c of+             x | x < 0x10000 -> do+                     writeWord8Buf oraw ow     (fromIntegral x)+                     writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8))+                     loop ir' (ow+2)+               | otherwise -> done InvalidSequence ir ow+    in+    loop ir0 ow0++-- -----------------------------------------------------------------------------+-- UTF-16b+--++-- | Mimics the base encoding for filesystem operations. This should be total on all inputs (word16 byte arrays).+--+-- Note that this has a subtle difference to 'encodeWithBaseWindows'/'decodeWithBaseWindows': it doesn't care for+-- the @0x0000@ end marker and will as such produce different results. Use @takeWhile (/= '\NUL')@ on the input+-- to recover this behavior.+utf16le_b :: TextEncoding+utf16le_b = mkUTF16le_b ErrorOnCodingFailure++mkUTF16le_b :: CodingFailureMode -> TextEncoding+mkUTF16le_b cfm = TextEncoding { textEncodingName = "UTF-16LE_b",+                                 mkTextDecoder = utf16le_b_DF cfm,+                                 mkTextEncoder = utf16le_b_EF cfm }++utf16le_b_DF :: CodingFailureMode -> IO (TextDecoder ())+utf16le_b_DF cfm =+  return (BufferCodec {+             encode   = utf16le_b_decode,+             recover  = recoverDecode cfm,+             close    = return (),+             getState = return (),+             setState = const $ return ()+          })++utf16le_b_EF :: CodingFailureMode -> IO (TextEncoder ())+utf16le_b_EF cfm =+  return (BufferCodec {+             encode   = utf16le_b_encode,+             recover  = recoverEncode cfm,+             close    = return (),+             getState = return (),+             setState = const $ return ()+          })+++utf16le_b_decode :: DecodeBuffer+utf16le_b_decode+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }+ = let+       loop !ir !ow+         | ow >= os     = done OutputUnderflow ir ow+         | ir >= iw     = done InputUnderflow ir ow+         | ir + 1 == iw = done InputUnderflow ir ow+         | otherwise = do+              c0 <- readWord8Buf iraw ir+              c1 <- readWord8Buf iraw (ir+1)+              let x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0+              if | iw - ir >= 4 -> do+                      c2 <- readWord8Buf iraw (ir+2)+                      c3 <- readWord8Buf iraw (ir+3)+                      let x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2+                      if | 0xd800 <= x1 && x1 <= 0xdbff+                         , 0xdc00 <= x2 && x2 <= 0xdfff -> do+                             ow' <- writeCharBuf oraw ow (unsafeChr ((x1 - 0xd800)*0x400 + (x2 - 0xdc00) + 0x10000))+                             loop (ir+4) ow'+                         | otherwise -> do+                             ow' <- writeCharBuf oraw ow (unsafeChr x1)+                             loop (ir+2) ow'+                 | iw - ir >= 2 -> do+                        ow' <- writeCharBuf oraw ow (unsafeChr x1)+                        loop (ir+2) ow'+                 | otherwise -> done InputUnderflow ir ow++       -- lambda-lifted, to avoid thunks being built in the inner-loop:+       done why !ir !ow = return (why,+                                  if ir == iw then input{ bufL=0, bufR=0 }+                                              else input{ bufL=ir },+                                  output{ bufR=ow })+    in+    loop ir0 ow0+++utf16le_b_encode :: EncodeBuffer+utf16le_b_encode+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }+ = let+      done why !ir !ow = return (why,+                                 if ir == iw then input{ bufL=0, bufR=0 }+                                             else input{ bufL=ir },+                                 output{ bufR=ow })+      loop !ir !ow+        | ir >= iw     =  done InputUnderflow ir ow+        | os - ow < 2  =  done OutputUnderflow ir ow+        | otherwise = do+           (c,ir') <- readCharBuf iraw ir+           case ord c of+             x | x < 0x10000 -> do+                     writeWord8Buf oraw ow     (fromIntegral x)+                     writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8))+                     loop ir' (ow+2)+               | otherwise ->+                     if os - ow < 4 then done OutputUnderflow ir ow else do+                     let x' = x - 0x10000+                         w1 = x' `div` 0x400 + 0xd800+                         w2 = x' `mod` 0x400 + 0xdc00+                     writeWord8Buf oraw ow     (fromIntegral w1)+                     writeWord8Buf oraw (ow+1) (fromIntegral (w1 `shiftR` 8))+                     writeWord8Buf oraw (ow+2) (fromIntegral w2)+                     writeWord8Buf oraw (ow+3) (fromIntegral (w2 `shiftR` 8))+                     loop ir' (ow+4)+    in+    loop ir0 ow0++-- -----------------------------------------------------------------------------+-- Windows encoding (ripped off from base)+--++cWcharsToChars_UCS2 :: [Word16] -> [Char]+cWcharsToChars_UCS2 = map (chr . fromIntegral)+++-- On Windows, wchar_t is 16 bits wide and CWString uses the UTF-16 encoding.++-- coding errors generate Chars in the surrogate range+cWcharsToChars :: [Word16] -> [Char]+cWcharsToChars = map chr . fromUTF16 . map fromIntegral+ where+  fromUTF16 :: [Int] -> [Int]+  fromUTF16 (c1:c2:wcs)+    | 0xd800 <= c1 && c1 <= 0xdbff && 0xdc00 <= c2 && c2 <= 0xdfff =+      ((c1 - 0xd800)*0x400 + (c2 - 0xdc00) + 0x10000) : fromUTF16 wcs+  fromUTF16 (c:wcs) = c : fromUTF16 wcs+  fromUTF16 [] = []++charsToCWchars :: [Char] -> [Word16]+charsToCWchars = foldr (utf16Char . ord) []+ where+  utf16Char :: Int -> [Word16] -> [Word16]+  utf16Char c wcs+    | c < 0x10000 = fromIntegral c : wcs+    | otherwise   = let c' = c - 0x10000 in+                    fromIntegral (c' `div` 0x400 + 0xd800) :+                    fromIntegral (c' `mod` 0x400 + 0xdc00) : wcs++-- -----------------------------------------------------------------------------++-- -----------------------------------------------------------------------------+-- FFI+--++withFilePathWin :: FilePath -> (Int -> Ptr Word16 -> IO a) -> IO a+withFilePathWin = withArrayLen . charsToCWchars++peekFilePathWin :: (Ptr Word16, Int) -> IO FilePath+peekFilePathWin (cp, l) = do+  cs <- peekArray l cp+  return (cWcharsToChars cs)++withFilePathPosix :: FilePath -> (CStringLen -> IO a) -> IO a+withFilePathPosix fp f = getFileSystemEncoding >>= \enc -> GHC.withCStringLen enc fp f++peekFilePathPosix :: CStringLen -> IO FilePath+peekFilePathPosix fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp++-- | Decode with the given 'TextEncoding'.+decodeWithTE :: TextEncoding -> BS8.ShortByteString -> Either EncodingException String+decodeWithTE enc ba = unsafePerformIO $ do+  r <- try @SomeException $ BS8.useAsCStringLen ba $ \fp -> GHC.peekCStringLen enc fp+  evaluate $ force $ first (flip EncodingError Nothing . displayException) r++-- | Encode with the given 'TextEncoding'.+encodeWithTE :: TextEncoding -> String -> Either EncodingException BS8.ShortByteString+encodeWithTE enc str = unsafePerformIO $ do+  r <- try @SomeException $ GHC.withCStringLen enc str $ \cstr -> BS8.packCStringLen cstr+  evaluate $ force $ first (flip EncodingError Nothing . displayException) r++-- -----------------------------------------------------------------------------+-- Encoders / decoders+--++-- | This mimics the filepath decoder base uses on unix,+-- with the small distinction that we're not truncating at NUL bytes (because we're not at+-- the outer FFI layer).+decodeWithBasePosix :: BS8.ShortByteString -> IO String+decodeWithBasePosix ba = BS8.useAsCStringLen ba $ \fp -> peekFilePathPosix fp++-- | This mimics the filepath dencoder base uses on unix,+-- with the small distinction that we're not truncating at NUL bytes (because we're not at+-- the outer FFI layer).+encodeWithBasePosix :: String -> IO BS8.ShortByteString+encodeWithBasePosix str = withFilePathPosix str $ \cstr -> BS8.packCStringLen cstr++-- | This mimics the filepath decoder base uses on windows,+-- with the small distinction that we're not truncating at NUL bytes (because we're not at+-- the outer FFI layer).+decodeWithBaseWindows :: BS16.ShortByteString -> IO String+decodeWithBaseWindows ba = BS16.useAsCWStringLen ba $ \fp -> peekFilePathWin fp++-- | This mimics the filepath dencoder base uses on windows,+-- with the small distinction that we're not truncating at NUL bytes (because we're not at+-- the outer FFI layer).+encodeWithBaseWindows :: String -> IO BS16.ShortByteString+encodeWithBaseWindows str = withFilePathWin str $ \l cstr -> BS16.packCWStringLen (cstr, l)+++-- -----------------------------------------------------------------------------+-- Types+--++data EncodingException =+    EncodingError 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)+++showEncodingException :: EncodingException -> String+showEncodingException (EncodingError desc (Just w))+    = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)+showEncodingException (EncodingError desc Nothing)+    = "Cannot decode input: " ++ desc++instance Show EncodingException where+    show = showEncodingException++instance Exception EncodingException++instance NFData EncodingException where+    rnf (EncodingError desc w) = rnf desc `seq` rnf w+++-- -----------------------------------------------------------------------------+-- Words+--++wNUL :: Word16+wNUL = 0x00

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

@@ -0,0 +1,27 @@+{-# LANGUAGE CPP #-}++#undef  WINDOWS+#define POSIX+#define IS_WINDOWS False+#define FILEPATH_NAME PosixPath+#define OSSTRING_NAME PosixString+#define WORD_NAME PosixChar++#include "Common.hs"++-- | QuasiQuote a 'PosixPath'. This accepts Unicode characters+-- and encodes as UTF-8. Runs 'isValid' on the input.+pstr :: QuasiQuoter+pstr =+  QuasiQuoter+  { quoteExp = \s -> do+      ps <- either (fail . show) pure $ encodeWith (mkUTF8 ErrorOnCodingFailure) s+      when (not $ isValid ps) $ fail ("filepath not valid: " ++ show ps)+      lift ps+  , quotePat  = \_ ->+      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)"+  }

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

@@ -0,0 +1,42 @@+{-# LANGUAGE CPP #-}++module System.OsPath.Types+  (+  -- * FilePath types+    OsPath+  , WindowsPath+  , PosixPath+  , PlatformPath++  -- * OsString reexports+  , WindowsString+  , PosixString+  , WindowsChar+  , PosixChar+  , OsString+  , OsChar+  )+where++import System.OsString.Internal.Types+++-- | Filepaths are @wchar_t*@ data on windows as passed to syscalls.+type WindowsPath = WindowsString++-- | Filepaths are @char[]@ data on unix as passed to syscalls.+type PosixPath = PosixString++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+-- | Ifdef around current platform (either 'WindowsPath' or 'PosixPath').+type PlatformPath = WindowsPath+#else+-- | Ifdef around current platform (either 'WindowsPath' or 'PosixPath').+type PlatformPath = PosixPath+#endif+++-- | Type representing filenames\/pathnames.+--+-- This type doesn't add any guarantees over 'OsString'.+type OsPath = OsString