pathtype-0.0.1: System/Path.hs

{-# LANGUAGE EmptyDataDecls, PatternGuards, FlexibleInstances, Rank2Types #-}

-- | This module provides type-safe access to filepath manipulations.
--
--   It is designed to be imported instead of 'System.FilePath' and
--   'System.Directory'. (It is intended to provide versions of
--   functions from those modules which have equivalent functionality
--   but are more typesafe).
--
--   The heart of this module is the @Path ar fd@ abstract type which
--   represents file and directory paths. The idea is that there are
--   two phantom type parameters - the first should be 'Abs' or 'Rel',
--   and the second 'File' or 'Dir'. A number of type synonyms are
--   provided for common types:
--
--   > type AbsFile    = Path Abs File
--   > type RelFile    = Path Rel File
--   > type AbsDir     = Path Abs Dir
--   > type RelDir     = Path Rel Dir
--   > type RelPath fd = Path Rel fd
--   > type DirPath ar = Path ar Dir
--
--   The type of the 'combine' (aka '</>') function gives the idea:
--
--   > (</>) :: DirPath ar -> RelPath fd -> Path ar fd
--
--   Together this enables us to give more meaningful types to
--   a lot of the functions, and (hopefully) catch a bunch more
--   errors at compile time.
--
--   The basic API (and properties satisfied) are heavily influenced
--   by Neil Mitchell's 'System.FilePath' module.
--
--
--   WARNING --- THE API IS NOT YET STABLE --- WARNING
--
--
-- Ben Moseley - (c) Jan 2009
--
module System.Path
(
  -- * 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,

  -- * Path to String conversion
  getPathString,

  -- * Constants
  rootDir,
  currentDir,

  -- * Unchecked Construction Functions
  mkPath,
  mkRelFile,
  mkRelDir,
  mkAbsFile,
  mkAbsDir,
  mkRelPath,
  mkAbsPath,
  mkFile,
  mkDir,

  -- * Checked Construction Functions
  mkPathAbsOrRel,
  mkPathFileOrDir,

  -- * 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,
  splitDirectories,
  splitPath,
  makeRelative,

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

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

  -- * Flexible Manipulation Functions
  addFileOrDirExtension,
  dropFileOrDirExtension,
  dropFileOrDirExtensions,
  splitFileOrDirExtension,
  splitFileOrDirExtensions,
  takeFileOrDirExtension,
  takeFileOrDirExtensions,

  -- * System.Directory replacements
  getDirectoryContents,
  absDirectoryContents,
  relDirectoryContents
)

where

import Prelude hiding (FilePath)

import Control.Applicative
import Control.Arrow
import Data.List
import qualified System.Directory as SD

import System.IO hiding (FilePath)
import System.IO.Error
import Text.Printf
import Test.QuickCheck


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

data Abs
data Rel
data File
data Dir

-- | This is the main filepath abstract datatype
data Path ar fd = PathRoot -- ^ Invariant - this should always have type :: DirPath ar
                | FileDir (DirPath ar) PathComponent
                  deriving (Eq, Ord)

newtype PathComponent = PathComponent { unPathComponent :: String } deriving (Eq,Ord)
instance Show PathComponent where showsPrec _ (PathComponent s) = showString s

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

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


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

class AbsRelClass ar where
    absRel :: (AbsPath fd -> a) -> (RelPath fd -> a) -> Path ar fd -> a

instance AbsRelClass Abs where absRel f g = f
instance AbsRelClass Rel where absRel f g = g

class FileDirClass fd where
    fileDir :: (FilePath ar -> a) -> (DirPath ar -> a) -> Path ar fd -> a

instance FileDirClass File where fileDir f g = f
instance FileDirClass Dir  where fileDir f g = g


pathAbsRel :: AbsRelClass ar => Path ar fd -> Either (AbsPath fd) (RelPath fd)
pathAbsRel = absRel Left Right


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

instance AbsRelClass ar => Show (Path ar fd) where
    showsPrec d x@PathRoot                = absRel (const $ showString pathSeparators)
                                                   (const $ showString ".") x
    -- we need the clause below so that we don't duplicate the pathSeparator after an abs
    -- root and we don't want to display a "./" prefix on relative paths
    showsPrec d x@(FileDir p@PathRoot pc) = absRel (const $ showString pathSeparators)
                                                   (const id)
                                                   p .
                                            showsPrec d pc
    showsPrec d x@(FileDir p pc)          = showsPrec d p . showString pathSeparators .
                                            showsPrec d pc

-- This instance consumes all remaining input. Would it be better to, say,
-- give up at newlines or some set of non-allowable chars?
instance AbsRelClass ar => Read (Path ar fd) where
    readsPrec _ s = [(mkPath s,"")]

-- | Convert the 'Path' into a plain 'String'. This is simply an
--   alias for 'show'.
getPathString :: AbsRelClass ar => Path ar fd -> String
getPathString = show

prop_mkPath_getPathString :: AbsFile -> Property
prop_mkPath_getPathString p = property $ p == mkPath (getPathString p)


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

rootDir :: AbsDir
rootDir = PathRoot

currentDir :: RelDir
currentDir = PathRoot


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

-- | Convert a 'String' into a 'Path' whose type is determined
--   by its context.
mkPath :: String -> Path ar fd
mkPath = mkPathFromComponents . mkPathComponents

mkRelFile :: String -> RelFile
mkRelFile = mkPath

mkRelDir :: String -> RelDir
mkRelDir = mkPath

mkAbsFile :: String -> AbsFile
mkAbsFile = mkPath

mkAbsDir :: String -> AbsDir
mkAbsDir = mkPath

mkRelPath :: String -> RelPath fd
mkRelPath = mkPath

mkAbsPath :: String -> AbsPath fd
mkAbsPath = mkPath

mkFile :: String -> FilePath ar
mkFile = mkPath

mkDir :: String -> DirPath ar
mkDir = mkPath


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

-- | Examines the supplied string and constructs an absolute or
-- relative path as appropriate.
mkPathAbsOrRel :: String -> Either (AbsPath fd) (RelPath fd)
mkPathAbsOrRel s | isAbsoluteString s = Left (mkPath s)
                 | otherwise = Right (mkPath 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 <- doesFileExist `onPathString` s
  isdir <- doesDirectoryExist `onPathString` s
  case (isfile, isdir) of
    (False, False) -> return Nothing
    (True,  False) -> return $ Just $ Left $ mkPath s
    (False, True ) -> return $ Just $ Right $ mkPath s
    (True,  True ) -> ioError $ userError "mkPathFileOrDir - internal inconsistency - file&dir"

-- | Lift a function which can operate on either Abs or Rel Path to one which
--   operates on Strings
onPathString :: (forall ar . AbsRelClass ar => Path ar fd -> a) -> String -> a
onPathString f = (f ||| f) . mkPathAbsOrRel

mkAbsFrom :: AbsRelClass ar => AbsDir -> Path ar fd -> AbsPath fd
mkAbsFrom base p = absRel id (mkAbsFromRel base) p

mkAbsFromRel :: AbsDir -> RelPath fd -> AbsPath fd
mkAbsFromRel = (</>)

prop_mkAbsFromRel_endSame :: AbsDir -> RelFile -> Property
prop_mkAbsFromRel_endSame base p = property $ show p `isSuffixOf` show (mkAbsFrom base p)

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

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


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

mkPathFromComponents :: [PathComponent] -> Path ar fd
mkPathFromComponents []  = PathRoot
mkPathFromComponents pcs | (p:ps) <- reverse pcs = FileDir (foldr (flip FileDir) PathRoot ps) p

mkPathComponents :: String -> [PathComponent]
mkPathComponents xs =
    case break isPathSeparator (dropWhile isPathSeparator xs) of
      ("","")  -> []
      (s,rest) -> PathComponent s : mkPathComponents rest

pathComponents :: Path ar fd -> [PathComponent]
pathComponents PathRoot = []
pathComponents (FileDir p pc) = pathComponents p ++ [pc]

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



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

-- | Join an (absolute or relative) directory path with a relative
--   (file or directory) path to form a new path.
(</>) :: DirPath ar -> RelPath fd -> Path ar fd
PathRoot         </> PathRoot       = PathRoot
(FileDir dp dpc) </> PathRoot       = FileDir dp dpc
d                </> (FileDir p pc) = FileDir (d </> p) pc

-- | 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:
--   'addFileOrDirExtension'.
(<.>) :: FilePath ar -> String -> FilePath ar
(<.>) = addFileOrDirExtension

-- | Add an extension, even if there is already one there.
--   E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@.
--
-- >> addExtension (mkFile "file.txt") "bib" == (mkFile "file.txt.bib")
-- >> addExtension (mkFile "file.") ".bib" == (mkFile "file..bib")
-- >> addExtension (mkFile "file") ".bib" == (mkFile "file.bib")
-- >> takeFileName (addExtension (mkFile "") "ext") == mkFile ".ext"
-- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"
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.
--
-- >> dropExtension x == fst (splitExtension x)
dropExtension :: FilePath ar -> FilePath ar
dropExtension = fst . splitExtension

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

dropFileName :: Path ar fd -> DirPath ar
dropFileName = fst . splitFileName


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

replaceBaseName :: Path ar fd -> String -> Path ar fd
replaceBaseName p bn = takeDirectory p </> (mkPath bn `addFileOrDirExtension` takeFileOrDirExtension p)

replaceDirectory :: Path ar1 fd -> DirPath ar2 -> Path ar2 fd
replaceDirectory p d = d </> takeFileName p

replaceFileName :: Path ar fd -> String -> Path ar fd
replaceFileName p fn = takeDirectory p </> mkPath fn


-- | Split on the extension. 'addExtension' is the inverse.
--
-- >> uncurry (<.>) (splitExtension x) == x
-- >> uncurry addExtension (splitExtension x) == x
-- >> splitExtension (mkFile "file.txt") == (mkFile "file",".txt")
-- >> splitExtension (mkFile "file") == (mkFile "file","")
-- >> splitExtension (mkFile "file/file.txt") == (mkFile "file/file",".txt")
-- >> splitExtension (mkFile "file.txt/boris") == (mkFile "file.txt/boris","")
-- >> splitExtension (mkFile "file.txt/boris.ext") == (mkFile "file.txt/boris",".ext")
-- >> splitExtension (mkFile "file/path.txt.bob.fred") == (mkFile "file/path.txt.bob",".fred")
splitExtension :: FilePath ar -> (FilePath ar, String)
splitExtension = splitFileOrDirExtension

-- | Split on all extensions
--
-- >> splitExtensions (mkFile "file.tar.gz") == (mkFile "file",".tar.gz")
splitExtensions :: FilePath ar -> (FilePath ar, String)
splitExtensions = splitFileOrDirExtensions

prop_splitCombine :: AbsFile -> Property
prop_splitCombine p = property $ p == p2 <.> ext
                      where
                        (p2, ext) = splitExtension p

splitFileName :: Path ar fd -> (DirPath ar, RelPath fd)
splitFileName (FileDir p pc) = (p, mkPathFromComponents [pc])

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


takeBaseName :: Path ar fd -> RelPath fd
takeBaseName = takeFileName . dropFileOrDirExtension

takeDirectory :: Path ar fd -> DirPath ar
takeDirectory = fst . splitFileName

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

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

takeFileName :: Path ar fd -> RelPath fd
takeFileName PathRoot = PathRoot -- becomes a relative root
takeFileName (FileDir _ pc) = FileDir PathRoot pc

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


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

equalFilePath :: String -> String -> Bool
equalFilePath s1 s2 = mkPath s1 == mkPath s2

-- | Constructs a 'Path' from a list of components.
joinPath :: [String] -> Path ar fd
joinPath = mkPathFromComponents . map PathComponent

-- | Currently just transforms:
--
-- >> normalise (mkFile "/tmp/fred/./jim/./file") == mkFile "/tmp/fred/jim/file"
normalise :: Path ar fd -> Path ar fd
normalise = mkPathFromComponents . filter (/=(PathComponent ".")) . pathComponents

splitDirectories :: Path ar fd -> [String]
splitDirectories PathRoot = []
splitDirectories p = map unPathComponent . init . pathComponents $ p

splitPath :: Path ar fd -> [String]
splitPath = map unPathComponent . pathComponents

makeRelative :: AbsDir -> AbsPath fd -> RelPath fd
makeRelative relTo orig = maybe err mkPathFromComponents $ stripPrefix relToPC origPC
  where
    err     = error $ printf "System.Path can't make %s relative to %s" (show origPC) (show relToPC)
    relToPC = pathComponents relTo
    origPC  = pathComponents orig

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

isAbsolute :: AbsRelClass ar => Path ar fd -> Bool
isAbsolute = absRel (const True) (const False)

isAbsoluteString :: String -> Bool
isAbsoluteString [] = False -- Treat the empty string as relative because it doesn't start with 'pathSeparators'
isAbsoluteString (x:_) = any (== x) pathSeparators -- Absolute if first char is a path separator

-- | Invariant - this should return True iff arg is of type @Path Rel _@
isRelative :: AbsRelClass ar => Path ar fd -> Bool
isRelative = not . isAbsolute

isRelativeString :: String -> Bool
isRelativeString = not . isAbsoluteString


-- | Does the given filename have an extension?
--
-- >> null (takeExtension x) == not (hasExtension x)
hasExtension :: FilePath ar -> Bool
hasExtension = not . null . 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
--
-- >> 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.
--
-- > Windows: pathSeparator == '\\'
-- > Posix:   pathSeparator ==  '/'
-- >> isPathSeparator pathSeparator
pathSeparator :: Char
pathSeparator = '/'

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

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

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

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

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


------------------------------------------------------------------------
-- Flexible 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
--
-- >> addFileOrDirExtension (mkFile "/") "x" == (mkFile "/.x")
addFileOrDirExtension :: Path ar fd -> String -> Path ar fd
addFileOrDirExtension p "" = p
addFileOrDirExtension (FileDir p (PathComponent pc)) ext = FileDir p (PathComponent (pc ++ suffix))
                                         where suffix | "." `isPrefixOf` ext = ext
                                                      | otherwise = "." ++ ext
addFileOrDirExtension PathRoot ext = FileDir PathRoot (PathComponent suffix)
                                         where suffix | "." `isPrefixOf` ext = ext
                                                      | otherwise = "." ++ ext

dropFileOrDirExtension :: Path ar fd -> Path ar fd
dropFileOrDirExtension = fst . splitFileOrDirExtension

dropFileOrDirExtensions :: Path ar fd -> Path ar fd
dropFileOrDirExtensions = fst . splitFileOrDirExtensions

splitFileOrDirExtension :: Path ar fd -> (Path ar fd, String)
splitFileOrDirExtension (FileDir p (PathComponent s)) = (FileDir p (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 p = (reverse *** reverse) . swap . break p . reverse
splitFileOrDirExtension p = (p,"")

splitFileOrDirExtensions :: Path ar fd -> (Path ar fd, String)
splitFileOrDirExtensions (FileDir p (PathComponent s)) = (FileDir p (PathComponent s1), s2)
    where (s1,s2) = break isExtSeparator s
splitFileOrDirExtensions p = (p,"")

takeFileOrDirExtension :: Path ar fd -> String
takeFileOrDirExtension = snd . splitFileOrDirExtension

takeFileOrDirExtensions :: Path ar fd -> String
takeFileOrDirExtensions = snd . splitFileOrDirExtension


------------------------------------------------------------------------
-- System.Directory replacements

doesFileExist :: AbsRelClass ar => FilePath ar -> IO Bool
doesFileExist = SD.doesFileExist . getPathString

doesDirectoryExist :: AbsRelClass ar => DirPath ar -> IO Bool
doesDirectoryExist = SD.doesDirectoryExist . getPathString

getDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([AbsDir], [AbsFile])
getDirectoryContents = absDirectoryContents

-- | Retrieve the contents of a directory path (which may be relative) as absolute paths
absDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([AbsDir], [AbsFile])
absDirectoryContents p = do
  cd <- mkAbsDir <$> SD.getCurrentDirectory
  let dir = absRel id (cd </>) p
  (rds, rfs) <- relDirectoryContents dir
  return (map (dir </>) rds, map (dir </>) rfs)

-- | Returns paths relative /to/ the supplied (abs or relative) directory path.
--   eg (for current working directory of @\/somewhere\/cwd\/@):
--
-- > show (relDirectoryContents (mkRelDir "subDir1")) == (["subDir1A","subDir1B"],
-- >                                                      ["file1A","file1B"])
--
relDirectoryContents :: AbsRelClass ar => DirPath ar -> IO ([RelDir], [RelFile])
relDirectoryContents dir = do
  filenames <- filter (not . flip elem [".",".."]) <$> SD.getDirectoryContents (getPathString dir)
  dirFlags  <- mapM (doesDirectoryExist . (dir </>) . mkPath) filenames
  let fileinfo = zip filenames dirFlags
      (dirs, files) = partition snd fileinfo
  return (map (FileDir currentDir . PathComponent . fst) dirs,
          map (FileDir currentDir . PathComponent . fst) files)

filesInDir :: AbsRelClass ar => DirPath ar -> IO [RelFile]
filesInDir dir = snd <$> relDirectoryContents dir

dirsInDir :: AbsRelClass ar => DirPath ar -> IO [RelDir]
dirsInDir dir = fst <$> relDirectoryContents dir

createDirectory :: AbsRelClass ar => DirPath ar -> IO ()
createDirectory = SD.createDirectory . getPathString

createDirectoryIfMissing :: AbsRelClass ar => Bool -> DirPath ar -> IO ()
createDirectoryIfMissing flag = SD.createDirectoryIfMissing flag . getPathString

removeDirectory :: AbsRelClass ar => DirPath ar -> IO ()
removeDirectory = SD.removeDirectory . getPathString

removeDirectoryRecursive :: AbsRelClass ar => DirPath ar -> IO ()
removeDirectoryRecursive = SD.removeDirectoryRecursive . getPathString

getCurrentDirectory :: IO AbsDir
getCurrentDirectory = mkAbsDir <$> SD.getCurrentDirectory

setCurrentDirectory :: AbsRelClass ar => FilePath ar -> IO ()
setCurrentDirectory = SD.setCurrentDirectory . getPathString

getHomeDirectory :: IO AbsDir
getHomeDirectory = mkAbsDir <$> SD.getHomeDirectory

getUserDocumentsDirectory :: IO AbsDir
getUserDocumentsDirectory = mkAbsDir <$> SD.getUserDocumentsDirectory

getTemporaryDirectory :: IO AbsDir
getTemporaryDirectory = mkAbsDir <$> SD.getTemporaryDirectory

getAppUserDataDirectory :: String -> IO AbsDir
getAppUserDataDirectory user = mkAbsDir <$> SD.getAppUserDataDirectory user

copyFile :: (AbsRelClass ar1, AbsRelClass ar2) => FilePath ar1 -> FilePath ar2 -> IO ()
copyFile p1 p2 = SD.copyFile (getPathString p1) (getPathString p2)

removeFile :: AbsRelClass ar => FilePath ar -> IO ()
removeFile = SD.removeFile . getPathString

renameFile :: (AbsRelClass ar1, AbsRelClass ar2) => FilePath ar1 -> FilePath ar2 -> IO ()
renameFile p1 p2 = SD.renameFile (getPathString p1) (getPathString p2)

makeRelativeToCurrentDirectory :: AbsRelClass ar => Path ar fd -> IO (RelPath fd)
makeRelativeToCurrentDirectory p = mkPath <$> SD.makeRelativeToCurrentDirectory (getPathString p)

renameDirectory :: (AbsRelClass ar1, AbsRelClass ar2) => DirPath ar1 -> DirPath ar2 -> IO ()
renameDirectory p1 p2 = SD.renameDirectory (getPathString p1) (getPathString p2)

canonicalizePath :: AbsRelClass ar => Path ar fd -> IO (AbsPath fd)
canonicalizePath p = mkPath <$> SD.canonicalizePath (getPathString p)

{-
findExecutable :: String -> IO (Maybe FilePath)
getPermissions :: FilePath -> IO Permissions
setPermissions :: FilePath -> Permissions -> IO ()
getModificationTime :: FilePath -> IO ClockTime
-}


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

testall = do
  putStrLn "Running QuickCheck tests..."
  quickCheck prop_mkPathFromComponents_pathComponents
  quickCheck prop_mkAbsFromRel_endSame
  quickCheck prop_mkAbsFromRel_startSame
  quickCheck prop_split_combine
  quickCheck prop_takeFileName_end
  quickCheck prop_splitCombine
  putStrLn "Tests completed."

vectorOf :: Gen a -> Int -> Gen [a]
vectorOf gen n = sequence [ gen | i <- [1..n] ]

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

qcFilePath :: Gen (FilePath ar)
qcFilePath = do
  numDirs <- arbitrary
  pcs <- vectorOf qcDirComponent numDirs
  pc <- qcFileComponent
  return $ mkPathFromComponents (pcs ++ [pc])

qcDirPath :: Gen (DirPath ar)
qcDirPath = do
  numDirs <- arbitrary
  pcs <- vectorOf qcDirComponent numDirs
  pc <- qcDirComponent
  return $ mkPathFromComponents (pcs ++ [pc])

-- qcPath :: (AbsRelClass ar, FileDirClass fd) => Gen (Path ar fd)
-- qcPath = absRel

instance Arbitrary PathComponent where
    arbitrary = oneof [qcFileComponent, qcDirComponent]
    coarbitrary = error "No PathComponent coarbitrary"

instance Arbitrary (Path ar File) where
    arbitrary = qcFilePath
    coarbitrary = error "No (FilePath ar) coarbitrary"

instance Arbitrary (Path ar Dir)  where
    arbitrary = qcDirPath
    coarbitrary = error "No DirPath coarbitrary"