pathtype-0.7: src/System/Path/Internal.hs

module System.Path.Internal
(
  -- * The main filepath (& dirpath) abstract type
  Path, -- kept abstract

  -- * Possible types for Path type parameters
  Abs,
  Rel,
  AbsOrRel,
  File,
  Dir,
  FileOrDir,

  -- * Type Synonyms
  AbsFile,
  RelFile,
  AbsDir,
  RelDir,
  AbsOrRelFile,
  AbsOrRelDir,
  AbsFileOrDir,
  RelFileOrDir,
  AbsOrRelFileOrDir,

  AbsPath,
  RelPath,
  FilePath,
  DirPath,
  AbsOrRelPath,
  FileOrDirPath,

  -- * Classes
  AbsRelClass(..), AbsOrRelClass(..), absRel,
  FileOrDirClass(..), FileDirClass(..), fileDir,

  -- * Path to String conversion
  toString,
  getPathString,

  -- * Constants
  rootDir,
  currentDir,
  emptyFile,

  -- * Parsing Functions
  maybePath,
  parsePath,

  -- * Checked Construction Functions
  path,
  relFile,
  relDir,
  absFile,
  absDir,
  relPath,
  absPath,
  filePath,
  dirPath,

  idAbsOrRel, idAbs, idRel,
  idFileOrDir, idFile, idDir,

  -- * Unchecked Construction Functions
  asPath,
  asRelFile,
  asRelDir,
  asAbsFile,
  asAbsDir,
  asRelPath,
  asAbsPath,
  asFilePath,
  asDirPath,

  -- * Checked Construction Functions
  mkPathAbsOrRel,
  mkPathFileOrDir,
  mkAbsPath,
  mkAbsPathFromCwd,

  -- * Basic Manipulation Functions
  (</>),
  (<.>),
  (<++>),
  addExtension,
  combine,
  dropExtension,
  dropExtensions,
  dropFileName,
  replaceExtension,
  replaceBaseName,
  replaceDirectory,
  replaceFileName,
  splitExtension,
  splitExtensions,
  splitFileName,
  takeBaseName,
  takeDirectory,
  takeExtension,
  takeExtensions,
  takeFileName,
  mapFileName,

  -- * Auxillary Manipulation Functions
  equalFilePath,
  joinPath,
  normalise,
  splitPath,
  makeRelative,
  makeRelativeMaybe,
  makeAbsolute,
  makeAbsoluteFromCwd,
  dynamicMakeAbsolute,
  dynamicMakeAbsoluteFromCwd,
  genericMakeAbsolute,
  genericMakeAbsoluteFromCwd,
  pathMap,
  dirFromFile,
  fileFromDir,
  toFileOrDir,
  fromFileOrDir,
  fileFromFileOrDir,
  dirFromFileOrDir,

  -- * Path Predicates
  isAbsolute,
  isRelative,
  isAbsoluteString,
  isRelativeString,
  hasAnExtension,
  hasExtension,

  -- * Separators
  System(..),
  extSeparator,
  searchPathSeparator,
  isExtSeparator,
  isSearchPathSeparator,

  -- * Generic Manipulation Functions
  genericAddExtension,
  genericDropExtension,
  genericDropExtensions,
  genericSplitExtension,
  genericSplitExtensions,
  genericTakeExtension,
  genericTakeExtensions,

  -- * Tests
  testAll,
  isValid,
)

where

import qualified System.Directory as SD

import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Trans.State as MS
import Control.Monad (MonadPlus, guard, liftM2, mplus, mzero)
import Control.Applicative (Const(Const), liftA2, (<$>))
import Control.DeepSeq (NFData(rnf))

import qualified Data.Monoid.HT as MonHT
import qualified Data.List.HT as ListHT
import Data.Tagged (Tagged(Tagged), untag)
import Data.Functor.Compose (Compose(Compose), getCompose)
import Data.List (isSuffixOf, isPrefixOf, stripPrefix, intersperse)
import Data.String (IsString(fromString))
import Data.Maybe.HT (toMaybe)
import Data.Maybe (fromMaybe, maybeToList)
import Data.Tuple.HT (mapFst, mapSnd)
import Data.Monoid (Monoid(mempty, mappend, mconcat), Endo(Endo), appEndo)
import Data.Char (isSpace)
import Data.Ord.HT (comparing)
import Data.Eq.HT (equating)

import Text.Show.HT (concatS)
import Text.Printf (printf)

import qualified Test.QuickCheck as QC
import Test.QuickCheck
          (Gen, Property, property, Arbitrary(arbitrary), frequency)

import Prelude hiding (FilePath)


------------------------------------------------------------------------
-- Types

newtype Abs = Abs GenComponent
data Rel = Rel
data AbsOrRel = AbsO GenComponent | RelO

absPC :: String -> Abs
absPC = Abs . PathComponent

newtype File = File GenComponent
data Dir = Dir
data FileOrDir = FileOrDir


data Generic = Generic

_osDummy :: Generic
_osDummy = Generic


-- | This is the main filepath abstract datatype
data Path os ar fd = Path ar [PathComponent os] fd

instance
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
        Eq (Path os ar fd) where
    (==)  =  equating inspectPath

instance
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
        Ord (Path os ar fd) where
    compare  =  comparing inspectPath

inspectPath ::
    Path os ar fd -> (WrapAbsRel os ar, [PathComponent os], WrapFileDir os fd)
inspectPath (Path ar pcs fd) = (WrapAbsRel ar, pcs, WrapFileDir fd)


newtype WrapAbsRel os ar = WrapAbsRel {unwrapAbsRel :: ar}

instance (System os, AbsOrRelClass ar) => Eq (WrapAbsRel os ar) where
    (==) = equating inspectAbsRel

instance (System os, AbsOrRelClass ar) => Ord (WrapAbsRel os ar) where
    compare = comparing inspectAbsRel

inspectAbsRel ::
    (AbsOrRelClass ar) =>
    WrapAbsRel os ar -> Either (PathComponent os) ()
inspectAbsRel =
    absRelPlain (Left . PathComponent) (Right ()) . unwrapAbsRel


newtype WrapFileDir os fd = WrapFileDir {unwrapFileDir :: fd}

instance (System os, FileOrDirClass fd) => Eq (WrapFileDir os fd) where
    (==) = equating inspectFileDir

instance (System os, FileOrDirClass fd) => Ord (WrapFileDir os fd) where
    compare = comparing inspectFileDir

inspectFileDir ::
    (FileOrDirClass ar) =>
    WrapFileDir os ar -> Either (PathComponent os) ()
inspectFileDir =
    fileOrDirPlain (Left . retagPC) (Right ()) (Right ()) . unwrapFileDir


{- |
We cannot have a PathComponent without phantom types plus a Tagged wrapper,
because we need specialised Eq and Ord instances.
-}
type GenComponent = PathComponent Generic

newtype PathComponent os = PathComponent String

instance (System os) => Eq (PathComponent os) where
    (==)  =  equating (applyComp canonicalize)

instance (System os) => Ord (PathComponent os) where
    compare  =  comparing (applyComp canonicalize)

applyComp :: Tagged os (String -> String) -> PathComponent os -> String
applyComp (Tagged canon) (PathComponent pc) = canon pc

retagPC :: GenComponent -> PathComponent os
retagPC (PathComponent pc) = PathComponent pc

untagPC :: PathComponent os -> GenComponent
untagPC (PathComponent pc) = PathComponent pc

selTag :: Path os ar fd -> Tagged os a -> a
selTag _ = untag


type AbsFile os = Path os Abs File
type RelFile os = Path os Rel File
type AbsDir  os = Path os Abs Dir
type RelDir  os = Path os Rel Dir
type AbsOrRelFile os = Path os AbsOrRel File
type AbsOrRelDir  os = Path os AbsOrRel Dir
type AbsFileOrDir os = Path os Abs FileOrDir
type RelFileOrDir os = Path os Rel FileOrDir
type AbsOrRelFileOrDir os = Path os AbsOrRel FileOrDir

type AbsPath  os fd = Path os Abs fd
type RelPath  os fd = Path os Rel fd
type FilePath os ar = Path os ar File
type DirPath  os ar = Path os ar Dir
type AbsOrRelPath  os fd = Path os AbsOrRel fd
type FileOrDirPath os ar = Path os ar FileOrDir

instance NFData (PathComponent os) where
    rnf (PathComponent pc) = rnf pc

instance NFData Abs where
    rnf (Abs drive) = rnf drive

instance NFData Rel where
    rnf Rel = ()

instance NFData File where
    rnf (File pc) = rnf pc

instance NFData Dir where
    rnf Dir = ()

instance NFData FileOrDir where
    rnf FileOrDir = ()

instance (AbsOrRelClass ar, FileOrDirClass fd) => NFData (Path os ar fd) where
    rnf (Path ar pcs fd) =
        rnf (absRelPlain rnf () ar, pcs, fileOrDirPlain rnf () () fd)

absRelPlain :: (AbsOrRelClass ar) => (String -> a) -> a -> ar -> a
absRelPlain fAbs fRel =
    runFuncArg $
    switchAbsOrRel
        (FuncArg $ \(Abs (PathComponent drive)) -> fAbs drive)
        (FuncArg $ \Rel -> fRel)
        (FuncArg $ \ar ->
            case ar of
                AbsO (PathComponent drive) -> fAbs drive
                RelO -> fRel)

