-- LANGUAGE pragmas need to go in System.Path.[Windows|Posix]
module System.Path.MODULE_NAME
(
  -- * The main filepath (& dirpath) abstract type
  Path, -- kept abstract

  -- * Phantom Types
  Abs,
  Rel,
  File,
  Dir,

  -- * Type Synonyms
  AbsFile,
  RelFile,
  AbsDir,
  RelDir,
  AbsPath,
  RelPath,
  FilePath,
  DirPath,

  -- * Classes
  AbsRelClass(..),
  FileDirClass(..),

  -- * Path to String conversion
  getPathString,

  -- * Constants
  rootDir,
  currentDir,

  -- * 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,

  -- * Auxillary Manipulation Functions
  equalFilePath,
  joinPath,
  normalise,
  splitPath,
  makeRelative,
  makeAbsolute,
  makeAbsoluteFromCwd,
  genericMakeAbsolute,
  genericMakeAbsoluteFromCwd,
  pathMap,

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

  -- * Separators
  addTrailingPathSeparator,
  dropTrailingPathSeparator,
  extSeparator,
  hasTrailingPathSeparator,
  pathSeparator,
  pathSeparators,
  searchPathSeparator,
  isExtSeparator,
  isPathSeparator,
  isSearchPathSeparator,

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

where

import qualified System.Directory as SD

import Control.Arrow (first, second, (|||), (***))
import Control.Monad (guard, mplus)
import Control.Applicative ((<$>))
import Control.DeepSeq (NFData(rnf))
import Data.List (isSuffixOf, isPrefixOf, stripPrefix, intersperse)
import Data.String (IsString(fromString))
import Data.Maybe (fromMaybe, maybeToList)
import Data.Char (toLower, isAlpha, isSpace)

import Text.Printf (printf)

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

import Prelude hiding (FilePath)


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

newtype Abs = Abs String deriving (Eq, Ord)
data Rel = Rel deriving (Eq, Ord)

newtype File = File PathComponent deriving (Eq, Ord)
data Dir  = Dir deriving (Eq, Ord)

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

instance (AbsRelClass ar, FileDirClass fd) => Eq (Path ar fd) where
    Path ar0 pcs0 fd0 == Path ar1 pcs1 fd1  =
        (WrapAbsRel ar0, pcs0, WrapFileDir fd0)
        ==
        (WrapAbsRel ar1, pcs1, WrapFileDir fd1)

instance (AbsRelClass ar, FileDirClass fd) => Ord (Path ar fd) where
    compare (Path ar0 pcs0 fd0) (Path ar1 pcs1 fd1)  =
        compare
            (WrapAbsRel ar0, pcs0, WrapFileDir fd0)
            (WrapAbsRel ar1, pcs1, WrapFileDir fd1)


newtype WrapAbsRel ar = WrapAbsRel {unwrapAbsRel :: ar}

instance (AbsRelClass ar) => Eq (WrapAbsRel ar) where
    (==) = switchRelation switchAbsRel unwrapAbsRel (==) (==)

instance (AbsRelClass ar) => Ord (WrapAbsRel ar) where
    compare = switchRelation switchAbsRel unwrapAbsRel compare compare


newtype WrapFileDir fd = WrapFileDir {unwrapFileDir :: fd}

instance (FileDirClass fd) => Eq (WrapFileDir fd) where
    (==) = switchRelation switchFileDir unwrapFileDir (==) (==)

instance (FileDirClass fd) => Ord (WrapFileDir fd) where
    compare = switchRelation switchFileDir unwrapFileDir compare compare


newtype Relation res a = Relation {runRelation :: a -> a -> res}

switchRelation ::
    (Relation res a -> Relation res b -> Relation res c) ->
    (wrapped -> c) ->
    (a -> a -> res) ->
    (b -> b -> res) ->
    wrapped -> wrapped -> res
switchRelation switch unwrap fFile fDir ar0 ar1 =
    runRelation
        (switch (Relation fFile) (Relation fDir))
        (unwrap ar0) (unwrap ar1)


newtype PathComponent = PathComponent String

instance Eq PathComponent where
    PathComponent x == PathComponent y  =
        if isPosix
          then x==y
          else map toLower x == map toLower y

instance Ord PathComponent where
    compare (PathComponent x) (PathComponent y) =
        if isPosix
          then compare x y
          else compare (map toLower x) (map toLower y)


type AbsFile = Path Abs File
type RelFile = Path Rel File
type AbsDir  = Path Abs Dir
type RelDir  = Path Rel Dir

type AbsPath  fd = Path Abs fd
type RelPath  fd = Path Rel fd
type FilePath ar = Path ar File
type DirPath  ar = Path ar Dir

instance NFData PathComponent 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 (AbsRelClass ar, FileDirClass fd) => NFData (Path ar fd) where
    rnf (Path ar pcs fd) =
        rnf (absRelPlain rnf rnf ar, pcs, fileDirPlain rnf rnf fd)

absRelPlain :: (AbsRelClass ar) => (Abs -> a) -> (Rel -> a) -> ar -> a
absRelPlain fAbs fRel =
    runFuncArg $ switchAbsRel (FuncArg fAbs) (FuncArg fRel)

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

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.
--
-- >> Posix.pathMap (map toLower) "/tmp/Reports/SpreadSheets" == Posix.asAbsDir "/tmp/reports/spreadsheets"
pathMap :: (FileDirClass fd) => (String -> String) -> Path ar fd -> Path ar fd
pathMap f (Path ar pcs fd) = Path ar (map (pcMap f) pcs) (fdMap f fd)

newtype FDMap ar fd = FDMap {runFDMap :: fd -> fd}

fdMap :: (FileDirClass fd) => (String -> String) -> fd -> fd
fdMap f =
    runFDMap $
    switchFileDir (FDMap $ \(File pc) -> File $ pcMap f pc) (FDMap id)

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


------------------------------------------------------------------------
-- 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 File
instance Private Dir

-- | This class allows selective behaviour for absolute and
--   relative paths and is mostly for internal use.
class Private ar => AbsRelClass ar where
    -- | See <https://wiki.haskell.org/Closed_world_instances>
    --   for the used technique.
    switchAbsRel :: f Abs -> f Rel -> f ar
    -- | Will become a top-level function in future
    absRel :: (AbsPath fd -> a) -> (RelPath fd -> a) -> Path ar fd -> a
    absRel f g = runAbsRel $ switchAbsRel (AbsRel f) (AbsRel g)

newtype AbsRel fd a ar = AbsRel {runAbsRel :: Path ar fd -> a}

instance AbsRelClass Abs where switchAbsRel f _g = f
instance AbsRelClass Rel where switchAbsRel _f g = g

-- | This class allows selective behaviour for file and
--   directory paths and is mostly for internal use.
class Private fd => FileDirClass fd where
    switchFileDir :: f File -> f Dir -> f fd
    -- | Will become a top-level function in future
    fileDir :: (FilePath ar -> a) -> (DirPath ar -> a) -> Path ar fd -> a
    fileDir f g = runFileDir $ switchFileDir (FileDir f) (FileDir g)

newtype FileDir ar a fd = FileDir {runFileDir :: Path ar fd -> a}

instance FileDirClass File where switchFileDir f _g = f
instance FileDirClass Dir  where switchFileDir _f g = g


-- | Currently not exported
_pathAbsRel :: AbsRelClass ar => Path ar fd -> Either (AbsPath fd) (RelPath fd)
_pathAbsRel = absRel Left Right

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

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

-- >> show (Posix.rootDir </> "bla" </> Posix.asRelFile "blub") == "rootDir </> \"bla\" </> \"blub\""
-- >> show (Just (Posix.rootDir </> "bla" </> Posix.asRelFile "blub")) == "Just (rootDir </> \"bla\" </> \"blub\")"
-- >> show (Posix.currentDir </> "bla" </> Posix.asRelFile "blub") == "currentDir </> \"bla\" </> \"blub\""
-- >> show (Just (Posix.currentDir </> "bla" </> Posix.asRelFile "blub")) == "Just (currentDir </> \"bla\" </> \"blub\")"
-- >> show (Windows.asAbsDir "c:" Windows.</> "bla" Windows.</> Windows.asRelFile "blub") == "asAbsDir \"c:\" </> \"bla\" </> \"blub\""
-- >> show (Just (Windows.asAbsDir "c:\\" Windows.</> "bla" Windows.</> Windows.asRelFile "blub")) == "Just (asAbsDir \"c:\" </> \"bla\" </> \"blub\")"
instance (AbsRelClass ar, FileDirClass fd) => Show (Path ar fd) where
    showsPrec d x =
        case pathComponents x of
            (ar, pcs) ->
                showParen (d>9) $
                foldr (.) id $
                intersperse
                    (showChar ' ' .
                     showString combineOperator . showChar ' ') $
                absRelPlain
                    (\(Abs drive) ->
                        if null drive
                          then showString rootName
                          else showString absDirName .
                               showString drive .
                               showChar '"')
                    (const $ showString currentName)
                    ar :
                map (\(PathComponent pc) -> shows pc) pcs

-- >> let path = Posix.rootDir </> "bla" </> Posix.asRelFile "blub" in read (show path) == path
-- >> let path = Just (Posix.rootDir </> "bla" </> Posix.asRelFile "blub") in read (show path) == path
-- >> let path = Posix.currentDir </> "bla" </> Posix.asRelFile "blub" in read (show path) == path
-- >> let path = Just (Posix.currentDir </> "bla" </> Posix.asRelFile "blub") in read (show path) == path
-- >> let path = Windows.rootDir Windows.</> "bla" Windows.</> Windows.asRelFile "blub" in read (show path) == path
-- >> let path = Just (Windows.rootDir Windows.</> "bla" Windows.</> Windows.asRelFile "blub") in read (show path) == path
instance (AbsRelClass ar, FileDirClass fd) => Read (Path ar fd) where
    readsPrec d = readParen (d>9) $ \str ->
        let go :: ReadS [PathComponent]
            go s0 =
                case stripPrefix combineOperator $ dropWhile isSpace s0 of
                    Nothing -> [([], s0)]
                    Just s1 -> do
                        (pc, s2) <- reads s1
                        (pcs, s3) <- go s2
                        return (PathComponent pc : pcs, s3)
        in  do
                (ar, s0) <- maybeToList $ readsSplitDrive $ dropWhile isSpace str
                (pcs, s1) <- go s0
                path <- maybeToList $ maybePathFromComponents ar pcs
                return (path, s1)

newtype
    ReadsSplitDrive ar =
        ReadsSplitDrive {runReadsSplitDrive :: Maybe (ar, String)}

readsSplitDrive :: (AbsRelClass ar) => String -> Maybe (ar, String)
readsSplitDrive str0 =
    runReadsSplitDrive $
    switchAbsRel
        (ReadsSplitDrive $
            (fmap ((,) (Abs "")) $ stripPrefix rootName str0)
            `mplus`
            do  str1 <- stripPrefix absDirName str0
                (drive, '"':str2) <- Just $ break ('"'==) str1
                return (Abs drive, str2))
        (ReadsSplitDrive $
            fmap ((,) Rel) $ stripPrefix currentName str0)

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

getPathStringS :: (AbsRelClass ar, FileDirClass fd) => Path ar fd -> ShowS
getPathStringS x =
    case pathComponents x of
        (ar, []) ->
            absRelPlain
                (\(Abs drive) -> showString drive . showChar pathSeparator)
                (const $ showString currentDirComponent) ar
        (ar, pcs) ->
            foldr (.) id $ intersperse (showChar pathSeparator) $
            absRelPlain (\(Abs drive) -> (showString drive :)) (const id) ar $
            map (\(PathComponent pc) -> showString pc) pcs

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


------------------------------------------------------------------------
-- Windows / Posix

isPosix :: Bool
isPosix = not isWindows

isWindows :: Bool
isWindows = IS_WINDOWS

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

rootDir :: AbsDir
rootDir = Path (Abs "") [] Dir

currentDir :: RelDir
currentDir = Path Rel [] Dir

rootName :: String
rootName = "rootDir"

currentName :: String
currentName = "currentDir"

currentDirComponent :: String
currentDirComponent = "."

absDirName :: String
absDirName = "asAbsDir \""

------------------------------------------------------------------------
-- 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.
--
-- >> Posix.asPath "/tmp" == Posix.asAbsDir "/tmp"
-- >> Posix.asPath "file.txt" == Posix.asRelFile "file.txt"
-- >> Posix.isAbsolute (Posix.asAbsDir "/tmp")
-- >> Posix.isRelative (Posix.asRelDir "/tmp")
-- >> Posix.getPathString (Posix.asPath "/tmp" :: Posix.AbsDir) == "/tmp"
-- >> Posix.getPathString (Posix.asPath "/tmp" :: Posix.RelDir) == "tmp"
-- >> Windows.getPathString (Windows.asPath "\\tmp" :: Windows.AbsDir) == "\\tmp"
-- >> Windows.getPathString (Windows.asPath "a:\\tmp" :: Windows.AbsDir) == "a:\\tmp"
-- >> Windows.getPathString (Windows.asPath "tmp" :: Windows.RelDir) == "tmp"
asPath :: (AbsRelClass ar, FileDirClass fd) => String -> Path ar fd
asPath = uncurry mkPathFromComponents . mkPathComponents

newtype AbsRelDefault ar = AbsRelDefault {getAbsRelDefault :: ar}

absRelDefault :: (AbsRelClass ar) => ar
absRelDefault =
    getAbsRelDefault $ switchAbsRel (AbsRelDefault $ Abs "") (AbsRelDefault Rel)


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

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

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

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

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

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

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

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

-- | Allow use of OverloadedStrings if desired
instance
    (AbsRelClass ar, FileDirClass fd) =>
        IsString (Path ar fd) where fromString = asPath

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

-- | Examines the supplied string and constructs an absolute or
-- relative path as appropriate.
--
-- >> Posix.mkPathAbsOrRel "/tmp" == Left (Posix.asAbsDir "/tmp")
-- >> Posix.mkPathAbsOrRel  "tmp" == Right (Posix.asRelDir "tmp")
-- >> Windows.mkPathAbsOrRel "\\tmp" == Left (Windows.asAbsDir "\\tmp")
-- >> Windows.mkPathAbsOrRel "d:\\tmp" == Left (Windows.asAbsDir "d:\\tmp")
-- >> Windows.mkPathAbsOrRel "tmp" == Right (Windows.asRelDir "tmp")
mkPathAbsOrRel ::
    (FileDirClass fd) => String -> Either (AbsPath fd) (RelPath fd)
mkPathAbsOrRel s =
    if isAbsoluteString s
      then Left $ asAbsPath s
      else Right $ asRelPath s

-- | 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 ::
    AbsRelClass ar => String -> IO (Maybe (Either (FilePath ar) (DirPath 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.
--
-- >> Posix.mkAbsPath "/tmp" "foo.txt" == Posix.asAbsFile "/tmp/foo.txt"
-- >> Posix.mkAbsPath "/tmp" "/etc/foo.txt" == Posix.asAbsFile "/etc/foo.txt"
mkAbsPath :: (FileDirClass fd) => AbsDir -> String -> AbsPath fd
mkAbsPath d = (id ||| makeAbsolute d) . mkPathAbsOrRel

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


------------------------------------------------------------------------
-- Internal Functions for PathComponent manipulation

mkPathFromComponents :: (FileDirClass fd) => ar -> [PathComponent] -> Path ar fd
mkPathFromComponents ar pcs =
    switchFileDir
        (fromMaybe (Path ar [] $ File $ PathComponent "") $
         mkFilePathFromComponents ar pcs)
        (mkDirPathFromComponents ar pcs)

maybePathFromComponents ::
    (FileDirClass fd) => ar -> [PathComponent] -> Maybe (Path ar fd)
maybePathFromComponents ar pcs =
    getFunctorPath $
    switchFileDir
        (FunctorPath $ mkFilePathFromComponents ar pcs)
        (FunctorPath $ Just $ mkDirPathFromComponents ar pcs)

newtype
    FunctorPath f ar fd =
        FunctorPath {getFunctorPath :: f (Path ar fd)}

mkDirPathFromComponents :: ar -> [PathComponent] -> Path ar Dir
mkDirPathFromComponents ar pcs = Path ar pcs Dir

mkFilePathFromComponents :: ar -> [PathComponent] -> Maybe (Path ar File)
mkFilePathFromComponents _ [] = Nothing
mkFilePathFromComponents ar0 (q:qs) =
    let mapPathDirs f ~(Path ar pcs fd) = Path ar (f pcs) fd
        go p [] = Path ar0 [] (File p)
        go p0 (p1:ps) = mapPathDirs (p0:) $ go p1 ps
    in  Just $ go q qs

mkPathComponents :: (AbsRelClass ar) => String -> (ar, [PathComponent])
mkPathComponents =
    let go xs =
            case break isPathSeparator $ dropWhile isPathSeparator xs of
                ("","") -> []
                (s,rest) -> s : go rest
        split [] = (absRelDefault, [])
        split (pc:pcs) =
            second (map PathComponent) $
            case splitDrive pc of
                (drive, "") -> (drive, pcs)
                (drive, pc0) -> (drive, pc0:pcs)
    in  split . go

newtype SplitDrive ar = SplitDrive {runSplitDrive :: (ar, String)}

splitDrive :: (AbsRelClass ar) => String -> (ar, String)
splitDrive str =
    runSplitDrive $
    switchAbsRel
        (SplitDrive $ first Abs $
         if isPosix
           then ("", str)
           else
               case break (':'==) str of
                   (drive, ':':rest) -> (drive++":", rest)
                   _ -> ("", str))
        (SplitDrive (Rel, str))

pathComponents :: (FileDirClass fd) => Path ar fd -> (ar, [PathComponent])
pathComponents (Path ar pcs fd) = (ar, pcs ++ fileDirComponent fd)

fileDirComponent :: (FileDirClass fd) => fd -> [PathComponent]
fileDirComponent = fileDirPlain (\(File pc) -> [pc]) (\Dir -> [])

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



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

combineOperator :: String
combineOperator = "</>"

-- | Infix variant of 'combine'.
--
-- >> Posix.getPathString (Posix.asAbsDir "/tmp" </> Posix.asRelFile "file.txt") == "/tmp/file.txt"
-- >> Posix.getPathString (Posix.asAbsDir "/tmp" </> Posix.asRelDir "dir" </> Posix.asRelFile "file.txt") == "/tmp/dir/file.txt"
-- >> Posix.getPathString (Posix.asRelDir "dir" </> Posix.asRelFile "file.txt") == "dir/file.txt"
-- >> Windows.getPathString (Windows.asAbsDir "\\tmp" Windows.</> Windows.asRelFile "file.txt") == "\\tmp\\file.txt"
-- >> Windows.getPathString (Windows.asAbsDir "c:\\tmp" Windows.</> Windows.asRelFile "file.txt") == "c:\\tmp\\file.txt"
-- >> Windows.getPathString (Windows.asAbsDir "c:" Windows.</> Windows.asRelDir "tmp" Windows.</> Windows.asRelFile "file.txt") == "c:\\tmp\\file.txt"
-- >> Windows.getPathString (Windows.asRelDir "dir" Windows.</> Windows.asRelFile "file.txt") == "dir\\file.txt"
(</>) :: DirPath ar -> RelPath fd -> Path ar fd
(Path ar pcs0 Dir) </> (Path Rel pcs1 fd) = Path ar (pcs0 ++ pcs1) fd

-- | 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 ar -> String -> FilePath ar
Path ar pcs (File pc) <.> ext = Path ar pcs (File $ addExtensionPC pc ext)

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

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


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

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

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


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

replaceBaseName :: FilePath ar -> String -> FilePath ar
replaceBaseName (Path ar pcs (File pc)) bn =
    Path ar pcs $ File $
    addExtensionPC (PathComponent bn) $ snd $ splitExtensionPC pc

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

replaceFileName :: FilePath ar -> String -> FilePath ar
replaceFileName (Path ar pcs _) fn = Path ar pcs (File (PathComponent fn))


-- | Split on the extension. 'addExtension' is the inverse.
--
-- >> uncurry (<.>) (Posix.splitExtension x) == x
-- >> uncurry Posix.addExtension (Posix.splitExtension x) == x
-- >> Posix.splitExtension (Posix.asRelFile "file.txt") == ("file",".txt")
-- >> Posix.splitExtension (Posix.asRelFile "file") == ("file","")
-- >> Posix.splitExtension (Posix.asRelFile "file/file.txt") == ("file/file",".txt")
-- >> Posix.splitExtension (Posix.asRelFile "file.txt/boris") == ("file.txt/boris","")
-- >> Posix.splitExtension (Posix.asRelFile "file.txt/boris.ext") == ("file.txt/boris",".ext")
-- >> Posix.splitExtension (Posix.asRelFile "file/path.txt.bob.fred") == ("file/path.txt.bob",".fred")
splitExtension :: FilePath ar -> (FilePath ar, String)
splitExtension (Path ar pcs (File pc)) =
    first (Path ar pcs . File) $ splitExtensionPC pc

-- | Split on all extensions
--
-- >> Posix.splitExtensions (Posix.asRelFile "file.tar.gz") == ("file",".tar.gz")
splitExtensions :: FilePath ar -> (FilePath ar, String)
splitExtensions (Path ar pcs (File pc)) =
    first (Path ar pcs . File) $ splitExtensionsPC pc

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

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

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


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

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

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

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

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

prop_takeFileName_end :: AbsFile -> Property
prop_takeFileName_end p = property $ show (takeFileName p) `isSuffixOf` show p


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

-- | Check whether two strings are equal as file paths.
--
-- >>       Posix.equalFilePath "/tmp/" "/tmp"
-- >> not $ Posix.equalFilePath "/tmp" "tmp"
-- >>       Windows.equalFilePath "file" "File"
-- >> not $ Windows.equalFilePath "file" "dir"
equalFilePath :: String -> String -> Bool
equalFilePath s1 s2 =
    let abs1 = isAbsoluteString s1
        abs2 = isAbsoluteString s2
    in  abs1 == abs2 &&
        if abs1
          then asAbsDir s1 == asAbsDir s2
          else asRelDir s1 == asRelDir s2

-- | 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.
--
-- >> Posix.joinPath ["tmp","someDir","dir"] == Posix.asRelDir "tmp/someDir/dir"
-- >> Posix.joinPath ["tmp","someDir","file.txt"] == Posix.asRelFile "tmp/someDir/file.txt"
joinPath :: (FileDirClass fd) => [String] -> RelPath fd
joinPath = mkPathFromComponents Rel . map PathComponent

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

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

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

maybeFileDir :: (FileDirClass fd) => fd -> Maybe RelFile
maybeFileDir = fileDirPlain (Just . Path Rel []) (\Dir -> 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'.
--
-- >> Posix.makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/file.txt" == Posix.asRelFile "anotherdir/file.txt"
-- >> Posix.makeRelative "/tmp/somedir" "/tmp/somedir/anotherdir/dir" == Posix.asRelDir "anotherdir/dir"
-- >> Windows.makeRelative "c:\\tmp\\somedir" "c:\\Tmp\\SomeDir\\AnotherDir\\File.txt" == Windows.asRelFile "AnotherDir\\File.txt"
-- >> Windows.makeRelative "c:\\tmp\\somedir" "c:\\tmp\\somedir\\anotherdir\\dir" == Windows.asRelDir "anotherdir\\dir"
makeRelative :: (FileDirClass fd) => AbsDir -> AbsPath fd -> RelPath fd
makeRelative relTo@(Path relToAR relToPCs Dir) orig@(Path origAR origPCs fd) =
    maybe (error msg) (flip (Path Rel) fd) $
    guard (relToAR == origAR) >> stripPrefix relToPCs origPCs
  where
    msg =
        printf "System.Path can't make (%s) relative to (%s)"
            (show orig) (show relTo)

-- | Joins an absolute directory with a relative path to construct a
--   new absolute path.
--
-- >> Posix.makeAbsolute "/tmp" "file.txt"      == Posix.asAbsFile "/tmp/file.txt"
-- >> Posix.makeAbsolute "/tmp" "adir/file.txt" == Posix.asAbsFile "/tmp/adir/file.txt"
-- >> Posix.makeAbsolute "/tmp" "adir/dir"      == Posix.asAbsDir "/tmp/adir/dir"
makeAbsolute :: AbsDir -> RelPath fd -> AbsPath fd
makeAbsolute = genericMakeAbsolute

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

-- | As for 'makeAbsolute', but for use when the path may already be
--   absolute (in which case it is left unchanged).
--
-- >> Posix.genericMakeAbsolute "/tmp" (Posix.asRelFile "file.txt")       == "/tmp/file.txt"
-- >> Posix.genericMakeAbsolute "/tmp" (Posix.asRelFile "adir/file.txt")  == "/tmp/adir/file.txt"
-- >> Posix.genericMakeAbsolute "/tmp" (Posix.asAbsFile "adir/file.txt")  == "/adir/file.txt"
-- >> Posix.genericMakeAbsolute "/tmp" (Posix.asAbsFile "/adir/file.txt") == "/adir/file.txt"
genericMakeAbsolute :: AbsRelClass ar => AbsDir -> Path ar fd -> AbsPath 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 :: AbsRelClass ar => Path ar fd -> IO (AbsPath 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 :: AbsDir -> RelFile -> Property
prop_makeAbsoluteFromDir_endSame base p =
    property $ show p `isSuffixOf` show (makeAbsolute base p)

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

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


------------------------------------------------------------------------
-- 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.
--
-- >> Posix.isAbsolute (Posix.asAbsFile "fred")
-- >> Posix.isAbsolute (Posix.asAbsFile "/fred")
-- >> Windows.isAbsolute (Windows.asAbsFile "\\fred")
-- >> Windows.isAbsolute (Windows.asAbsFile "c:\\fred")
isAbsolute :: AbsRelClass ar => Path ar fd -> Bool
isAbsolute = absRel (const True) (const False)

-- | Test whether the 'String' would correspond to an absolute path
--   if interpreted as a 'Path'.
isAbsoluteString :: String -> Bool
isAbsoluteString [] = False -- Treat the empty string as relative because it doesn't start with 'pathSeparators'
isAbsoluteString (x:xs) =
    isPathSeparator x -- Absolute if first char is a path separator
    ||
    isWindows && isAlpha x && isPrefixOf ":" xs

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

-- | Test whether the 'String' would correspond to a relative path
--   if interpreted as a 'Path'.
--
-- > isRelativeString = not . isAbsoluteString
isRelativeString :: String -> Bool
isRelativeString = not . isAbsoluteString


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

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


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

-- | This is largely for 'System.FilePath' compatability
addTrailingPathSeparator :: String -> String
addTrailingPathSeparator = (++[pathSeparator])

-- | This is largely for 'System.FilePath' compatability
dropTrailingPathSeparator :: String -> String
dropTrailingPathSeparator = init

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

-- | This is largely for 'System.FilePath' compatability
hasTrailingPathSeparator :: String -> Bool
hasTrailingPathSeparator = isPathSeparator . last

-- | 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 :: Char
pathSeparator | isWindows = '\\'
              | otherwise = '/'

-- | The list of all possible separators.
--
-- >> Posix.pathSeparator `elem` Posix.pathSeparators
pathSeparators :: [Char]
pathSeparators = return pathSeparator

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

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

-- | 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
--
-- >> Posix.genericAddExtension "/" "x" == Posix.asAbsDir "/.x"
-- >> Posix.genericAddExtension "/a" "x" == Posix.asAbsDir "/a.x"
-- >> Posix.genericAddExtension "" "x" == Posix.asRelFile ".x"
-- >> Posix.genericAddExtension "" "" == Posix.asRelFile ""
genericAddExtension :: (FileDirClass fd) => Path ar fd -> String -> Path ar fd
genericAddExtension p "" = p
genericAddExtension path ext =
    runAddExtension
        (switchFileDir
            (AddExtension $
             \(Path ar pcs (File pc)) ->
                Path ar pcs $ File $ addExtensionPC pc ext)
            (AddExtension $
             \(Path ar pcs0 Dir) ->
                let pcs = if null pcs0 then [PathComponent ""] else pcs0
                in  Path ar (mapLast (flip addExtensionPC ext) pcs) Dir))
        path

newtype
    AddExtension ar fd =
        AddExtension {runAddExtension :: Path ar fd -> Path ar fd}

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

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

genericSplitExtension ::
    (FileDirClass fd) => Path ar fd -> (Path ar fd, String)
genericSplitExtension =
    runSplitExtension $
    switchFileDir
        (SplitExtension $
         \(Path ar pcs (File pc)) ->
            first (Path ar pcs . File) $ splitExtensionPC pc)
        (SplitExtension $
         \(Path ar pcs Dir) ->
            first (flip (Path ar) Dir) $
            mapLastPair
                (error "genericSplitExtension: empty path")
                splitExtensionPC pcs)

genericSplitExtensions ::
    (FileDirClass fd) => Path ar fd -> (Path ar fd, String)
genericSplitExtensions =
    runSplitExtension $
    switchFileDir
        (SplitExtension $
         \(Path ar pcs (File pc)) ->
            first (Path ar pcs . File) $ splitExtensionsPC pc)
        (SplitExtension $
         \(Path ar pcs Dir) ->
            first (flip (Path ar) Dir) $
            mapLastPair
                (error "genericSplitExtensions: empty path")
                splitExtensionsPC pcs)

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

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

newtype
    SplitExtension ar fd =
        SplitExtension {runSplitExtension :: Path ar fd -> (Path ar fd, 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 b0 f xs =
    case reverse xs of
        [] -> (xs, b0)
        y:ys ->
            let (a, b) = f y
            in  (reverse ys ++ [a], b)

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

splitExtensionPC :: PathComponent -> (PathComponent, String)
splitExtensionPC (PathComponent s) = (PathComponent s1, s2)
    where (s1,s2) = fixTrailingDot $ rbreak isExtSeparator s
          fixTrailingDot ("",r2) = (r2,"")
          fixTrailingDot (r1,r2) | [extSeparator] `isSuffixOf` r1 = (init r1, extSeparator:r2)
                                 | otherwise = (r1,r2)
          swap (x,y) = (y,x)
          rbreak q = (reverse *** reverse) . swap . break q . reverse

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

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

_testall :: IO ()
_testall = do
  putStrLn "Running QuickCheck tests..."
  quickCheck prop_asPath_getPathString
  quickCheck prop_mkPathFromComponents_pathComponents
  quickCheck prop_makeAbsoluteFromDir_endSame
  quickCheck prop_makeAbsoluteFromDir_startSame
  quickCheck prop_split_combine
  quickCheck prop_takeFileName_end
  quickCheck prop_split_combineExt
  putStrLn "Tests completed."

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

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

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

instance Arbitrary PathComponent where
    arbitrary = oneof [qcFileComponent, qcDirComponent]


qcGenPath ::
    (AbsRelClass ar, FileDirClass fd) =>
    Gen PathComponent -> Gen (Path ar fd)
qcGenPath qcLastComponent = do
    ar <- switchAbsRel (fmap (Abs . (:":")) $ QC.choose ('a', 'z')) (return Rel)
    pcs <- QC.listOf qcDirComponent
    pc <- qcLastComponent
    return $ mkPathFromComponents ar (pcs ++ [pc])

qcFilePath :: (AbsRelClass ar) => Gen (FilePath ar)
qcFilePath = qcGenPath qcFileComponent

qcDirPath :: (AbsRelClass ar) => Gen (DirPath ar)
qcDirPath = qcGenPath qcDirComponent

qcPath :: (AbsRelClass ar, FileDirClass fd) => Gen (Path ar fd)
qcPath =
    getFunctorPath $
    switchFileDir (FunctorPath qcFilePath) (FunctorPath qcDirPath)

instance (AbsRelClass ar, FileDirClass fd) => Arbitrary (Path ar fd) where
    arbitrary = qcPath