-- | A more type-safe version of file paths
--
-- This module is intended to replace imports of System.FilePath, and
-- additionally exports thin wrappers around common IO functions.  To facilitate
-- importing this module unqualified we also re-export some  definitions from
-- System.IO (importing both would likely lead to name clashes).
--
-- Note that his module does not import any other modules from Hackage.Security;
-- everywhere else we use Path instead of FilePath directly.
{-# LANGUAGE CPP #-}
module Hackage.Security.Util.Path (
    -- * Paths
    Path(..)
  , castRoot
    -- * FilePath-like operations on paths with arbitrary roots
  , takeDirectory
  , takeFileName
  , (<.>)
  , splitExtension
  , takeExtension
    -- * Unrooted paths
  , Unrooted
  , (</>)
  , rootPath
  , unrootPath
  , toUnrootedFilePath
  , fromUnrootedFilePath
  , fragment
  , joinFragments
  , splitFragments
  , isPathPrefixOf
    -- * File-system paths
  , Relative
  , Absolute
  , HomeDir
  , FsRoot(..)
  , FsPath(..)
    -- ** Conversions
  , toFilePath
  , fromFilePath
  , makeAbsolute
  , fromAbsoluteFilePath
    -- ** Wrappers around System.IO
  , withFile
  , openTempFile'
    -- ** Wrappers around Data.ByteString
  , readLazyByteString
  , readStrictByteString
  , writeLazyByteString
  , writeStrictByteString
    -- ** Wrappers around System.Directory
  , copyFile
  , createDirectory
  , createDirectoryIfMissing
  , removeDirectory
  , doesFileExist
  , doesDirectoryExist
  , getModificationTime
  , removeFile
  , getTemporaryDirectory
  , getDirectoryContents
  , getRecursiveContents
  , renameFile
  , getCurrentDirectory
    -- * Wrappers around Codec.Archive.Tar
  , Tar
  , tarIndexLookup
  , tarAppend
    -- * Wrappers around Network.URI
  , Web
  , toURIPath
  , fromURIPath
  , uriPath
  , modifyUriPath
    -- * Re-exports
  , IOMode(..)
  , BufferMode(..)
  , Handle
  , SeekMode(..)
  , IO.hSetBuffering
  , IO.hClose
  , IO.hFileSize
  , IO.hSeek
  ) where

import MyPrelude
import Control.Monad
import Data.List (isPrefixOf)
import System.IO (IOMode(..), BufferMode(..), Handle, SeekMode(..))
import System.IO.Unsafe (unsafeInterleaveIO)
#if MIN_VERSION_directory(1,2,0)
import Data.Time (UTCTime)
#else
import System.Time (ClockTime)
#endif
import qualified Data.ByteString         as BS
import qualified Data.ByteString.Lazy    as BS.L
import qualified System.FilePath         as FP.Native
import qualified System.FilePath.Posix   as FP.Posix
import qualified System.IO               as IO
import qualified System.Directory        as Dir
import qualified Codec.Archive.Tar       as Tar
import qualified Codec.Archive.Tar.Index as TarIndex
import qualified Network.URI             as URI

import Hackage.Security.Util.Pretty

{-------------------------------------------------------------------------------
  Paths
-------------------------------------------------------------------------------}

-- | Paths
--
-- A 'Path' is simply a 'FilePath' with a type-level tag indicating where this
-- path is rooted (relative to the current directory, absolute path, relative to
-- a web domain, whatever). Most operations on 'Path' are just lifted versions
-- of the operations on the underlying 'FilePath'. The tag however allows us to
-- give a lot of operations a more meaningful type. For instance, it does not
-- make sense to append two absolute paths together; instead, we can only append
-- an unrooted path to another path. It also means we avoid bugs where we use
-- one kind of path where we expect another.
newtype Path a = Path FilePath -- always a Posix style path internally
  deriving (Int -> Path a -> ShowS
[Path a] -> ShowS
Path a -> String
(Int -> Path a -> ShowS)
-> (Path a -> String) -> ([Path a] -> ShowS) -> Show (Path a)
forall a. Int -> Path a -> ShowS
forall a. [Path a] -> ShowS
forall a. Path a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Path a -> ShowS
showsPrec :: Int -> Path a -> ShowS
$cshow :: forall a. Path a -> String
show :: Path a -> String
$cshowList :: forall a. [Path a] -> ShowS
showList :: [Path a] -> ShowS
Show, Path a -> Path a -> Bool
(Path a -> Path a -> Bool)
-> (Path a -> Path a -> Bool) -> Eq (Path a)
forall a. Path a -> Path a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Path a -> Path a -> Bool
== :: Path a -> Path a -> Bool
$c/= :: forall a. Path a -> Path a -> Bool
/= :: Path a -> Path a -> Bool
Eq, Eq (Path a)
Eq (Path a) =>
(Path a -> Path a -> Ordering)
-> (Path a -> Path a -> Bool)
-> (Path a -> Path a -> Bool)
-> (Path a -> Path a -> Bool)
-> (Path a -> Path a -> Bool)
-> (Path a -> Path a -> Path a)
-> (Path a -> Path a -> Path a)
-> Ord (Path a)
Path a -> Path a -> Bool
Path a -> Path a -> Ordering
Path a -> Path a -> Path a
forall a. Eq (Path a)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Path a -> Path a -> Bool
forall a. Path a -> Path a -> Ordering
forall a. Path a -> Path a -> Path a
$ccompare :: forall a. Path a -> Path a -> Ordering
compare :: Path a -> Path a -> Ordering
$c< :: forall a. Path a -> Path a -> Bool
< :: Path a -> Path a -> Bool
$c<= :: forall a. Path a -> Path a -> Bool
<= :: Path a -> Path a -> Bool
$c> :: forall a. Path a -> Path a -> Bool
> :: Path a -> Path a -> Bool
$c>= :: forall a. Path a -> Path a -> Bool
>= :: Path a -> Path a -> Bool
$cmax :: forall a. Path a -> Path a -> Path a
max :: Path a -> Path a -> Path a
$cmin :: forall a. Path a -> Path a -> Path a
min :: Path a -> Path a -> Path a
Ord)

mkPathNative :: FilePath -> Path a
mkPathNative :: forall a. String -> Path a
mkPathNative = String -> Path a
forall a. String -> Path a
Path (String -> Path a) -> ShowS -> String -> Path a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
FP.Posix.joinPath ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
FP.Native.splitDirectories

unPathNative :: Path a -> FilePath
unPathNative :: forall a. Path a -> String
unPathNative (Path String
fp) = [String] -> String
FP.Native.joinPath ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
FP.Posix.splitDirectories ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
fp

mkPathPosix :: FilePath -> Path a
mkPathPosix :: forall a. String -> Path a
mkPathPosix = String -> Path a
forall a. String -> Path a
Path

unPathPosix :: Path a -> FilePath
unPathPosix :: forall a. Path a -> String
unPathPosix (Path String
fp) = String
fp

-- | Reinterpret the root of a path
--
-- This literally just changes the type-level tag; use with caution!
castRoot :: Path root -> Path root'
castRoot :: forall root root'. Path root -> Path root'
castRoot (Path String
fp) = String -> Path root'
forall a. String -> Path a
Path String
fp

{-------------------------------------------------------------------------------
  FilePath-like operations on paths with an arbitrary root
-------------------------------------------------------------------------------}

takeDirectory :: Path a -> Path a
takeDirectory :: forall a. Path a -> Path a
takeDirectory = ShowS -> Path a -> Path a
forall a b. ShowS -> Path a -> Path b
liftFP ShowS
FP.Posix.takeDirectory

takeFileName :: Path a -> String
takeFileName :: forall a. Path a -> String
takeFileName = ShowS -> Path a -> String
forall x a. (String -> x) -> Path a -> x
liftFromFP ShowS
FP.Posix.takeFileName

(<.>) :: Path a -> String -> Path a
Path a
fp <.> :: forall a. Path a -> String -> Path a
<.> String
ext = ShowS -> Path a -> Path a
forall a b. ShowS -> Path a -> Path b
liftFP (String -> ShowS
FP.Posix.<.> String
ext) Path a
fp

splitExtension :: Path a -> (Path a, String)
splitExtension :: forall a. Path a -> (Path a, String)
splitExtension (Path String
fp) = (String -> Path a
forall a. String -> Path a
Path String
fp', String
ext)
  where
    (String
fp', String
ext) = String -> (String, String)
FP.Posix.splitExtension String
fp

takeExtension :: Path a -> String
takeExtension :: forall a. Path a -> String
takeExtension (Path String
fp) = ShowS
FP.Posix.takeExtension String
fp

{-------------------------------------------------------------------------------
  Unrooted paths
-------------------------------------------------------------------------------}

-- | Type-level tag for unrooted paths
--
-- Unrooted paths need a root before they can be interpreted.
data Unrooted

instance Pretty (Path Unrooted) where
  pretty :: Path Unrooted -> String
pretty (Path String
fp) = String
fp

(</>) :: Path a -> Path Unrooted -> Path a
</> :: forall a. Path a -> Path Unrooted -> Path a
(</>) = (String -> ShowS) -> Path a -> Path Unrooted -> Path a
forall a b c. (String -> ShowS) -> Path a -> Path b -> Path c
liftFP2 String -> ShowS
(FP.Posix.</>)

-- | Reinterpret an unrooted path
--
-- This is an alias for 'castRoot'; see comments there.
rootPath :: Path Unrooted -> Path root
rootPath :: forall root. Path Unrooted -> Path root
rootPath (Path String
fp) = String -> Path root
forall a. String -> Path a
Path String
fp

-- | Forget a path's root
--
-- This is an alias for 'castRoot'; see comments there.
unrootPath :: Path root -> Path Unrooted
unrootPath :: forall root. Path root -> Path Unrooted
unrootPath (Path String
fp) = String -> Path Unrooted
forall a. String -> Path a
Path String
fp

-- | Convert a relative\/unrooted Path to a FilePath (using POSIX style
-- directory separators).
--
-- See also 'toAbsoluteFilePath'
--
toUnrootedFilePath :: Path Unrooted -> FilePath
toUnrootedFilePath :: Path Unrooted -> String
toUnrootedFilePath = Path Unrooted -> String
forall a. Path a -> String
unPathPosix

-- | Convert from a relative\/unrooted FilePath (using POSIX style directory
-- separators).
--
fromUnrootedFilePath :: FilePath -> Path Unrooted
fromUnrootedFilePath :: String -> Path Unrooted
fromUnrootedFilePath = String -> Path Unrooted
forall a. String -> Path a
mkPathPosix

-- | A path fragment (like a single directory or filename)
fragment :: String -> Path Unrooted
fragment :: String -> Path Unrooted
fragment = String -> Path Unrooted
forall a. String -> Path a
Path

joinFragments :: [String] -> Path Unrooted
joinFragments :: [String] -> Path Unrooted
joinFragments = ([String] -> String) -> [String] -> Path Unrooted
forall x a. (x -> String) -> x -> Path a
liftToFP [String] -> String
FP.Posix.joinPath

splitFragments :: Path Unrooted -> [String]
splitFragments :: Path Unrooted -> [String]
splitFragments (Path String
fp) = String -> [String]
FP.Posix.splitDirectories String
fp

isPathPrefixOf :: Path Unrooted -> Path Unrooted -> Bool
isPathPrefixOf :: Path Unrooted -> Path Unrooted -> Bool
isPathPrefixOf = (String -> String -> Bool)
-> Path Unrooted -> Path Unrooted -> Bool
forall x a b. (String -> String -> x) -> Path a -> Path b -> x
liftFromFP2 String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf

{-------------------------------------------------------------------------------
  File-system paths
-------------------------------------------------------------------------------}

data Relative
data Absolute
data HomeDir

instance Pretty (Path Absolute) where
  pretty :: Path Absolute -> String
pretty (Path String
fp) = String
fp

instance Pretty (Path Relative) where
  pretty :: Path Relative -> String
pretty (Path String
fp) = String
"./" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fp

instance Pretty (Path HomeDir) where
  pretty :: Path HomeDir -> String
pretty (Path String
fp) = String
"~/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fp

-- | A file system root can be interpreted as an (absolute) FilePath
class FsRoot root where
  -- | Convert a Path to an absolute FilePath (using native style directory separators).
  --
  toAbsoluteFilePath :: Path root -> IO FilePath

instance FsRoot Relative where
    toAbsoluteFilePath :: Path Relative -> IO String
toAbsoluteFilePath Path Relative
p = String -> IO String
go (Path Relative -> String
forall a. Path a -> String
unPathNative Path Relative
p)
      where
        go :: FilePath -> IO FilePath
#if MIN_VERSION_directory(1,2,2)
        go :: String -> IO String
go = String -> IO String
Dir.makeAbsolute
#else
        -- copied implementation from the directory package
        go = (FP.Native.normalise <$>) . absolutize
        absolutize path -- avoid the call to `getCurrentDirectory` if we can
          | FP.Native.isRelative path
                      = (FP.Native.</> path)
                      . FP.Native.addTrailingPathSeparator <$>
                        Dir.getCurrentDirectory
          | otherwise = return path
#endif

instance FsRoot Absolute where
    toAbsoluteFilePath :: Path Absolute -> IO String
toAbsoluteFilePath = String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (Path Absolute -> String) -> Path Absolute -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Absolute -> String
forall a. Path a -> String
unPathNative

instance FsRoot HomeDir where
    toAbsoluteFilePath :: Path HomeDir -> IO String
toAbsoluteFilePath Path HomeDir
p = do
      String
home <- IO String
Dir.getHomeDirectory
      String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
home String -> ShowS
FP.Native.</> Path HomeDir -> String
forall a. Path a -> String
unPathNative Path HomeDir
p

-- | Abstract over a file system root
--
-- see 'fromFilePath'
data FsPath = forall root. FsRoot root => FsPath (Path root)

{-------------------------------------------------------------------------------
  Conversions
-------------------------------------------------------------------------------}

toFilePath :: Path Absolute -> FilePath
toFilePath :: Path Absolute -> String
toFilePath = Path Absolute -> String
forall a. Path a -> String
unPathNative

fromFilePath :: FilePath -> FsPath
fromFilePath :: String -> FsPath
fromFilePath String
fp
    | String -> Bool
FP.Native.isAbsolute String
fp = Path Absolute -> FsPath
forall root. FsRoot root => Path root -> FsPath
FsPath (String -> Path Absolute
forall a. String -> Path a
mkPathNative String
fp  :: Path Absolute)
    | Just String
fp' <- String -> Maybe String
atHome String
fp   = Path HomeDir -> FsPath
forall root. FsRoot root => Path root -> FsPath
FsPath (String -> Path HomeDir
forall a. String -> Path a
mkPathNative String
fp' :: Path HomeDir)
    | Bool
otherwise               = Path Relative -> FsPath
forall root. FsRoot root => Path root -> FsPath
FsPath (String -> Path Relative
forall a. String -> Path a
mkPathNative String
fp  :: Path Relative)
  where
    -- TODO: I don't know if there a standard way that Windows users refer to
    -- their home directory. For now, we'll only interpret '~'. Everybody else
    -- can specify an absolute path if this doesn't work.
    atHome :: FilePath -> Maybe FilePath
    atHome :: String -> Maybe String
atHome String
"~" = String -> Maybe String
forall a. a -> Maybe a
Just String
""
    atHome (Char
'~':Char
sep:String
fp') | Char -> Bool
FP.Native.isPathSeparator Char
sep = String -> Maybe String
forall a. a -> Maybe a
Just String
fp'
    atHome String
_otherwise = Maybe String
forall a. Maybe a
Nothing

makeAbsolute :: FsPath -> IO (Path Absolute)
makeAbsolute :: FsPath -> IO (Path Absolute)
makeAbsolute (FsPath Path root
p) = String -> Path Absolute
forall a. String -> Path a
mkPathNative (String -> Path Absolute) -> IO String -> IO (Path Absolute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
p

fromAbsoluteFilePath :: FilePath -> Path Absolute
fromAbsoluteFilePath :: String -> Path Absolute
fromAbsoluteFilePath String
fp
  | String -> Bool
FP.Native.isAbsolute String
fp = String -> Path Absolute
forall a. String -> Path a
mkPathNative String
fp
  | Bool
otherwise               = String -> Path Absolute
forall a. HasCallStack => String -> a
error (String
"fromAbsoluteFilePath: not an absolute path: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fp)

{-------------------------------------------------------------------------------
  Wrappers around System.IO
-------------------------------------------------------------------------------}

-- | Wrapper around 'withFile'
withFile :: FsRoot root => Path root -> IOMode -> (Handle -> IO r) -> IO r
withFile :: forall root r.
FsRoot root =>
Path root -> IOMode -> (Handle -> IO r) -> IO r
withFile Path root
path IOMode
mode Handle -> IO r
callback = do
    String
filePath <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path
    String -> IOMode -> (Handle -> IO r) -> IO r
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile String
filePath IOMode
mode Handle -> IO r
callback

-- | Wrapper around 'openBinaryTempFileWithDefaultPermissions'
--
-- NOTE: The caller is responsible for cleaning up the temporary file.
openTempFile' :: FsRoot root => Path root -> String -> IO (Path Absolute, Handle)
openTempFile' :: forall root.
FsRoot root =>
Path root -> String -> IO (Path Absolute, Handle)
openTempFile' Path root
path String
template = do
    String
filePath <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path
    (String
tempFilePath, Handle
h) <- String -> String -> IO (String, Handle)
IO.openBinaryTempFileWithDefaultPermissions String
filePath String
template
    (Path Absolute, Handle) -> IO (Path Absolute, Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Path Absolute
fromAbsoluteFilePath String
tempFilePath, Handle
h)

{-------------------------------------------------------------------------------
  Wrappers around Data.ByteString.*
-------------------------------------------------------------------------------}

readLazyByteString :: FsRoot root => Path root -> IO BS.L.ByteString
readLazyByteString :: forall root. FsRoot root => Path root -> IO ByteString
readLazyByteString Path root
path = do
    String
filePath <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path
    String -> IO ByteString
BS.L.readFile String
filePath

readStrictByteString :: FsRoot root => Path root -> IO BS.ByteString
readStrictByteString :: forall root. FsRoot root => Path root -> IO ByteString
readStrictByteString Path root
path = do
    String
filePath <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path
    String -> IO ByteString
BS.readFile String
filePath

writeLazyByteString :: FsRoot root => Path root -> BS.L.ByteString -> IO ()
writeLazyByteString :: forall root. FsRoot root => Path root -> ByteString -> IO ()
writeLazyByteString Path root
path ByteString
bs = do
    String
filePath <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path
    String -> ByteString -> IO ()
BS.L.writeFile String
filePath ByteString
bs

writeStrictByteString :: FsRoot root => Path root -> BS.ByteString -> IO ()
writeStrictByteString :: forall root. FsRoot root => Path root -> ByteString -> IO ()
writeStrictByteString Path root
path ByteString
bs = do
    String
filePath <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path
    String -> ByteString -> IO ()
BS.writeFile String
filePath ByteString
bs

{-------------------------------------------------------------------------------
  Wrappers around System.Directory
-------------------------------------------------------------------------------}

copyFile :: (FsRoot root, FsRoot root') => Path root -> Path root' -> IO ()
copyFile :: forall root root'.
(FsRoot root, FsRoot root') =>
Path root -> Path root' -> IO ()
copyFile Path root
src Path root'
dst = do
    String
src' <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
src
    String
dst' <- Path root' -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root'
dst
    String -> String -> IO ()
Dir.copyFile String
src' String
dst'

createDirectory :: FsRoot root => Path root -> IO ()
createDirectory :: forall root. FsRoot root => Path root -> IO ()
createDirectory Path root
path = String -> IO ()
Dir.createDirectory (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path

createDirectoryIfMissing :: FsRoot root => Bool -> Path root -> IO ()
createDirectoryIfMissing :: forall root. FsRoot root => Bool -> Path root -> IO ()
createDirectoryIfMissing Bool
createParents Path root
path = do
    String
filePath <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path
    Bool -> String -> IO ()
Dir.createDirectoryIfMissing Bool
createParents String
filePath

removeDirectory :: FsRoot root => Path root -> IO ()
removeDirectory :: forall root. FsRoot root => Path root -> IO ()
removeDirectory Path root
path = String -> IO ()
Dir.removeDirectory (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path

doesFileExist :: FsRoot root => Path root -> IO Bool
doesFileExist :: forall root. FsRoot root => Path root -> IO Bool
doesFileExist Path root
path = do
    String
filePath <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path
    String -> IO Bool
Dir.doesFileExist String
filePath

doesDirectoryExist :: FsRoot root => Path root -> IO Bool
doesDirectoryExist :: forall root. FsRoot root => Path root -> IO Bool
doesDirectoryExist Path root
path = do
    String
filePath <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path
    String -> IO Bool
Dir.doesDirectoryExist String
filePath

#if MIN_VERSION_directory(1,2,0)
getModificationTime :: FsRoot root => Path root -> IO UTCTime
#else
getModificationTime :: FsRoot root => Path root -> IO ClockTime
#endif
getModificationTime :: forall root. FsRoot root => Path root -> IO UTCTime
getModificationTime Path root
path = do
    String
filePath <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path
    String -> IO UTCTime
Dir.getModificationTime String
filePath

removeFile :: FsRoot root => Path root -> IO ()
removeFile :: forall root. FsRoot root => Path root -> IO ()
removeFile Path root
path = do
    String
filePath <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path
    String -> IO ()
Dir.removeFile String
filePath

getTemporaryDirectory :: IO (Path Absolute)
getTemporaryDirectory :: IO (Path Absolute)
getTemporaryDirectory = String -> Path Absolute
fromAbsoluteFilePath (String -> Path Absolute) -> IO String -> IO (Path Absolute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
Dir.getTemporaryDirectory

-- | Return the immediate children of a directory
--
-- Filters out @"."@ and @".."@.
getDirectoryContents :: FsRoot root => Path root -> IO [Path Unrooted]
getDirectoryContents :: forall root. FsRoot root => Path root -> IO [Path Unrooted]
getDirectoryContents Path root
path = do
    String
filePath <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
path
    [String] -> [Path Unrooted]
fragments ([String] -> [Path Unrooted]) -> IO [String] -> IO [Path Unrooted]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
Dir.getDirectoryContents String
filePath
  where
    fragments :: [String] -> [Path Unrooted]
    fragments :: [String] -> [Path Unrooted]
fragments = (String -> Path Unrooted) -> [String] -> [Path Unrooted]
forall a b. (a -> b) -> [a] -> [b]
map String -> Path Unrooted
fragment ([String] -> [Path Unrooted])
-> ([String] -> [String]) -> [String] -> [Path Unrooted]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
skip)

    skip :: String -> Bool
    skip :: String -> Bool
skip String
"."  = Bool
True
    skip String
".." = Bool
True
    skip String
_    = Bool
False

-- | Recursive traverse a directory structure
--
-- Returns a set of paths relative to the directory specified. The list is
-- lazily constructed, so that directories are only read when required.
-- (This is also essential to ensure that this function does not build the
-- entire result in memory before returning, potentially running out of heap.)
getRecursiveContents :: FsRoot root => Path root -> IO [Path Unrooted]
getRecursiveContents :: forall root. FsRoot root => Path root -> IO [Path Unrooted]
getRecursiveContents Path root
root = Path Unrooted -> IO [Path Unrooted]
go Path Unrooted
emptyPath
  where
    go :: Path Unrooted -> IO [Path Unrooted]
    go :: Path Unrooted -> IO [Path Unrooted]
go Path Unrooted
subdir = IO [Path Unrooted] -> IO [Path Unrooted]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [Path Unrooted] -> IO [Path Unrooted])
-> IO [Path Unrooted] -> IO [Path Unrooted]
forall a b. (a -> b) -> a -> b
$ do
      [Path Unrooted]
entries <- Path root -> IO [Path Unrooted]
forall root. FsRoot root => Path root -> IO [Path Unrooted]
getDirectoryContents (Path root
root Path root -> Path Unrooted -> Path root
forall a. Path a -> Path Unrooted -> Path a
</> Path Unrooted
subdir)
      ([[Path Unrooted]] -> [Path Unrooted])
-> IO [[Path Unrooted]] -> IO [Path Unrooted]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[Path Unrooted]] -> [Path Unrooted]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[Path Unrooted]] -> IO [Path Unrooted])
-> IO [[Path Unrooted]] -> IO [Path Unrooted]
forall a b. (a -> b) -> a -> b
$ [Path Unrooted]
-> (Path Unrooted -> IO [Path Unrooted]) -> IO [[Path Unrooted]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Path Unrooted]
entries ((Path Unrooted -> IO [Path Unrooted]) -> IO [[Path Unrooted]])
-> (Path Unrooted -> IO [Path Unrooted]) -> IO [[Path Unrooted]]
forall a b. (a -> b) -> a -> b
$ \Path Unrooted
entry -> do
        let path :: Path Unrooted
path = Path Unrooted
subdir Path Unrooted -> Path Unrooted -> Path Unrooted
forall a. Path a -> Path Unrooted -> Path a
</> Path Unrooted
entry
        Bool
isDirectory <- Path root -> IO Bool
forall root. FsRoot root => Path root -> IO Bool
doesDirectoryExist (Path root
root Path root -> Path Unrooted -> Path root
forall a. Path a -> Path Unrooted -> Path a
</> Path Unrooted
path)
        if Bool
isDirectory then Path Unrooted -> IO [Path Unrooted]
go Path Unrooted
path
                       else [Path Unrooted] -> IO [Path Unrooted]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Path Unrooted
path]

    emptyPath :: Path Unrooted
    emptyPath :: Path Unrooted
emptyPath = [String] -> Path Unrooted
joinFragments []

renameFile :: (FsRoot root, FsRoot root')
           => Path root  -- ^ Old
           -> Path root' -- ^ New
           -> IO ()
renameFile :: forall root root'.
(FsRoot root, FsRoot root') =>
Path root -> Path root' -> IO ()
renameFile Path root
old Path root'
new = do
    String
old' <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
old
    String
new' <- Path root' -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root'
new
    String -> String -> IO ()
Dir.renameFile String
old' String
new'

getCurrentDirectory :: IO (Path Absolute)
getCurrentDirectory :: IO (Path Absolute)
getCurrentDirectory = do
    String
cwd <- IO String
Dir.getCurrentDirectory
    FsPath -> IO (Path Absolute)
makeAbsolute (FsPath -> IO (Path Absolute)) -> FsPath -> IO (Path Absolute)
forall a b. (a -> b) -> a -> b
$ String -> FsPath
fromFilePath String
cwd

{-------------------------------------------------------------------------------
  Wrappers around Codec.Archive.Tar.*
-------------------------------------------------------------------------------}

data Tar

instance Pretty (Path Tar) where
  pretty :: Path Tar -> String
pretty (Path String
fp) = String
"<tarball>/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fp

tarIndexLookup :: TarIndex.TarIndex -> Path Tar -> Maybe TarIndex.TarIndexEntry
tarIndexLookup :: TarIndex -> Path Tar -> Maybe TarIndexEntry
tarIndexLookup TarIndex
index Path Tar
path = TarIndex -> String -> Maybe TarIndexEntry
TarIndex.lookup TarIndex
index String
path'
  where
    path' :: FilePath
    path' :: String
path' = Path Unrooted -> String
toUnrootedFilePath (Path Unrooted -> String) -> Path Unrooted -> String
forall a b. (a -> b) -> a -> b
$ Path Tar -> Path Unrooted
forall root. Path root -> Path Unrooted
unrootPath Path Tar
path

tarAppend :: (FsRoot root, FsRoot root')
          => Path root   -- ^ Path of the @.tar@ file
          -> Path root'  -- ^ Base directory
          -> [Path Tar]  -- ^ Files to add, relative to the base dir
          -> IO ()
tarAppend :: forall root root'.
(FsRoot root, FsRoot root') =>
Path root -> Path root' -> [Path Tar] -> IO ()
tarAppend Path root
tarFile Path root'
baseDir [Path Tar]
contents = do
    String
tarFile' <- Path root -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root
tarFile
    String
baseDir' <- Path root' -> IO String
forall root. FsRoot root => Path root -> IO String
toAbsoluteFilePath Path root'
baseDir
    String -> String -> [String] -> IO ()
Tar.append String
tarFile' String
baseDir' [String]
contents'
  where
    contents' :: [FilePath]
    contents' :: [String]
contents' = (Path Tar -> String) -> [Path Tar] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Path Unrooted -> String
forall a. Path a -> String
unPathNative (Path Unrooted -> String)
-> (Path Tar -> Path Unrooted) -> Path Tar -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Tar -> Path Unrooted
forall root. Path root -> Path Unrooted
unrootPath) [Path Tar]
contents

{-------------------------------------------------------------------------------
  Wrappers around Network.URI
-------------------------------------------------------------------------------}

data Web

toURIPath :: FilePath -> Path Web
toURIPath :: String -> Path Web
toURIPath = Path Unrooted -> Path Web
forall root. Path Unrooted -> Path root
rootPath (Path Unrooted -> Path Web)
-> (String -> Path Unrooted) -> String -> Path Web
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path Unrooted
fromUnrootedFilePath

fromURIPath :: Path Web -> FilePath
fromURIPath :: Path Web -> String
fromURIPath = Path Unrooted -> String
toUnrootedFilePath (Path Unrooted -> String)
-> (Path Web -> Path Unrooted) -> Path Web -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Web -> Path Unrooted
forall root. Path root -> Path Unrooted
unrootPath

uriPath :: URI.URI -> Path Web
uriPath :: URI -> Path Web
uriPath = String -> Path Web
toURIPath (String -> Path Web) -> (URI -> String) -> URI -> Path Web
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
URI.uriPath

modifyUriPath :: URI.URI -> (Path Web -> Path Web) -> URI.URI
modifyUriPath :: URI -> (Path Web -> Path Web) -> URI
modifyUriPath URI
uri Path Web -> Path Web
f = URI
uri { URI.uriPath = f' (URI.uriPath uri) }
  where
    f' :: FilePath -> FilePath
    f' :: ShowS
f' = Path Web -> String
fromURIPath (Path Web -> String) -> (String -> Path Web) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Web -> Path Web
f (Path Web -> Path Web)
-> (String -> Path Web) -> String -> Path Web
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path Web
toURIPath

{-------------------------------------------------------------------------------
  Auxiliary
-------------------------------------------------------------------------------}

liftFP :: (FilePath -> FilePath) -> Path a -> Path b
liftFP :: forall a b. ShowS -> Path a -> Path b
liftFP ShowS
f (Path String
fp) = String -> Path b
forall a. String -> Path a
Path (ShowS
f String
fp)

liftFP2 :: (FilePath -> FilePath -> FilePath) -> Path a -> Path b -> Path c
liftFP2 :: forall a b c. (String -> ShowS) -> Path a -> Path b -> Path c
liftFP2 String -> ShowS
f (Path String
fp) (Path String
fp') = String -> Path c
forall a. String -> Path a
Path (String -> ShowS
f String
fp String
fp')

liftFromFP :: (FilePath -> x) -> Path a -> x
liftFromFP :: forall x a. (String -> x) -> Path a -> x
liftFromFP String -> x
f (Path String
fp) = String -> x
f String
fp

liftFromFP2 :: (FilePath -> FilePath -> x) -> Path a -> Path b -> x
liftFromFP2 :: forall x a b. (String -> String -> x) -> Path a -> Path b -> x
liftFromFP2 String -> String -> x
f (Path String
fp) (Path String
fp') = String -> String -> x
f String
fp String
fp'

liftToFP :: (x -> FilePath) -> x -> Path a
liftToFP :: forall x a. (x -> String) -> x -> Path a
liftToFP x -> String
f x
x = String -> Path a
forall a. String -> Path a
Path (x -> String
f x
x)