fileDirPlain :: (FileDirClass fd) => (GenComponent -> a) -> a -> fd -> a
fileDirPlain fFile fDir =
    runFuncArg $
    switchFileDir (FuncArg $ \(File pc) -> fFile pc) (FuncArg $ \Dir -> fDir)

fileOrDirPlain ::
    (FileOrDirClass fd) => (GenComponent -> a) -> a -> a -> fd -> a
fileOrDirPlain fFile fDir fFileOrDir =
    runFuncArg $
    switchFileOrDir (FuncArg $ \(File pc) -> fFile pc)
        (FuncArg $ \Dir -> fDir) (FuncArg $ \FileOrDir -> fFileOrDir)

newtype FuncArg b a = FuncArg {runFuncArg :: a -> b}

-- I don't think this basic type of fold is appropriate for a nested datatype
-- pathFold :: a -> (a -> String -> a) -> Path ar fd -> a
-- pathFold pr f PathRoot = pr
-- pathFold pr f (FileDir d pc) = f (pathFold pr f d) (unPathComponent pc)

-- | Map over the components of the path.
--
-- >> Path.pathMap (map toLower) (absDir "/tmp/Reports/SpreadSheets") == Posix.absDir "/tmp/reports/spreadsheets"
pathMap ::
    (FileOrDirClass fd) => (String -> String) -> Path os ar fd -> Path os ar fd
pathMap f (Path ar pcs fd) = Path ar (map (pcMap f) pcs) (fdMap f fd)

fdMap :: (FileOrDirClass fd) => (String -> String) -> fd -> fd
fdMap f = appEndo $ switchFileOrDir (Endo $ fileMap f) (Endo id) (Endo id)

fileMap :: (String -> String) -> File -> File
fileMap f (File pc) = File $ pcMap f pc

pcMap :: (String -> String) -> PathComponent os -> PathComponent os
pcMap f (PathComponent s) = PathComponent (f s)


mapFilePart ::
    (GenComponent -> GenComponent) -> FilePath os ar -> FilePath os ar
mapFilePart f (Path ar pcs (File fd)) = Path ar pcs $ File $ f fd

splitFilePart ::
    (GenComponent -> (GenComponent, a)) -> FilePath os ar -> (FilePath os ar, a)
splitFilePart f (Path ar pcs (File fd)) = mapFst (Path ar pcs . File) $ f fd

mapPathDirs ::
    ([PathComponent os] -> [PathComponent os]) -> Path os ar fd -> Path os ar fd
mapPathDirs f ~(Path ar pcs fd) = Path ar (f pcs) fd


------------------------------------------------------------------------
-- Type classes and machinery for switching on Abs/Rel and File/Dir

-- | This class provides a way to prevent other modules
--   from making further 'AbsRelClass' or 'FileDirClass'
--   instances
class Private p
instance Private Abs
instance Private Rel
instance Private AbsOrRel
instance Private File
instance Private Dir
instance Private FileOrDir

-- | This class allows selective behaviour for absolute and
--   relative paths and is mostly for internal use.
class Private ar => AbsOrRelClass ar where
    {- |
    See <https://wiki.haskell.org/Closed_world_instances>
    for the used technique.
    -}
    switchAbsOrRel :: f Abs -> f Rel -> f AbsOrRel -> f ar

instance AbsOrRelClass Abs where switchAbsOrRel f _ _ = f
instance AbsOrRelClass Rel where switchAbsOrRel _ f _ = f
instance AbsOrRelClass AbsOrRel where switchAbsOrRel _ _ f = f

class AbsOrRelClass ar => AbsRelClass ar where
    switchAbsRel :: f Abs -> f Rel -> f ar

instance AbsRelClass Abs where switchAbsRel f _ = f
instance AbsRelClass Rel where switchAbsRel _ f = f

absRel ::
    (AbsOrRelClass ar) =>
    (AbsPath os fd -> a) -> (RelPath os fd -> a) -> Path os ar fd -> a
absRel fAbs fRel (Path ar pcs fd) =
    absRelPlain
        (\drive -> fAbs $ Path (Abs (PathComponent drive)) pcs fd)
        (fRel $ Path Rel pcs fd)
        ar

class AbsRelClass ar => IsAbs ar where switchAbs :: f Abs -> f ar
instance IsAbs Abs where switchAbs = id

class AbsRelClass ar => IsRel ar where switchRel :: f Rel -> f ar
instance IsRel Rel where switchRel = id


-- | This class allows selective behaviour for file and
--   directory paths and is mostly for internal use.
class Private fd => FileOrDirClass fd where
    switchFileOrDir :: f File -> f Dir -> f FileOrDir -> f fd

instance FileOrDirClass File      where switchFileOrDir f _ _ = f
instance FileOrDirClass Dir       where switchFileOrDir _ f _ = f
instance FileOrDirClass FileOrDir where switchFileOrDir _ _ f = f

switchFileOrDirPath ::
    (FileOrDirClass fd) =>
    f (FilePath os ar) -> f (DirPath os ar) -> f (FileOrDirPath os ar) ->
    f (Path os ar fd)
switchFileOrDirPath f d fd =
    getCompose $ switchFileOrDir (Compose f) (Compose d) (Compose fd)

class FileOrDirClass fd => FileDirClass fd where
    switchFileDir :: f File -> f Dir -> f fd

instance FileDirClass File where switchFileDir f _ = f
instance FileDirClass Dir  where switchFileDir _ f = f

switchFileDirPath ::
    (FileDirClass fd) =>
    f (FilePath os ar) -> f (DirPath os ar) -> f (Path os ar fd)
switchFileDirPath f d =
    getCompose $ switchFileDir (Compose f) (Compose d)

fileDir ::
    (FileDirClass fd) =>
    (FilePath os ar -> a) -> (DirPath os ar -> a) -> Path os ar fd -> a
fileDir f g = runFuncArg $ switchFileDirPath (FuncArg f) (FuncArg g)

class FileDirClass fd => IsFile fd where switchFile :: f File -> f fd
instance IsFile File where switchFile = id

class FileDirClass fd => IsDir fd where switchDir :: f Dir -> f fd
instance IsDir Dir where switchDir = id


-- | Currently not exported
_eitherFromAbsRel ::
    AbsOrRelClass ar => Path os ar fd -> Either (AbsPath os fd) (RelPath os fd)
_eitherFromAbsRel = absRel Left Right

-- | Currently not exported
_eitherFromFileDir ::
    FileDirClass fd => Path os ar fd -> Either (FilePath os ar) (DirPath os ar)
_eitherFromFileDir = fileDir Left Right

------------------------------------------------------------------------
-- Read & Show instances

{- |
We show and parse file path components
using the rather generic 'relPath' smart constructor
instead of 'relFile', 'relDir' and @relPath str :: FileOrDirPath ar@.
Otherwise handling of all cases of 'File', 'Dir' and 'FileOrDir' types
becomes pretty complicated.
-}
-- >> show (Posix.rootDir </> relDir "bla" </> relFile "blub") == "rootDir </> relPath \"bla\" </> relPath \"blub\""
-- >> show (Just (Posix.rootDir </> relDir "bla" </> relFile "blub")) == "Just (rootDir </> relPath \"bla\" </> relPath \"blub\")"
-- >> show (Posix.currentDir </> relDir "bla" </> relFile "blub") == "currentDir </> relPath \"bla\" </> relPath \"blub\""
-- >> show (Just (Posix.currentDir </> relDir "bla" </> relFile "blub")) == "Just (currentDir </> relPath \"bla\" </> relPath \"blub\")"
-- >> show (Windows.absDir "c:" </> relDir "bla" </> relFile "blub") == "absDir \"c:\" </> relPath \"bla\" </> relPath \"blub\""
-- >> show (Just (Windows.absDir "c:\\" </> relDir "bla" </> relFile "blub")) == "Just (absDir \"c:\\\\\" </> relPath \"bla\" </> relPath \"blub\")"
instance
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
        Show (Path os ar fd) where
    showsPrec = untag showsPrecTagged

showsPrecTagged ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
    Tagged os (Int -> Path os ar fd -> ShowS)
showsPrecTagged =
    flip fmap rootStringTagged $ \root d x ->
        case pathComponents x of
            (ar, pcs) ->
                showParen (d>5) $ concatS $
                intersperse
                    (showChar ' ' . showString combineOperator . showChar ' ') $
                absRelPlain
                    (\drive ->
                        if drive == root
                          then showString rootName
                          else showsCons absDirName drive)
                    (showString currentName)
                    ar :
                map (\(PathComponent pc) -> showsCons relPathName pc) pcs

showsCons :: Show a => String -> a -> ShowS
showsCons name arg  =  showString name . showChar ' ' . showsPrec 11 arg

{- |
Currently it also parses AbsOrRel and FileOrDir paths,
although these cannot be composed with the accepted combinators.
-}
-- >> read "rootDir" == Posix.rootDir
-- >> read "rootDir" == Windows.rootDir
-- >> read "currentDir" == Posix.currentDir
-- >> read "currentDir" == Windows.currentDir
-- >> let path = Posix.rootDir </> relDir "bla" </> relFile "blub" in read (show path) == path
-- >> let path = Just (Posix.rootDir </> relDir "bla" </> relFile "blub") in read (show path) == path
-- >> let path = Posix.currentDir </> relDir "bla" </> relFile "blub" in read (show path) == path
-- >> let path = Just (Posix.currentDir </> relDir "bla" </> relFile "blub") in read (show path) == path
-- >> let path = Windows.rootDir </> relDir "bla" </> relFile "blub" in read (show path) == path
-- >> let path = Just (Windows.rootDir </> relDir "bla" </> relFile "blub") in read (show path) == path
-- >> let path = Windows.absDir "c:" </> relDir "bla" </> relFile "blub" in read (show path) == path
instance
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
        Read (Path os ar fd) where
    readsPrec d = readParen (d>5) $ untag readsPrecTagged

readsPrecTagged ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
    Tagged os (ReadS (Path os ar fd))
readsPrecTagged =
    flip fmap readsSplitDrive $ \readsSplDrv ->
        let go =
                handleMismatch
                    (skipSpaces >> matchString combineOperator)
                    (return [])
                    (liftM2 (:) (fmap PathComponent $ readsCons relPathName) go)
        in  MS.runStateT $ do
                skipSpaces
                MT.lift . maybeToList =<<
                    liftM2 maybePathFromComponents readsSplDrv go

skipSpaces :: (Monad m) => MS.StateT String m ()
skipSpaces = MS.modify $ dropWhile isSpace

readsCons :: (Read a) => String -> MS.StateT String [] a
readsCons name = do
    skipSpaces
    matchString name
    MS.StateT $ readsPrec 11

handleMismatch ::
    MS.StateT s Maybe () ->
    MS.StateT s m a -> MS.StateT s m a -> MS.StateT s m a
handleMismatch act err success =
    MS.StateT $ \s0 ->
        case MS.execStateT act s0 of
           Nothing -> MS.runStateT err s0
           Just s1 -> MS.runStateT success s1

matchString :: (MonadPlus m) => String -> MS.StateT String m ()
matchString prefix =
    MS.StateT $ maybe mzero (return . (,) ()) . stripPrefix prefix

readsSplitDrive ::
    (System os, AbsOrRelClass ar) => Tagged os (MS.StateT String [] ar)
readsSplitDrive =
    flip fmap readsSplitDriveAbs $ \readsSplDrvAbs ->
        switchAbsOrRel
            readsSplDrvAbs
            readsSplitDriveRel
            (mplus
                (fmap (\(Abs drive) -> AbsO drive) readsSplDrvAbs)
                (fmap (\Rel -> RelO) readsSplitDriveRel))

readsSplitDriveAbs :: (System os) => Tagged os (MS.StateT String [] Abs)
readsSplitDriveAbs =
    flip fmap rootStringTagged $ \root ->
        fmap absPC $
            (matchString rootName >> return root)
            `mplus`
            readsCons absDirName

readsSplitDriveRel :: (MonadPlus m) => MS.StateT String m Rel
readsSplitDriveRel = matchString currentName >> return Rel


-- | Synonym of 'getPathString' intended for qualified use.
toString ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) => Path os ar fd -> String
toString = getPathString

-- | Convert the 'Path' into a plain 'String' as required for OS calls.
getPathString ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) => Path os ar fd -> String
getPathString = flip getPathStringS ""

getPathStringS ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) => Path os ar fd -> ShowS
getPathStringS x =
    case pathComponents x of
        (ar, []) ->
            absRelPlain showString (showString currentDirComponent) ar
        (ar, pcs) ->
            concatS $
            absRelPlain (\drive -> (showString drive :)) id ar $
            intersperse (showChar (selTag x pathSeparator)) $
            map (\(PathComponent pc) -> showString pc) pcs

prop_asPath_getPathString :: (System os) => AbsFile os -> Property
prop_asPath_getPathString p = property $ p == asPath (getPathString p)


------------------------------------------------------------------------
-- Constants

-- >> Posix.toString Path.rootDir == "/"
-- >> Windows.toString Path.rootDir == "\\"
rootDir :: (System os) => AbsDir os
rootDir = untag rootDirTagged

rootDirTagged :: (System os) => Tagged os (AbsDir os)
rootDirTagged = fmap (\root -> Path (absPC root) [] Dir) rootStringTagged

rootStringTagged :: (System os) => Tagged os String
rootStringTagged = fmap (\sep -> [sep]) pathSeparator

-- >> Posix.toString Path.currentDir == "."
-- >> Windows.toString Path.currentDir == "."
currentDir :: (System os) => RelDir os
currentDir = Path Rel [] Dir

{- |
This is a file with path @\"\"@.
You will not be able to create a file with this name.
We also forbid parsing @\"\"@ by 'relFile'.
You might only need this file path as intermediate step
when manipulating extensions of files like @\".bashrc\"@.
-}
emptyFile :: (System os) => RelFile os
emptyFile = Path Rel [] $ File emptyPC

emptyPC :: PathComponent os
emptyPC = PathComponent ""

rootName :: String
rootName = "rootDir"

currentName :: String
currentName = "currentDir"

currentDirComponent :: String
currentDirComponent = "."

absDirName :: String
absDirName = "absDir"

relPathName :: String
relPathName = "relPath"


------------------------------------------------------------------------
-- Parsing Functions

-- | This function is intended for checking and parsing paths
--   provided as user input.
--
-- >> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsDir) == Just "/"
-- >> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.AbsFile) == Nothing
-- >> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelDir) == Nothing
-- >> fmap Posix.toString (Posix.maybePath "/" :: Maybe Posix.RelFile) == Nothing
-- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsDir) == Just "/tmp"
-- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsFile) == Just "/tmp"
-- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelDir) == Nothing
-- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.RelFile) == Nothing
-- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsDir) == Just "/tmp"
-- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsFile) == Nothing
-- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelDir) == Nothing
-- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.RelFile) == Nothing
-- >> fmap Posix.toString (Posix.maybePath "/tmp" :: Maybe Posix.AbsOrRelFileOrDir) == Just "/tmp"
-- >> fmap Posix.toString (Posix.maybePath "/tmp/" :: Maybe Posix.AbsOrRelFileOrDir) == Just "/tmp"
-- >> fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.RelFile) == Just "file.txt"
-- >> fmap Posix.toString (Posix.maybePath "file.txt" :: Maybe Posix.AbsFile) == Nothing
-- >> fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.AbsDir) == Just "\\tmp"
-- >> fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.AbsDir) == Just "a:\\tmp"
-- >> fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.AbsDir) == Just "a:tmp"
-- >> fmap Windows.toString (Windows.maybePath "a:\\" :: Maybe Windows.AbsDir) == Just "a:\\"
-- >> fmap Windows.toString (Windows.maybePath "a:" :: Maybe Windows.AbsDir) == Just "a:"
-- >> fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.RelDir) == Just "tmp"
-- >> fmap Windows.toString (Windows.maybePath "\\tmp" :: Maybe Windows.RelDir) == Nothing
-- >> fmap Windows.toString (Windows.maybePath "a:\\tmp" :: Maybe Windows.RelDir) == Nothing
-- >> fmap Windows.toString (Windows.maybePath "a:tmp" :: Maybe Windows.RelDir) == Nothing
-- >> fmap Windows.toString (Windows.maybePath "tmp" :: Maybe Windows.AbsDir) == Nothing
maybePath ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
    String -> Maybe (Path os ar fd)
maybePath str = do
    let (ar0, pcs0, fd0) = untag makePathComponents str
    ar <-
        case ar0 of
            AbsO pc -> switchAbsOrRel (Just $ Abs pc) Nothing (Just ar0)
            RelO -> switchAbsOrRel Nothing (Just Rel) (Just ar0)
    (pcs, fd) <-
        case fd0 of
            Left FileOrDir -> arrangeComponents pcs0
            Right Dir ->
                fmap ((,) pcs0) $
                switchFileOrDir Nothing (Just Dir) (Just FileOrDir)
    return $ Path ar pcs fd

parsePath ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
    String -> Either String (Path os ar fd)
parsePath = pathWithNames arName fdName

pathWithNames ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
    Const String ar -> Const String fd ->
    String -> Either String (Path os ar fd)
pathWithNames (Const ar) (Const fd) str =
    maybe (Left (printf "\"%s\" is not a valid %s%spath" str ar fd)) Right $
    maybePath str

arName :: (AbsOrRelClass ar) => Const String ar
arName = switchAbsOrRel (Const "absolute ") (Const "relative ") (Const "")

fdName :: (FileOrDirClass fd) => Const String fd
fdName = switchFileOrDir (Const "file ") (Const "directory ") (Const "")

------------------------------------------------------------------------
-- Checked Construction Functions

-- | This function is intended for converting path strings
--   with known content, e.g. string literals, to the 'Path' type.
path ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
    String -> Path os ar fd
path = either error id . parsePath

-- | Construct a 'RelFile' from a 'String'.
--
-- >> Posix.toString (Posix.relFile "file.txt") == "file.txt"
-- >> Posix.toString (Posix.relFile "tmp") == "tmp"
relFile :: (System os) => String -> RelFile os
relFile = path

-- | Construct a 'RelDir' from a 'String'.
--
-- >> Posix.toString (Posix.relDir ".") == "."
-- >> Posix.toString (Posix.relDir "file.txt") == "file.txt"
-- >> Posix.toString (Posix.relDir "tmp") == "tmp"
relDir :: (System os) => String -> RelDir os
relDir = path

-- | Construct an 'AbsFile' from a 'String'.
--
-- >> Posix.toString (Posix.absFile "/file.txt") == "/file.txt"
-- >> Posix.toString (Posix.absFile "/tmp") == "/tmp"
absFile :: (System os) => String -> AbsFile os
absFile = path

-- | Construct an 'AbsDir' from a 'String'.
--
-- >> Posix.toString (Posix.absDir "/file.txt") == "/file.txt"
-- >> Posix.toString (Posix.absDir "/tmp") == "/tmp"
absDir :: (System os) => String -> AbsDir os
absDir = path

-- | Construct a 'RelPath fd' from a 'String'.
relPath :: (System os, FileOrDirClass fd) => String -> RelPath os fd
relPath = path

-- | Construct an 'AbsPath fd' from a 'String'.
absPath :: (System os, FileOrDirClass fd) => String -> AbsPath os fd
absPath = path

-- | Construct a 'FilePath ar' from a 'String'.
filePath :: (System os, AbsOrRelClass ar) => String -> FilePath os ar
filePath = path

-- | Construct a 'DirPath ar' from a 'String'.
dirPath :: (System os, AbsOrRelClass ar) => String -> DirPath os ar
dirPath = path



idAbsOrRel :: AbsOrRelPath os fd -> AbsOrRelPath os fd
idAbsOrRel = id

idAbs :: AbsPath os fd -> AbsPath os fd
idAbs = id

idRel :: RelPath os fd -> RelPath os fd
idRel = id


idFileOrDir :: FileOrDirPath os fd -> FileOrDirPath os fd
idFileOrDir = id

idFile :: FilePath os fd -> FilePath os fd
idFile = id

idDir :: DirPath os fd -> DirPath os fd
idDir = id


{-# DEPRECATED asPath "Use 'maybePath', 'parsePath' or 'path' instead." #-}
{-# DEPRECATED asRelFile "Use 'relFile' instead." #-}
{-# DEPRECATED asRelDir "Use 'relDir' instead." #-}
{-# DEPRECATED asAbsFile "Use 'absFile' instead." #-}
{-# DEPRECATED asAbsDir "Use 'absDir' instead." #-}
{-# DEPRECATED asRelPath "Use 'relPath' instead." #-}
{-# DEPRECATED asAbsPath "Use 'absPath' instead." #-}
{-# DEPRECATED asFilePath "Use 'filePath' instead." #-}
{-# DEPRECATED asDirPath "Use 'dirPath' instead." #-}

------------------------------------------------------------------------
-- Unchecked Construction Functions
-- NB - these construction functions are non-IO and do no checking!!

-- | Use a 'String' as a 'Path' whose type is determined by its context.
--   You should not use this and other @as*@ functions,
--   since they may silently turn a relative path to an absolute one,
--   or vice versa, or they may accept a path as file path
--   although it ends on a slash.
--   If you are certain about the string content
--   then you should use 'path'.
--   If you got the string as user input then use 'maybePath' or 'parsePath'.
--
-- >> Posix.asPath "/tmp" == Posix.absDir "/tmp"
-- >> Posix.asPath "file.txt" == Posix.relFile "file.txt"
-- >> Path.isAbsolute (Posix.asAbsDir "/tmp")
-- >> Path.isRelative (Posix.asRelDir "/tmp")
-- >> Posix.toString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp"
-- >> Posix.toString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp"
-- >> Windows.toString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp"
-- >> Windows.toString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp"
-- >> Windows.toString (Windows.asPath "a:tmp" :: Windows.AbsDir) == "a:tmp"
-- >> Windows.toString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp"
asPath ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) => String -> Path os ar fd
asPath = uncurry mkPathFromComponents . untag mkPathComponents


-- | Use a 'String' as a 'RelFile'. No checking is done.
--
-- >> Posix.toString (Posix.asRelFile "file.txt") == "file.txt"
-- >> Posix.toString (Posix.asRelFile "/file.txt") == "file.txt"
-- >> Posix.toString (Posix.asRelFile "tmp") == "tmp"
-- >> Posix.toString (Posix.asRelFile "/tmp") == "tmp"
asRelFile :: (System os) => String -> RelFile os
asRelFile = asPath

-- | Use a 'String' as a 'RelDir'. No checking is done.
--
-- >> Posix.toString (Posix.asRelDir ".") == "."
-- >> Posix.toString (Posix.asRelDir "file.txt") == "file.txt"
-- >> Posix.toString (Posix.asRelDir "/file.txt") == "file.txt"
-- >> Posix.toString (Posix.asRelDir "tmp") == "tmp"
-- >> Posix.toString (Posix.asRelDir "/tmp") == "tmp"
asRelDir :: (System os) => String -> RelDir os
asRelDir = asPath

-- | Use a 'String' as an 'AbsFile'. No checking is done.
--
-- >> Posix.toString (Posix.asAbsFile "/file.txt") == "/file.txt"
-- >> Posix.toString (Posix.asAbsFile "/tmp") == "/tmp"
asAbsFile :: (System os) => String -> AbsFile os
asAbsFile = asPath

-- | Use a 'String' as an 'AbsDir'. No checking is done.
--
-- >> Posix.toString (Posix.asAbsDir "/file.txt") == "/file.txt"
-- >> Posix.toString (Posix.asAbsDir "/tmp") == "/tmp"
asAbsDir :: (System os) => String -> AbsDir os
asAbsDir = asPath

-- | Use a 'String' as a 'RelPath fd'. No checking is done.
asRelPath :: (System os, FileOrDirClass fd) => String -> RelPath os fd
asRelPath = asPath

-- | Use a 'String' as an 'AbsPath fd'. No checking is done.
asAbsPath :: (System os, FileOrDirClass fd) => String -> AbsPath os fd
asAbsPath = asPath

-- | Use a 'String' as a 'FilePath ar'. No checking is done.
asFilePath :: (System os, AbsOrRelClass ar) => String -> FilePath os ar
asFilePath = asPath

-- | Use a 'String' as a 'DirPath ar'. No checking is done.
asDirPath :: (System os, AbsOrRelClass ar) => String -> DirPath os ar
asDirPath = asPath

-- | Forbid use of OverloadedStrings and prevent custom orphan instances
instance
    (ForbiddenSystem os, ForbiddenAbsRel ar, ForbiddenFileDir fd) =>
        IsString (Path os ar fd) where fromString = forbiddenFromString

class System os => ForbiddenSystem os where
    forbiddenFromString :: String -> Path os ar fd

class AbsRelClass ar => ForbiddenAbsRel ar where
class FileDirClass fd => ForbiddenFileDir fd where

------------------------------------------------------------------------
-- Checked Construction Functions

-- | Examines the supplied string and constructs an absolute or
-- relative path as appropriate.
--
-- >> Path.mkPathAbsOrRel "/tmp" == Left (Posix.absDir "/tmp")
-- >> Path.mkPathAbsOrRel  "tmp" == Right (Posix.relDir "tmp")
-- >> Path.mkPathAbsOrRel "\\tmp" == Left (Windows.absDir "\\tmp")
-- >> Path.mkPathAbsOrRel "d:\\tmp" == Left (Windows.absDir "d:\\tmp")
-- >> Path.mkPathAbsOrRel "d:tmp" == Left (Windows.absDir "d:tmp")
-- >> Path.mkPathAbsOrRel "tmp" == Right (Windows.relDir "tmp")
mkPathAbsOrRel ::
    (System os, FileOrDirClass fd) =>
    String -> Either (AbsPath os fd) (RelPath os fd)
mkPathAbsOrRel = eitherAbsOrRel . asPath

eitherAbsOrRel :: AbsOrRelPath os fd -> Either (AbsPath os fd) (RelPath os fd)
eitherAbsOrRel (Path ar pcs fd) =
    case ar of
        AbsO drive -> Left $ Path (Abs drive) pcs fd
        RelO -> Right $ Path Rel pcs fd

-- | Searches for a file or directory with the supplied path string
--   and returns a 'File' or 'Dir' path as appropriate. If neither exists
--   at the supplied path, 'Nothing' is returned.
mkPathFileOrDir ::
    (System os, AbsOrRelClass ar) =>
    String -> IO (Maybe (Either (FilePath os ar) (DirPath os ar)))
mkPathFileOrDir s = do
  isfile <- SD.doesFileExist s
  isdir <- SD.doesDirectoryExist s
  case (isfile, isdir) of
    (False, False) -> return Nothing
    (True,  False) -> return $ Just $ Left $ asPath s
    (False, True ) -> return $ Just $ Right $ asPath s
    (True,  True ) -> ioError $ userError "mkPathFileOrDir - object type changed while checking"

-- | Convert a 'String' into an 'AbsPath' by interpreting it as
--   relative to the supplied directory if necessary.
--
-- >> Path.mkAbsPath (absDir "/tmp") "foo.txt" == Posix.absFile "/tmp/foo.txt"
-- >> Path.mkAbsPath (absDir "/tmp") "/etc/foo.txt" == Posix.absFile "/etc/foo.txt"
mkAbsPath ::
    (System os, FileOrDirClass fd) => AbsDir os -> String -> AbsPath os fd
mkAbsPath d = either id (makeAbsolute d) . mkPathAbsOrRel

-- | Convert a 'String' into an 'AbsPath' by interpreting it as
--   relative to the cwd if necessary.
mkAbsPathFromCwd ::
    (System os, FileOrDirClass fd) => String -> IO (AbsPath os fd)
mkAbsPathFromCwd = either return makeAbsoluteFromCwd . mkPathAbsOrRel


------------------------------------------------------------------------
-- Internal Functions for GenComponent manipulation

mkPathFromComponents ::
    (FileOrDirClass fd) => ar -> [PathComponent os] -> Path os ar fd
mkPathFromComponents ar pcs =
    uncurry (Path ar) $
    switchFileOrDir
        (mapSnd File $
         ListHT.switchR ([], emptyPC) (curry $ mapSnd untagPC) pcs)
        (pcs, Dir)
        (pcs, FileOrDir)

maybePathFromComponents ::
    (FileOrDirClass fd) => ar -> [PathComponent os] -> Maybe (Path os ar fd)
maybePathFromComponents ar pcs =
    fmap (uncurry $ Path ar) $ arrangeComponents pcs

arrangeComponents ::
    (FileOrDirClass fd) => [PathComponent os] -> Maybe ([PathComponent os], fd)
arrangeComponents pcs =
    getCompose $
    switchFileOrDir
        (Compose $ fmap (mapSnd (File . untagPC)) $ ListHT.viewR pcs)
        (Compose $ Just (pcs, Dir))
        (Compose $ Just (pcs, FileOrDir))

mkPathComponents ::
    (System os, AbsOrRelClass ar) =>
    Tagged os (String -> (ar, [PathComponent os]))
mkPathComponents =
    liftA2
        (\isSep splDriveOS ->
            mapSnd (nonEmptyComponents . ListHT.chop isSep)
             . MS.runState splDriveOS)
        isPathSeparator splitDriveOS

{- |
Parse path string independent from expectations
expressed by the type parameters.
-}
makePathComponents ::
    (System os) =>
    Tagged os (String -> (AbsOrRel, [PathComponent os], Either FileOrDir Dir))
makePathComponents =
    liftA2
        (\isSep splAbsolute str ->
            let (ar, pct) =
                    mapSnd (ListHT.chop isSep) $
                    MS.runState splAbsolute str
                (pcs1, fd) =
                    case ListHT.viewR pct of
                        Nothing -> ([], Right Dir)
                        Just (pcs, pc) ->
                            if null pc -- caused by trailing slash
                              then (pcs, Right Dir)
                              else (pct, Left FileOrDir)
            in  (ar, nonEmptyComponents pcs1, fd))
        isPathSeparator splitAbsoluteO

nonEmptyComponents :: [String] -> [PathComponent os]
nonEmptyComponents = map PathComponent . filter (not . null)

splitDriveOS ::
    (System os, AbsOrRelClass ar) => Tagged os (MS.State String ar)
splitDriveOS =
    liftA2
        (\splDrive splAbsolute ->
            switchAbsOrRel (fmap absPC splDrive) (return Rel) splAbsolute)
        splitDriveAbs splitAbsoluteO

splitDriveAbs :: (System os) => Tagged os (MS.State String String)
splitDriveAbs =
    liftA2
        (\isSep splDrive -> do
            drive <- splDrive
            xt <- MS.get
            case xt of
                [] -> return drive
                x:xs ->
                    if isSep x
                      then MS.put xs >> return (drive++[x])
                      else return drive)
        isPathSeparator splitDrive

splitAbsoluteO :: (System os) => Tagged os (MS.State String AbsOrRel)
splitAbsoluteO =
    fmap (\drive -> if null drive then RelO else AbsO $ PathComponent drive)
    <$>
    splitAbsolute

pathComponents ::
    (FileOrDirClass fd) => Path os ar fd -> (ar, [PathComponent os])
pathComponents (Path ar pcs fd) =
    (ar, pcs ++ fileOrDirPlain ((:[]) . retagPC) [] [] fd)

prop_mkPathFromComponents_pathComponents :: (System os) => AbsDir os -> Property
prop_mkPathFromComponents_pathComponents p =
    property $ uncurry mkPathFromComponents (pathComponents p) == p



------------------------------------------------------------------------
-- Basic Manipulation Functions

combineOperator :: String
combineOperator = "</>"


instance (IsRel ar, IsDir fd) => Monoid (Path os ar fd) where
    mempty = Path relVar [] dirVar
    mappend (Path rel pcs0 _dir) (Path _rel pcs1 dir) =
        Path rel (pcs0 ++ pcs1) dir
    mconcat paths =
        Path relVar (concatMap (\(Path _rel pcs _dir) -> pcs) paths) dirVar

relVar :: IsRel ar => ar
relVar = unwrapAbsRel $ switchRel $ WrapAbsRel Rel

dirVar :: IsDir fd => fd
dirVar = unwrapFileDir $ switchDir $ WrapFileDir Dir


-- | Infix variant of 'combine'.
--
-- >> Posix.toString (Posix.absDir "/tmp" </> Posix.relFile "file.txt") == "/tmp/file.txt"
-- >> Posix.toString (Posix.absDir "/tmp" </> Posix.relDir "dir" </> Posix.relFile "file.txt") == "/tmp/dir/file.txt"
-- >> Posix.toString (Posix.relDir "dir" </> Posix.relFile "file.txt") == "dir/file.txt"
-- >> Windows.toString (Windows.absDir "\\tmp" </> Windows.relFile "file.txt") == "\\tmp\\file.txt"
-- >> Windows.toString (Windows.absDir "c:\\tmp" </> Windows.relFile "file.txt") == "c:\\tmp\\file.txt"
-- >> Windows.toString (Windows.absDir "c:tmp" </> Windows.relFile "file.txt") == "c:tmp\\file.txt"
-- >> Windows.toString (Windows.absDir "c:\\" </> Windows.relDir "tmp" </> Windows.relFile "file.txt") == "c:\\tmp\\file.txt"
-- >> Windows.toString (Windows.absDir "c:" </> Windows.relDir "tmp" </> Windows.relFile "file.txt") == "c:tmp\\file.txt"
-- >> Windows.toString (Windows.relDir "dir" </> Windows.relFile "file.txt") == "dir\\file.txt"
(</>) :: DirPath os ar -> RelPath os fd -> Path os ar fd
Path ar pcs0 Dir  </>  Path Rel pcs1 fd  =  Path ar (pcs0 ++ pcs1) fd

infixr 5  </>

-- | Infix variant of 'addExtension'.
--   We only allow files (and not directories) to have extensions added
--   by this function. This is because it's the vastly common case and
--   an attempt to add one to a directory will - more often than not -
--   represent an error.
--   We don't however want to prevent the corresponding operation on
--   directories, and so we provide a function that is more flexible:
--   'genericAddExtension'.
(<.>) :: FilePath os ar -> String -> FilePath os ar
p <.> ext = mapFilePart (flip addExtensionPC ext) p

infixl 7  <.>

(<++>) :: FilePath os ar -> String -> FilePath os ar
p <++> str = mapFileName (++str) p

infixl 7  <++>

-- | Add an extension, even if there is already one there.
--   E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@.
--
-- >> Path.addExtension (relFile "file.txt") "bib" == Posix.relFile "file.txt.bib"
-- >> Path.addExtension (relFile "file.") ".bib" == Posix.relFile "file..bib"
-- >> Path.addExtension (relFile "file") ".bib" == Posix.relFile "file.bib"
-- >> Path.addExtension Path.emptyFile "bib" == Posix.relFile ".bib"
-- >> Path.addExtension Path.emptyFile ".bib" == Posix.relFile ".bib"
-- >> Path.takeFileName (Path.addExtension Path.emptyFile "ext") == Posix.relFile ".ext"
addExtension :: FilePath os ar -> String -> FilePath os ar
addExtension = (<.>)

-- | Join an (absolute or relative) directory path with a relative
--   (file or directory) path to form a new path.
combine :: DirPath os ar -> RelPath os fd -> Path os ar fd
combine = (</>)

prop_combine_currentDir :: (System os) => RelDir os -> Property
prop_combine_currentDir p = property $ combine currentDir p == p


-- | Remove last extension, and the \".\" preceding it.
--
-- >> Path.dropExtension x == fst (Path.splitExtension x)
dropExtension :: FilePath os ar -> FilePath os ar
dropExtension = fst . splitExtension

-- | Drop all extensions
--
-- >> not $ Path.hasAnExtension (Path.dropExtensions x)
dropExtensions :: FilePath os ar -> FilePath os ar
dropExtensions = fst . splitExtensions

-- | Synonym for 'takeDirectory'
dropFileName :: FilePath os ar -> DirPath os ar
dropFileName = fst . splitFileName


-- | Set the extension of a file, overwriting one if already present.
--
-- >> Path.replaceExtension (relFile "file.txt") ".bob" == Posix.relFile "file.bob"
-- >> Path.replaceExtension (relFile "file.txt") "bob" == Posix.relFile "file.bob"
-- >> Path.replaceExtension (relFile "file") ".bob" == Posix.relFile "file.bob"
-- >> Path.replaceExtension (relFile "file.txt") "" == Posix.relFile "file"
-- >> Path.replaceExtension (relFile "file.fred.bob") "txt" == Posix.relFile "file.fred.txt"
replaceExtension :: FilePath os ar -> String -> FilePath os ar
replaceExtension p ext = dropExtension p <.> ext

replaceBaseName :: FilePath os ar -> String -> FilePath os ar
replaceBaseName p bn =
    mapFilePart (addExtensionPC (PathComponent bn) . snd . splitExtensionPC) p

replaceDirectory :: FilePath os ar1 -> DirPath os ar2 -> FilePath os ar2
replaceDirectory (Path _ _ fd) (Path ar pcs _) = Path ar pcs fd

replaceFileName :: FilePath os ar -> String -> FilePath os ar
replaceFileName p fn = mapFilePart (const (PathComponent fn)) p


-- | Split on the extension. 'addExtension' is the inverse.
--
-- >> uncurry (<.>) (Path.splitExtension x) == x
-- >> uncurry Path.addExtension (Path.splitExtension x) == x
-- >> Path.splitExtension (relFile "file.txt") == (Posix.relFile "file",".txt")
-- >> Path.splitExtension (relFile ".bashrc") == (Posix.emptyFile, ".bashrc")
-- >> Path.splitExtension (relFile "file") == (Posix.relFile "file","")
-- >> Path.splitExtension (relFile "file/file.txt") == (Posix.relFile "file/file",".txt")
-- >> Path.splitExtension (relFile "file.txt/boris") == (Posix.relFile "file.txt/boris","")
-- >> Path.splitExtension (relFile "file.txt/boris.ext") == (Posix.relFile "file.txt/boris",".ext")
-- >> Path.splitExtension (relFile "file/path.txt.bob.fred") == (Posix.relFile "file/path.txt.bob",".fred")
splitExtension :: FilePath os ar -> (FilePath os ar, String)
splitExtension = splitFilePart splitExtensionPC

-- | Split on all extensions
--
-- >> Path.splitExtensions (relFile "file.tar.gz") == (Posix.relFile "file",".tar.gz")
splitExtensions :: FilePath os ar -> (FilePath os ar, String)
splitExtensions = splitFilePart splitExtensionsPC

prop_split_combineExt :: (System os) => AbsFile os -> Property
prop_split_combineExt p = property $ p == uncurry (<.>) (splitExtension p)

splitFileName :: FilePath os ar -> (DirPath os ar, RelFile os)
splitFileName (Path ar pcs fd) = (Path ar pcs Dir, Path Rel [] fd)

prop_split_combine :: (System os) => AbsFile os -> Property
prop_split_combine p = property $ uncurry combine (splitFileName p) == p


-- | Get the basename of a file
--
-- >> Path.takeBaseName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile"
-- >> Path.takeBaseName (relFile "./myfile.txt") == Posix.relFile "myfile"
-- >> Path.takeBaseName (relFile "myfile.txt") == Posix.relFile "myfile"
takeBaseName :: FilePath os ar -> RelFile os
takeBaseName = takeFileName . dropExtension

takeDirectory :: FilePath os ar -> DirPath os ar
takeDirectory = fst . splitFileName

-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
--
-- >> Path.takeExtension x == snd (Path.splitExtension x)
-- >> Path.takeExtension (Path.addExtension x "ext") == ".ext"
-- >> Path.takeExtension (Path.replaceExtension x "ext") == ".ext"
takeExtension :: FilePath os ar -> String
takeExtension = snd . splitExtension

-- | Get all extensions
--
-- >> Path.takeExtensions (Posix.relFile "file.tar.gz") == ".tar.gz"
takeExtensions :: FilePath os ar -> String
takeExtensions = snd . splitExtensions

-- | Get the filename component of a file path (ie stripping all parent dirs)
--
-- >> Path.takeFileName (absFile "/tmp/somedir/myfile.txt") == Posix.relFile "myfile.txt"
-- >> Path.takeFileName (relFile "./myfile.txt") == Posix.relFile "myfile.txt"
-- >> Path.takeFileName (relFile "myfile.txt") == Posix.relFile "myfile.txt"
takeFileName :: FilePath os ar -> RelFile os
takeFileName (Path _ _ fd) = Path Rel [] fd

prop_takeFileName_end :: (System os) => AbsFile os -> Property
prop_takeFileName_end p =
    property $ getPathString (takeFileName p) `isSuffixOf` getPathString p

mapFileName :: (String -> String) -> FilePath os ar -> FilePath os ar
mapFileName = mapFilePart . pcMap


------------------------------------------------------------------------
-- Auxillary Manipulation Functions

-- | Check whether two strings are equal as file paths.
--
-- >>       Posix.equalFilePath "abc/def" "abc/def"
-- >>       Posix.equalFilePath "abc/def" "abc//def"
-- >>       Posix.equalFilePath "/tmp/" "/tmp"
-- >>       Posix.equalFilePath "/tmp" "//tmp"
-- >>       Posix.equalFilePath "/tmp" "///tmp"
-- >> not $ Posix.equalFilePath "abc" "def"
-- >> not $ Posix.equalFilePath "/tmp" "tmp"
-- >>       Windows.equalFilePath "abc\\def" "abc\\def"
-- >>       Windows.equalFilePath "abc\\def" "abc\\\\def"
-- >>       Windows.equalFilePath "file" "File"
-- >>       Windows.equalFilePath "\\file" "\\\\file"
-- >>       Windows.equalFilePath "\\file" "\\\\\\file"
-- >> not $ Windows.equalFilePath "abc" "def"
-- >> not $ Windows.equalFilePath "file" "dir"
equalFilePath :: (System os) => Tagged os (String -> String -> Bool)
equalFilePath = equating <$> mkPathAbsOrRelTagged

mkPathAbsOrRelTagged ::
    (System os) =>
    Tagged os (String -> Either (AbsFileOrDir os) (RelFileOrDir os))
mkPathAbsOrRelTagged = Tagged mkPathAbsOrRel

-- | Constructs a 'RelPath' from a list of components.
--   It is an unchecked error if the path components contain path separators.
--   It is an unchecked error if a 'RelFile' path is empty.
--
-- >> Path.joinPath ["tmp","someDir","dir"] == Posix.relDir "tmp/someDir/dir"
-- >> Path.joinPath ["tmp","someDir","file.txt"] == Posix.relFile "tmp/someDir/file.txt"
joinPath :: (FileOrDirClass fd) => [String] -> RelPath os fd
joinPath = mkPathFromComponents Rel . map PathComponent

-- | Currently just transforms:
--
-- >> Path.normalise (absFile "/tmp/fred/./jim/./file") == Posix.absFile "/tmp/fred/jim/file"
normalise :: (System os) => Path os ar fd -> Path os ar fd
normalise = mapPathDirs (filter (PathComponent currentDirComponent /=))

-- | Deconstructs a path into its components.
--
-- >> Path.splitPath (Posix.absDir "/tmp/someDir/mydir.dir") == (True, map relDir ["tmp","someDir","mydir.dir"], Nothing)
-- >> Path.splitPath (Posix.absFile "/tmp/someDir/myfile.txt") == (True, map relDir ["tmp","someDir"], Just $ relFile "myfile.txt")
splitPath ::
    (AbsOrRelClass ar, FileDirClass fd) =>
    Path os ar fd -> (Bool, [RelDir os], Maybe (RelFile os))
splitPath (Path ar pcs fd) =
    (isAbsolutePlain ar,
     map (\pc -> Path Rel [pc] Dir) pcs,
     maybeFileDir fd)

isAbsolutePlain :: (AbsOrRelClass ar) => ar -> Bool
isAbsolutePlain = absRelPlain (const True) False

maybeFileDir :: (FileDirClass fd) => fd -> Maybe (RelFile os)
maybeFileDir = fileDirPlain (Just . Path Rel [] . File) Nothing

-- | This function can be used to construct a relative path by removing
--   the supplied 'AbsDir' from the front. It is a runtime 'error' if the
--   supplied 'AbsPath' doesn't start with the 'AbsDir'.
--
-- >> Path.makeRelative (absDir "/tmp/somedir") (absFile "/tmp/somedir/anotherdir/file.txt") == Posix.relFile "anotherdir/file.txt"
-- >> Path.makeRelative (absDir "/tmp/somedir") (absDir "/tmp/somedir/anotherdir/dir") == Posix.relDir "anotherdir/dir"
-- >> Path.makeRelative (absDir "c:\\tmp\\somedir") (absFile "C:\\Tmp\\SomeDir\\AnotherDir\\File.txt") == Windows.relFile "AnotherDir\\File.txt"
-- >> Path.makeRelative (absDir "c:\\tmp\\somedir") (absDir "c:\\tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir"
-- >> Path.makeRelative (absDir "c:tmp\\somedir") (absDir "c:tmp\\somedir\\anotherdir\\dir") == Windows.relDir "anotherdir\\dir"
makeRelative ::
    (System os, FileOrDirClass fd) =>
    AbsDir os -> AbsPath os fd -> RelPath os fd
makeRelative relTo orig =
    fromMaybe
        (error $
            printf "System.Path can't make (%s) relative to (%s)"
                (getPathString orig) (getPathString relTo)) $
    makeRelativeMaybe relTo orig

-- >> Path.makeRelativeMaybe (Posix.absDir "/tmp/somedir") (absFile "/tmp/anotherdir/file.txt") == Nothing
-- >> Path.makeRelativeMaybe (Posix.absDir "/Tmp") (absFile "/tmp/anotherdir/file.txt") == Nothing
-- >> Path.makeRelativeMaybe (Windows.absDir "\\Tmp") (absFile "\\tmp\\anotherdir\\file.txt") == Just (relFile "anotherdir\\file.txt")
makeRelativeMaybe ::
    (System os, FileOrDirClass fd) =>
    AbsDir os -> AbsPath os fd -> Maybe (RelPath os fd)
makeRelativeMaybe relTo orig =
    case (inspectPath relTo, inspectPath orig) of
        ((relToAR, relToPCs, WrapFileDir Dir),
         (origAR, origPCs, WrapFileDir fd)) ->
            fmap (flip (Path Rel) fd) $
                guard (relToAR == origAR) >> stripPrefix relToPCs origPCs

-- | Joins an absolute directory with a relative path to construct a
--   new absolute path.
--
-- >> Path.makeAbsolute (absDir "/tmp") (relFile "file.txt")      == Posix.absFile "/tmp/file.txt"
-- >> Path.makeAbsolute (absDir "/tmp") (relFile "adir/file.txt") == Posix.absFile "/tmp/adir/file.txt"
-- >> Path.makeAbsolute (absDir "/tmp") (relDir  "adir/dir")      == Posix.absDir "/tmp/adir/dir"
makeAbsolute :: (System os) => AbsDir os -> RelPath os fd -> AbsPath os fd
makeAbsolute = genericMakeAbsolute

-- | Converts a relative path into an absolute one by
--   prepending the current working directory.
makeAbsoluteFromCwd :: (System os) => RelPath os fd -> IO (AbsPath os fd)
makeAbsoluteFromCwd = genericMakeAbsoluteFromCwd

dynamicMakeAbsolute ::
    (System os) => AbsDir os -> AbsOrRelPath os fd -> AbsPath os fd
dynamicMakeAbsolute = genericMakeAbsolute

dynamicMakeAbsoluteFromCwd ::
    (System os) => AbsOrRelPath os fd -> IO (AbsPath os fd)
dynamicMakeAbsoluteFromCwd = genericMakeAbsoluteFromCwd

-- | As for 'makeAbsolute', but for use when the path may already be
--   absolute (in which case it is left unchanged).
--   You should avoid the use of 'genericMakeAbsolute'-type functions,
--   because then you avoid to absolutize a path that was already absolutized.
--
-- >> Path.genericMakeAbsolute (absDir "/tmp") (relFile "file.txt")       == Posix.absFile "/tmp/file.txt"
-- >> Path.genericMakeAbsolute (absDir "/tmp") (relFile "adir/file.txt")  == Posix.absFile "/tmp/adir/file.txt"
-- >> Path.genericMakeAbsolute (absDir "/tmp") (absFile "/adir/file.txt") == Posix.absFile "/adir/file.txt"
genericMakeAbsolute ::
    (System os, AbsOrRelClass ar) => AbsDir os -> Path os ar fd -> AbsPath os fd
genericMakeAbsolute base p = absRel id (base </>) p

-- | As for 'makeAbsoluteFromCwd', but for use when the path may already be
--   absolute (in which case it is left unchanged).
genericMakeAbsoluteFromCwd ::
    (System os, AbsOrRelClass ar) => Path os ar fd -> IO (AbsPath os fd)
genericMakeAbsoluteFromCwd p = do
  cwdString <- SD.getCurrentDirectory -- we don't use System.Path.Directory impl here to avoid module cycle
  return $ genericMakeAbsolute (asAbsDir cwdString) p

prop_makeAbsoluteFromDir_endSame ::
    (System os) => AbsDir os -> RelFile os -> Property
prop_makeAbsoluteFromDir_endSame base p =
    property $ getPathString p `isSuffixOf` getPathString (makeAbsolute base p)

prop_makeAbsoluteFromDir_startSame ::
    (System os) => AbsDir os -> RelFile os -> Property
prop_makeAbsoluteFromDir_startSame base p =
    property $ getPathString base `isPrefixOf` getPathString (makeAbsolute base p)

-- prop_makeAbsoluteFromDir_startSameAbs :: AbsDir os -> AbsFile -> Property
-- prop_makeAbsoluteFromDir_startSameAbs base p = property $ show base `isPrefixOf` show (makeAbsolute base p)


-- | Convert a file to a directory path.
--   Obviously, the corresponding disk object won't change accordingly.
--   The purpose of this function is to be an intermediate step
--   when deriving a directory name from a file name.
dirFromFile :: FilePath os ar -> DirPath os ar
dirFromFile p = uncurry Path (pathComponents p) Dir

-- | Convert a directory to a file path.
--   The function returns 'Nothing' if the directory path is empty.
--   The purpose of this function is to be an intermediate step
--   when deriving a file name from a directory name.
fileFromDir :: DirPath os ar -> Maybe (FilePath os ar)
fileFromDir = fileFromAny

toFileOrDir :: (FileOrDirClass fd) => Path os ar fd -> FileOrDirPath os ar
toFileOrDir p = uncurry Path (pathComponents p) FileOrDir

fromFileOrDir ::
    (FileOrDirClass fd) => FileOrDirPath os ar -> Maybe (Path os ar fd)
fromFileOrDir p =
    switchFileOrDirPath
        (fileFromFileOrDir p)
        (Just $ dirFromFileOrDir p)
        (Just p)

fileFromFileOrDir :: FileOrDirPath os ar -> Maybe (FilePath os ar)
fileFromFileOrDir = fileFromAny

fileFromAny :: Path os ar fd -> Maybe (FilePath os ar)
fileFromAny (Path ar pcs _) =
    fmap (uncurry (Path ar) . mapSnd (File . untagPC)) $ ListHT.viewR pcs

dirFromFileOrDir :: FileOrDirPath os ar -> DirPath os ar
dirFromFileOrDir (Path ar pcs FileOrDir) = Path ar pcs Dir


------------------------------------------------------------------------
-- NYI - Not Yet Implemented

{-
splitSearchPath  :: String   -> [String]
getSearchPath    :: IO [String]
splitDrive       :: String   -> (String, String)
joinDrive        :: String   -> String -> String
takeDrive        :: String   -> String
hasDrive         :: String   -> Bool
dropDrive        :: String   -> String
isDrive          :: String   -> Bool
isValid          :: String   -> Bool
makeValid        :: String   -> String
-}


------------------------------------------------------------------------
-- Path Predicates

-- | Test whether a @'Path' ar fd@ is absolute.
--
-- >> Path.isAbsolute (Posix.absFile "/fred")
-- >> Path.isAbsolute (Windows.absFile "\\fred")
-- >> Path.isAbsolute (Windows.absFile "c:\\fred")
-- >> Path.isAbsolute (Windows.absFile "c:fred")
isAbsolute :: AbsOrRelClass ar => Path os ar fd -> Bool
isAbsolute = absRel (const True) (const False)

-- | Invariant - this should return True iff arg is of type @'Path' Rel _@
--
-- > isRelative = not . isAbsolute
-- >> Path.isRelative (Posix.relFile "fred")
-- >> Path.isRelative (Windows.relFile "fred")
isRelative :: AbsOrRelClass ar => Path os ar fd -> Bool
isRelative = not . isAbsolute


{- |
Test whether the 'String' would correspond
to an absolute path if interpreted as a 'Path'.
-}
isAbsoluteString :: (System os) => Tagged os (String -> Bool)
isAbsoluteString =
    fmap (\split -> not . null . MS.evalState split) splitAbsolute

{- |
Test whether the 'String' would correspond
to a relative path if interpreted as a 'Path'.

> isRelativeString = not . isAbsoluteString
-}
isRelativeString :: (System os) => Tagged os (String -> Bool)
isRelativeString = (not .) <$> isAbsoluteString


-- | Does the given filename have an extension?
--
-- >> null (Path.takeExtension x) == not (Path.hasAnExtension x)
hasAnExtension :: FilePath os ar -> Bool
hasAnExtension = not . null . snd . splitExtension

-- | Does the given filename have the given extension?
--
-- >> Path.hasExtension ".hs" (Posix.relFile "MyCode.hs")
-- >> Path.hasExtension ".hs" (Posix.relFile "MyCode.bak.hs")
-- >> not $ Path.hasExtension ".hs" (Posix.relFile "MyCode.hs.bak")
hasExtension :: String -> FilePath os ar -> Bool
hasExtension ext = (==ext) . snd . splitExtension


------------------------------------------------------------------------
-- Separators

-- | File extension character
--
-- >> Posix.extSeparator == '.'
extSeparator :: Char
extSeparator = '.'

-- | The character that is used to separate the entries in the $PATH environment variable.
--
searchPathSeparator :: Char
searchPathSeparator = ':'

-- | Is the character an extension character?
--
-- >> Posix.isExtSeparator a == (a == Posix.extSeparator)
isExtSeparator :: Char -> Bool
isExtSeparator = (== extSeparator)

-- | Is the character a file separator?
--
-- >> Posix.isSearchPathSeparator a == (a == Posix.searchPathSeparator)
isSearchPathSeparator :: Char -> Bool
isSearchPathSeparator = (== searchPathSeparator)


------------------------------------------------------------------------
-- Generic Manipulation Functions

-- These functions support manipulation of extensions on directories
-- as well as files. They have looser types than the corresponding
-- 'Basic Manipulation Functions', but it is expected that the basic
-- functions will be used more frequently as they provide more checks.

-- | This is a more flexible variant of 'addExtension' / '<.>' which can
--   work with files or directories
--
-- >> Path.genericAddExtension (absDir "/") "x" == Posix.absDir "/.x"
-- >> Path.genericAddExtension (absDir "/a") "x" == Posix.absDir "/a.x"
-- >> Path.genericAddExtension Path.emptyFile "x" == Posix.relFile ".x"
-- >> Path.genericAddExtension Path.emptyFile "" == Posix.emptyFile
genericAddExtension ::
    (FileOrDirClass fd) => Path os ar fd -> String -> Path os ar fd
genericAddExtension =
    flip $ \ext ->
        appEndo $ MonHT.when (not $ null ext) $
        switchFileOrDirPath
            (Endo $ flip addExtension ext)
            (Endo $ componentsAddExtension ext)
            (Endo $ componentsAddExtension ext)

componentsAddExtension :: String -> Path os ar fd -> Path os ar fd
componentsAddExtension ext (Path ar pcs0 fd) =
    let pcs = if null pcs0 then [emptyPC] else pcs0
    in  Path ar (mapLast (flip addExtensionPC ext) pcs) fd

genericDropExtension :: (FileOrDirClass fd) => Path os ar fd -> Path os ar fd
genericDropExtension = fst . genericSplitExtension

genericDropExtensions :: (FileOrDirClass fd) => Path os ar fd -> Path os ar fd
genericDropExtensions = fst . genericSplitExtensions

genericSplitExtension ::
    (FileOrDirClass fd) => Path os ar fd -> (Path os ar fd, String)
genericSplitExtension =
    runSplitExtension $
    switchFileOrDirPath
        (SplitExtension splitExtension)
        (SplitExtension componentsSplitExtension)
        (SplitExtension componentsSplitExtension)

componentsSplitExtension :: Path os ar b -> (Path os ar b, String)
componentsSplitExtension (Path ar pcs fd) =
    mapFst (flip (Path ar) fd) $
    mapLastPair
        (error "genericSplitExtension: empty path")
        splitExtensionPC pcs

genericSplitExtensions ::
    (FileOrDirClass fd) => Path os ar fd -> (Path os ar fd, String)
genericSplitExtensions =
    runSplitExtension $
    switchFileOrDirPath
        (SplitExtension splitExtensions)
        (SplitExtension componentsSplitExtensions)
        (SplitExtension componentsSplitExtensions)

componentsSplitExtensions :: Path os ar b -> (Path os ar b, String)
componentsSplitExtensions (Path ar pcs fd) =
    mapFst (flip (Path ar) fd) $
    mapLastPair
        (error "genericSplitExtensions: empty path")
        splitExtensionsPC pcs

genericTakeExtension :: (FileOrDirClass fd) => Path os ar fd -> String
genericTakeExtension = snd . genericSplitExtension

genericTakeExtensions :: (FileOrDirClass fd) => Path os ar fd -> String
genericTakeExtensions = snd . genericSplitExtension

newtype
    SplitExtension path =
        SplitExtension {runSplitExtension :: path -> (path, String)}


-- move to utility-ht
mapLast :: (a -> a) -> [a] -> [a]
mapLast f xs = zipWith id (drop 1 $ map (const id) xs ++ [f]) xs

mapLastPair :: b -> (a -> (a,b)) -> [a] -> ([a], b)
mapLastPair b f =
    ListHT.switchR ([], b) (\as a -> mapFst ((as++) . (:[])) $ f a)

mapLastPairFoldr :: b -> (a -> (a,b)) -> [a] -> ([a], b)
mapLastPairFoldr b _ [] = ([], b)
mapLastPairFoldr _ f (x:xs) =
    foldr
        (\y1 go y0 -> mapFst (y0:) $ go y1)
        (\y -> mapFst (:[]) $ f y)
        xs x

mapLastPairRec :: b -> (a -> (a,b)) -> [a] -> ([a], b)
mapLastPairRec b _ [] = ([], b)
mapLastPairRec _ f (x:xs) =
    let go y [] = mapFst (:[]) $ f y
        go y0 (y1:ys) = mapFst (y0:) $ go y1 ys
    in  go x xs

mapLastPairRev :: b -> (a -> (a,b)) -> [a] -> ([a], b)
mapLastPairRev b0 f xs =
    case reverse xs of
        [] -> (xs, b0)
        y:ys ->
            let (a, b) = f y
            in  (reverse ys ++ [a], b)

_prop_mapLastPair :: String -> Int -> [String] -> Bool
_prop_mapLastPair b n strs =
    let f = splitAt n
    in  all (mapLastPair b f strs ==) $
            mapLastPairFoldr b f strs :
            mapLastPairRev b f strs :
            mapLastPairRec b f strs :
            []


addExtensionPC :: PathComponent os -> String -> PathComponent os
addExtensionPC p "" = p
addExtensionPC (PathComponent pc) ext =
    PathComponent $ pc ++
        if [extSeparator] `isPrefixOf` ext
          then ext
          else extSeparator : ext

splitExtensionPC :: PathComponent os -> (PathComponent os, String)
splitExtensionPC (PathComponent s) =
    mapFst PathComponent $
    maybe (s, "") (mapFst concat) $
    ((\p@(pcs,_) -> toMaybe (not (null pcs)) p) =<<) $ ListHT.viewR $
    ListHT.segmentBefore isExtSeparator s

_splitExtensionPC :: PathComponent os -> (PathComponent os, String)
_splitExtensionPC (PathComponent s) =
    mapFst PathComponent $
    case break isExtSeparator $ reverse s of
        (_, "") -> (s, "")
        (rext, dot:rstem) -> (reverse rstem, dot : reverse rext)

splitExtensionsPC :: PathComponent os -> (PathComponent os, String)
splitExtensionsPC (PathComponent s) =
    mapFst PathComponent $ break isExtSeparator s



class System os where
    -- | The character that separates directories. In the case where more than
    --   one character is possible, 'pathSeparator' is the \'ideal\' one.
    --
    -- >> Posix.isPathSeparator Posix.pathSeparator
    pathSeparator :: Tagged os Char

    -- | The list of all possible separators.
    --
    -- >> Posix.pathSeparator `elem` Posix.pathSeparators
    pathSeparators :: Tagged os [Char]
    pathSeparators = (:[]) <$> pathSeparator

    -- | Rather than using @(== 'pathSeparator')@, use this. Test if something
    --   is a path separator.
    --
    -- >> Posix.isPathSeparator a == (a `elem` Posix.pathSeparators)
    isPathSeparator :: Tagged os (Char -> Bool)
    isPathSeparator = flip elem <$> pathSeparators

    splitAbsolute :: Tagged os (MS.State String String)

    canonicalize :: Tagged os (String -> String)

    splitDrive :: Tagged os (MS.State String String)
    genDrive :: Tagged os (Gen String)


{- |
Check internal integrity of the path data structure.
-}
isValid ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
    Path os ar fd -> Bool
isValid = untag isValidTagged

isValidTagged ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
    Tagged os (Path os ar fd -> Bool)
isValidTagged =
    fmap
        (\isValidPC (Path ar pcs fd) ->
            absRelPlain isValidComponent True ar
            &&
            all isValidPC pcs
            &&
            fileOrDirPlain (isValidPC . retagPC) True True fd)
        isValidPathComponent

isValidComponent :: String -> Bool
isValidComponent = not . null

isValidPathComponent ::
    (System os) => Tagged os (PathComponent os -> Bool)
isValidPathComponent =
    fmap
        (\isSep (PathComponent str) ->
            isValidComponent str  &&  not (any isSep str))
        isPathSeparator

------------------------------------------------------------------------
-- QuickCheck

testAll :: (System os) => os -> [(String, IO ())]
testAll os =
    ("asPath_getPathString",
        quickCheck os prop_asPath_getPathString) :
    ("mkPathFromComponents_pathComponents",
        quickCheck os prop_mkPathFromComponents_pathComponents) :
    ("combine_currentDir",
        quickCheck os prop_combine_currentDir) :
    ("makeAbsoluteFromDir_endSame",
        quickCheck os prop_makeAbsoluteFromDir_endSame) :
    ("makeAbsoluteFromDir_startSame",
        quickCheck os prop_makeAbsoluteFromDir_startSame) :
    ("split_combine",
        quickCheck os prop_split_combine) :
    ("takeFileName_end",
        quickCheck os prop_takeFileName_end) :
    ("split_combineExt",
        quickCheck os prop_split_combineExt) :
    []

quickCheck ::
    (QC.Testable prop, System os, FileOrDirClass fd, AbsOrRelClass ar) =>
    os -> (Path os ar fd -> prop) -> IO ()
quickCheck _ = QC.quickCheck

-- test :: Testable a => a -> IO ()
-- test = quickCheck

qcFileComponent :: Gen (PathComponent os)
qcFileComponent = PathComponent <$> frequency [
                    (1, return "someFile"),
                    (1, return "fileWith.ext"),
                    (1, return "file.with.multiple.exts"),
                    (1, return "file with spcs")
                  ]

qcDirComponent :: Gen (PathComponent os)
qcDirComponent = PathComponent <$> frequency [
                    (1, return "someDir"),
                    (1, return "aDir"),
                    (1, return "aFolder"),
                    (1, return "a folder"),
                    (1, return "directory")
                  ]


qcAbsRel :: (System os, AbsOrRelClass ar) => Tagged os (Gen ar)
qcAbsRel =
    flip fmap genDrive $ \drive ->
        switchAbsOrRel (fmap absPC drive) (return Rel)
            (QC.oneof [fmap (AbsO . PathComponent) drive, return RelO])

qcGenPath ::
    Tagged os (Gen ar) ->
    (Gen ar -> Gen (Path os ar fd)) ->
    Gen (Path os ar fd)
qcGenPath qcAR gen = gen $ untag qcAR

qcFilePath :: (System os, AbsOrRelClass ar) => Gen (FilePath os ar)
qcFilePath = qcGenPath qcAbsRel $ \qcAR -> do
    ar <- qcAR
    pcs <- QC.listOf qcDirComponent
    pc <- qcFileComponent
    return $ Path ar pcs $ File pc

qcDirPath :: (System os, AbsOrRelClass ar) => fd -> Gen (Path os ar fd)
qcDirPath fd = qcGenPath qcAbsRel $ \qcAR -> do
    ar <- qcAR
    pcs <- QC.listOf qcDirComponent
    return $ Path ar pcs fd

qcPath ::
    (System os, AbsOrRelClass ar, FileOrDirClass fd) => Gen (Path os ar fd)
qcPath = switchFileOrDirPath qcFilePath (qcDirPath Dir) (qcDirPath FileOrDir)

instance
    (System os, AbsOrRelClass ar, FileOrDirClass fd) =>
        Arbitrary (Path os ar fd) where
    arbitrary = qcPath