---------------------------------------------------------------------
-- Module      :  FileIO.Strings
--
----------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-missing-methods #-}

module Uniform.FileStrings
  ( module Uniform.Filenames,
    module Uniform.FileIOalgebra,
    SIO.IOMode (..),
    closeFile2,
    listDir',
    TIO.hGetLine,
    TIO.hPutStr,
  )
where

import Control.Arrow (first, second)
import Control.DeepSeq (force, ($!!))
import Control.Exception (SomeException, catch)
import Control.Monad (filterM, when)
import Control.Monad.Catch as Catch
  ( Exception,
    MonadThrow,
    SomeException,
  )
import Control.Monad.IO.Class (MonadIO (..))
import qualified Data.ByteString as BS (readFile, writeFile)
import qualified Data.ByteString.Lazy as L
import Data.Digest.Pure.MD5 (md5)
import Data.Either (isLeft)
import Data.List (isPrefixOf)
import Data.Maybe (catMaybes)
import qualified Data.Text.IO as T (appendFile, readFile, writeFile)
import qualified Data.Text.IO as TIO (hGetLine, hPutStr)
import qualified Path
import qualified Path.IO as PathIO
import qualified System.Directory as D
import qualified System.FilePath as OS
import qualified System.IO as SIO
import System.Posix (FileMode)
import qualified System.Posix as Posix
import Uniform.FileIOalgebra
import Uniform.FileStatus
import Uniform.Filenames
import Uniform.Filenames as FN (toFilePath)
import Uniform.Strings -- (Text)
import Uniform.Error


closeFile2 :: SIO.Handle -> ErrIO ()
-- close a handle, does not need a filepath
closeFile2 :: Handle -> ErrIO ()
closeFile2 Handle
handle = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
SIO.hClose Handle
handle

instance FileHandles String where
  write2handle :: Handle -> FilePath -> ErrIO ()
write2handle Handle
h FilePath
c = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
SIO.hPutStr Handle
h FilePath
c
  readLine4handle :: Handle -> ErrIO FilePath
readLine4handle Handle
h = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ Handle -> IO FilePath
SIO.hGetLine Handle
h

instance FileHandles L.ByteString where
  write2handle :: Handle -> ByteString -> ErrIO ()
write2handle Handle
h ByteString
c = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
L.hPutStr Handle
h ByteString
c
  readLine4handle :: Handle -> ErrIO ByteString
readLine4handle Handle
h = forall a. HasCallStack => FilePath -> a
error FilePath
"readLine4handle not implemented for lazy bytestring in FileStrings"

instance FileHandles Text where
  write2handle :: Handle -> Text -> ErrIO ()
write2handle Handle
h Text
c = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
TIO.hPutStr Handle
h Text
c
  readLine4handle :: Handle -> ErrIO Text
readLine4handle Handle
h = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ Handle -> IO Text
TIO.hGetLine Handle
h

instance FileHandles [Text] where
  write2handle :: Handle -> [Text] -> ErrIO ()
write2handle Handle
h [Text]
c = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
TIO.hPutStr Handle
h (forall a. CharChains a => [a] -> a
unlines' [Text]
c)
  readLine4handle :: Handle -> ErrIO [Text]
readLine4handle Handle
h = do
    Text
res <- forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ Handle -> IO Text
TIO.hGetLine Handle
h
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> [a]
lines' forall a b. (a -> b) -> a -> b
$ Text
res

listDir' ::
  (MonadIO m, MonadThrow m) =>
  -- | Directory to list
  Path b Dir ->
  -- | Sub-directories and files
  m ([Path Abs Dir], [Path Abs File])
listDir' :: forall (m :: * -> *) b.
(MonadIO m, MonadThrow m) =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir' Path b Dir
p = do
  ([Path Abs Dir], [Path Abs File])
abList :: ([Path.Path Abs Dir], [Path.Path Abs File]) <-
    forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
PathIO.listDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
unPath forall a b. (a -> b) -> a -> b
$ Path b Dir
p
  let abPathList :: ([Path Abs Dir], [Path Abs File])
abPathList = ([Path Abs Dir], [Path Abs File])
abList
  forall (m :: * -> *) a. Monad m => a -> m a
return ([Path Abs Dir], [Path Abs File])
abPathList

instance FileSystemOps FilePath where
  checkSymbolicLink :: FilePath -> ErrIO Bool
checkSymbolicLink FilePath
fp = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
D.pathIsSymbolicLink FilePath
fp
  getPermissions' :: FilePath -> ErrIO Permissions
getPermissions' = forall a. IO a -> ErrIO a
callIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Permissions
D.getPermissions

instance DirOps FilePath where
  doesDirExist' :: FilePath -> ErrIO Bool
doesDirExist' = forall a. IO a -> ErrIO a
callIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
D.doesDirectoryExist
  createDirIfMissing' :: FilePath -> ErrIO ()
createDirIfMissing' = forall a. IO a -> ErrIO a
callIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FilePath -> IO ()
D.createDirectoryIfMissing Bool
True

  createDir' :: FilePath -> ErrIO ()
createDir' = forall a. IO a -> ErrIO a
callIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
D.createDirectory
  renameDir' :: FilePath -> FilePath -> ErrIO ()
renameDir' FilePath
old FilePath
new = do
    forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"renamed start"]
    Bool
testSource <- forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist' FilePath
old
    Bool
testTarget <- forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist' FilePath
new
    if Bool
testTarget
      then
        forall a. Text -> ErrIO a
throwErrorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> Text
showT forall a b. (a -> b) -> a -> b
$ FilePath
new 
      else
        if Bool -> Bool
not Bool
testSource
          then
            forall a. Text -> ErrIO a
throwErrorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> Text
showT forall a b. (a -> b) -> a -> b
$ FilePath
old 
          else do
            forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn FilePath
"renamed"
            ()
r <- forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
D.renameDirectory FilePath
old FilePath
new
            forall (m :: * -> *) a. Monad m => a -> m a
return ()

  getDirectoryDirs' :: FilePath -> ErrIO [FilePath]
getDirectoryDirs' FilePath
dir = forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> ErrIO Bool
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall fp. FileOps fp => fp -> ErrIO [fp]
getDirCont FilePath
dir
    where
      f :: FilePath -> ErrIO Bool
f = forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist'
  getDirectoryDirsNonHidden' :: FilePath -> ErrIO [FilePath]
getDirectoryDirsNonHidden' FilePath
dir = forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> ErrIO Bool
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall fp. FileOps fp => fp -> ErrIO [fp]
getDirContNonHidden FilePath
dir
    where
      f :: FilePath -> ErrIO Bool
f = forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist'

  deleteDirRecursive :: FilePath -> ErrIO ()
deleteDirRecursive FilePath
f =
    do
      Bool
t <- forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist' FilePath
f
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
t forall a b. (a -> b) -> a -> b
$ do
        forall a. IO a -> ErrIO a
callIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
D.removeDirectoryRecursive forall a b. (a -> b) -> a -> b
$ FilePath
f

        forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"deleted", forall {a}. Show a => a -> Text
showT FilePath
f]

instance FileOps FilePath where
  doesFileExist' :: FilePath -> ErrIO Bool
doesFileExist' = forall a. IO a -> ErrIO a
callIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
D.doesFileExist

  copyOneFile :: FilePath -> FilePath -> ErrIO ()
copyOneFile FilePath
old FilePath
new = do
    -- source must exist, target must not exist
    Bool
t <- forall fp. FileOps fp => fp -> ErrIO Bool
doesFileExist' FilePath
old
    Bool
t2 <- forall fp. FileOps fp => fp -> ErrIO Bool
doesFileExist' FilePath
new
    if Bool
t Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
t2
      then do
        let dir :: FilePath
dir = forall fp. Filenames1 fp => fp -> FilePath
getParentDir FilePath
new -- was takeDir
        Bool
direxist <- forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist' FilePath
dir
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
direxist forall a b. (a -> b) -> a -> b
$
          forall fp. DirOps fp => fp -> ErrIO ()
createDirIfMissing' FilePath
dir
        forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
D.copyFile FilePath
old FilePath
new
      else
        if Bool -> Bool
not Bool
t
          then
            forall a. [Text] -> ErrIO a
throwErrorWords [Text
"copyFile source not exist", forall {a}. Show a => a -> Text
showT FilePath
old]
          else
            if Bool
t2
              then
                forall a. [Text] -> ErrIO a
throwErrorWords [Text
"copyFile target exist", forall {a}. Show a => a -> Text
showT FilePath
new]
              else forall a. [Text] -> ErrIO a
throwErrorWords [Text
"copyOneFile", Text
"other error"]
  copyOneFileOver :: FilePath -> FilePath -> ErrIO ()
copyOneFileOver FilePath
old FilePath
new = do
    -- may overwrite existing target
    Bool
t <- forall fp. FileOps fp => fp -> ErrIO Bool
doesFileExist' FilePath
old
    if Bool
t
      then do
        let dir :: FilePath
dir = forall fp. Filenames1 fp => fp -> FilePath
getParentDir FilePath
new -- was takeDir
        Bool
direxist <- forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist' FilePath
dir
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
direxist forall a b. (a -> b) -> a -> b
$
          forall fp. DirOps fp => fp -> ErrIO ()
createDirIfMissing' FilePath
dir
        forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
D.copyFile FilePath
old FilePath
new
      else -- not t - not existing source
        forall a. [Text] -> ErrIO a
throwErrorWords [Text
"copyFileOver source not exist", forall {a}. Show a => a -> Text
showT FilePath
old]

  getMD5 :: FilePath -> ErrIO (Maybe Text)
getMD5 FilePath
fn =
    do
      FileStatus
status <- forall fp. FileOps fp => fp -> ErrIO FileStatus
getSymbolicLinkStatus FilePath
fn
      let regular :: Bool
regular = FileStatus -> Bool
isRegularFile FileStatus
status
      Bool
readable <- forall fp. FileOps fp => fp -> (Bool, Bool, Bool) -> ErrIO Bool
getFileAccess FilePath
fn (Bool
True, Bool
False, Bool
False)
      if Bool
regular Bool -> Bool -> Bool
&& Bool
readable
        then forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ do
          ByteString
filedata :: L.ByteString <- FilePath -> IO ByteString
L.readFile FilePath
fn
          let res :: Text
res = forall {a}. Show a => a -> Text
showT forall a b. (a -> b) -> a -> b
$ ByteString -> MD5Digest
md5 ByteString
filedata
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. NFData a => (a -> b) -> a -> b
$!! (forall a. a -> Maybe a
Just Text
res)
        else forall a. [Text] -> ErrIO a
throwErrorWords [Text
"getMD5 error file not readable", forall {a}. Show a => a -> Text
showT FilePath
fn]
      forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchE` \Text
e -> do
        forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"getMD5 in FileStrings.hs", forall {a}. Show a => a -> Text
showT FilePath
fn, forall {a}. Show a => a -> Text
showT Text
e]

        forall a. [Text] -> ErrIO a
throwErrorWords [Text
"getMD5 error for", forall {a}. Show a => a -> Text
showT FilePath
fn]

  getDirCont :: FilePath -> ErrIO [FilePath]
getDirCont FilePath
fn = Bool -> FilePath -> ErrIO [FilePath]
getDirContAll Bool
True FilePath
fn

  getDirContNonHidden :: FilePath -> ErrIO [FilePath]
getDirContNonHidden FilePath
fp = do
    [FilePath]
r <- Bool -> FilePath -> ErrIO [FilePath]
getDirContAll Bool
False FilePath
fp
    forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
r

  deleteFile :: FilePath -> ErrIO ()
deleteFile FilePath
f = do
    forall a. IO a -> ErrIO a
callIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
D.removeFile forall a b. (a -> b) -> a -> b
$ FilePath
f

  getAppConfigDirectory :: ErrIO FilePath
getAppConfigDirectory = forall a. HasCallStack => FilePath -> a
error FilePath
"not implemented" -- do

  getSymbolicLinkStatus :: FilePath -> ErrIO FileStatus
getSymbolicLinkStatus FilePath
fp = do
    FileStatus
st <- forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileStatus
Posix.getSymbolicLinkStatus FilePath
fp
    forall (m :: * -> *) a. Monad m => a -> m a
return FileStatus
st

  getFileAccess :: FilePath -> (Bool, Bool, Bool) -> ErrIO Bool
getFileAccess FilePath
fp (Bool
r, Bool
w, Bool
e) =
    forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$
      FilePath -> Bool -> Bool -> Bool -> IO Bool
Posix.fileAccess FilePath
fp Bool
r Bool
w Bool
e

  getFileModificationTime :: FilePath -> ErrIO EpochTime
getFileModificationTime FilePath
fp = do
    FileStatus
stat :: Posix.FileStatus <- FilePath -> ErrIO FileStatus
getFileStatus' FilePath
fp
    let time :: EpochTime
time = FileStatus -> EpochTime
getModificationTimeFromStatus FileStatus
stat
    forall (m :: * -> *) a. Monad m => a -> m a
return EpochTime
time

  openFile2handle :: FilePath -> IOMode -> ErrIO Handle
openFile2handle FilePath
fp IOMode
mode =
    forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
SIO.openFile FilePath
fp IOMode
mode

getDirContAll :: Bool -> FilePath -> ErrIO [FilePath]
getDirContAll Bool
hiddenFlag FilePath
fn = do
  -- the hiddenFlag must be true to include them
  Bool
testDir <- forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist' FilePath
fn
  Bool
readExec <- forall fp. FileOps fp => fp -> (Bool, Bool, Bool) -> ErrIO Bool
getFileAccess FilePath
fn (Bool
True, Bool
False, Bool
True)
  if Bool
testDir Bool -> Bool -> Bool
&& Bool
readExec
    then do
      [FilePath]
r <- forall a. IO a -> ErrIO a
callIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [FilePath]
D.listDirectory forall a b. (a -> b) -> a -> b
$ FilePath
fn
      let r2 :: [FilePath]
r2 = forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
file' -> FilePath
file' forall a. Eq a => a -> a -> Bool
/= FilePath
"." Bool -> Bool -> Bool
&& FilePath
file' forall a. Eq a => a -> a -> Bool
/= FilePath
"..") [FilePath]
r
      let r3 :: [FilePath]
r3 =
            if Bool
hiddenFlag
              then [FilePath]
r2
              else forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
".") [FilePath]
r2
      let r4 :: [FilePath]
r4 = forall a b. (a -> b) -> [a] -> [b]
map (FilePath
fn forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</>) [FilePath]
r3
      forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
r4
    else
      forall a. [Text] -> ErrIO a
throwErrorWords
        [ Text
"getDirCont not exist or not readable",
          forall {a}. Show a => a -> Text
showT FilePath
fn,
          forall {a}. Show a => a -> Text
showT Bool
testDir,
          forall {a}. Show a => a -> Text
showT Bool
readExec
        ]

instance FileSystemOps (Path ar df) where
  getPermissions' :: Path ar df -> ErrIO Permissions
getPermissions' = forall (m :: * -> *) b t. MonadIO m => Path b t -> m Permissions
PathIO.getPermissions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
unPath
  checkSymbolicLink :: Path ar df -> ErrIO Bool
checkSymbolicLink Path ar df
fp = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
D.pathIsSymbolicLink (forall {b} {t}. Path b t -> FilePath
unL Path ar df
fp)

instance DirOps (Path Abs Dir) where
  doesDirExist' :: Path Abs Dir -> ErrIO Bool
doesDirExist' = forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
PathIO.doesDirExist

  createDir' :: Path Abs Dir -> ErrIO ()
createDir' = forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
PathIO.createDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
unPath

  renameDir' :: Path Abs Dir -> Path Abs Dir -> ErrIO ()
renameDir' Path Abs Dir
old Path Abs Dir
new =
    -- :: fp -> fp ->  ErrIO Text
    forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 Dir -> Path b1 Dir -> m ()
PathIO.renameDir (forall a. a -> a
unPath Path Abs Dir
old) (forall a. a -> a
unPath Path Abs Dir
new)

  getDirectoryDirs' :: Path Abs Dir -> ErrIO [Path Abs Dir]
getDirectoryDirs' Path Abs Dir
dir = do
    [FilePath]
res <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> ErrIO Bool
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall fp. FileOps fp => fp -> ErrIO [fp]
getDirCont (forall {b} {t}. Path b t -> FilePath
toFilePath Path Abs Dir
dir)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path Abs Dir
makeAbsDir forall a b. (a -> b) -> a -> b
$ [FilePath]
res
    where
      f :: FilePath -> ErrIO Bool
f = forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist'
  getDirectoryDirsNonHidden' :: Path Abs Dir -> ErrIO [Path Abs Dir]
getDirectoryDirsNonHidden' Path Abs Dir
dir = do
    [FilePath]
res <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> ErrIO Bool
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall fp. FileOps fp => fp -> ErrIO [fp]
getDirContNonHidden (forall {b} {t}. Path b t -> FilePath
toFilePath Path Abs Dir
dir)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path Abs Dir
makeAbsDir forall a b. (a -> b) -> a -> b
$ [FilePath]
res
    where
      f :: FilePath -> ErrIO Bool
f = forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist'

  createDirIfMissing' :: Path Abs Dir -> ErrIO ()
createDirIfMissing' = forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
PathIO.createDirIfMissing Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
unPath

  copyDirRecursive :: Path Abs Dir -> Path Abs Dir -> ErrIO ()
copyDirRecursive Path Abs Dir
old Path Abs Dir
new = forall (m :: * -> *) b0 b1.
(MonadIO m, MonadCatch m) =>
Path b0 Dir -> Path b1 Dir -> m ()
PathIO.copyDirRecur (forall a. a -> a
unPath Path Abs Dir
old) (forall a. a -> a
unPath Path Abs Dir
new)

  deleteDirRecursive :: Path Abs Dir -> ErrIO ()
deleteDirRecursive Path Abs Dir
f = forall fp. DirOps fp => fp -> ErrIO ()
deleteDirRecursive (forall {b} {t}. Path b t -> FilePath
unL Path Abs Dir
f)

instance DirOps (Path Rel Dir) where
  doesDirExist' :: Path Rel Dir -> ErrIO Bool
doesDirExist' = forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
PathIO.doesDirExist

  createDir' :: Path Rel Dir -> ErrIO ()
createDir' = forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
PathIO.createDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
unPath

  renameDir' :: Path Rel Dir -> Path Rel Dir -> ErrIO ()
renameDir' Path Rel Dir
old Path Rel Dir
new =
    forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 Dir -> Path b1 Dir -> m ()
PathIO.renameDir (forall a. a -> a
unPath Path Rel Dir
old) (forall a. a -> a
unPath Path Rel Dir
new)

  getDirectoryDirs' :: Path Rel Dir -> ErrIO [Path Rel Dir]
getDirectoryDirs' Path Rel Dir
dir = do
    [FilePath]
res <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> ErrIO Bool
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall fp. FileOps fp => fp -> ErrIO [fp]
getDirCont (forall {b} {t}. Path b t -> FilePath
toFilePath Path Rel Dir
dir)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path Rel Dir
makeRelDir forall a b. (a -> b) -> a -> b
$ [FilePath]
res
    where
      f :: FilePath -> ErrIO Bool
f = forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist'

  getDirectoryDirsNonHidden' :: Path Rel Dir -> ErrIO [Path Rel Dir]
getDirectoryDirsNonHidden' Path Rel Dir
dir = do
    [FilePath]
res <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> ErrIO Bool
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall fp. FileOps fp => fp -> ErrIO [fp]
getDirContNonHidden (forall {b} {t}. Path b t -> FilePath
toFilePath Path Rel Dir
dir)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path Rel Dir
makeRelDir forall a b. (a -> b) -> a -> b
$ [FilePath]
res
    where
      f :: FilePath -> ErrIO Bool
f = forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist'

  createDirIfMissing' :: Path Rel Dir -> ErrIO ()
createDirIfMissing' = forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
PathIO.createDirIfMissing Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
unPath

  copyDirRecursive :: Path Rel Dir -> Path Rel Dir -> ErrIO ()
copyDirRecursive Path Rel Dir
old Path Rel Dir
new = forall (m :: * -> *) b0 b1.
(MonadIO m, MonadCatch m) =>
Path b0 Dir -> Path b1 Dir -> m ()
PathIO.copyDirRecur (forall a. a -> a
unPath Path Rel Dir
old) (forall a. a -> a
unPath Path Rel Dir
new)

  deleteDirRecursive :: Path Rel Dir -> ErrIO ()
deleteDirRecursive Path Rel Dir
f = forall fp. DirOps fp => fp -> ErrIO ()
deleteDirRecursive (forall {b} {t}. Path b t -> FilePath
unL Path Rel Dir
f)

instance (Show (Path ar File)) => FileOps (Path ar File) where
  doesFileExist' :: Path ar File -> ErrIO Bool
doesFileExist' = forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
PathIO.doesFileExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
unPath

  copyOneFile :: Path ar File -> Path ar File -> ErrIO ()
copyOneFile Path ar File
old Path ar File
new = forall fp. FileOps fp => fp -> fp -> ErrIO ()
copyOneFile (forall {b} {t}. Path b t -> FilePath
unL Path ar File
old) (forall {b} {t}. Path b t -> FilePath
unL Path ar File
new)
  copyOneFileOver :: Path ar File -> Path ar File -> ErrIO ()
copyOneFileOver Path ar File
old Path ar File
new = forall fp. FileOps fp => fp -> fp -> ErrIO ()
copyOneFileOver (forall {b} {t}. Path b t -> FilePath
unL Path ar File
old) (forall {b} {t}. Path b t -> FilePath
unL Path ar File
new)
  renameOneFile :: Path ar File -> Path ar File -> ErrIO ()
renameOneFile Path ar File
old Path ar File
new =
    forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 File -> Path b1 File -> m ()
PathIO.renameFile (forall a. a -> a
unPath Path ar File
old) (forall a. a -> a
unPath Path ar File
new)

  deleteFile :: Path ar File -> ErrIO ()
deleteFile Path ar File
f = forall fp. FileOps fp => fp -> ErrIO ()
deleteFile (forall {b} {t}. Path b t -> FilePath
unL Path ar File
f)

  getMD5 :: Path ar File -> ErrIO (Maybe Text)
getMD5 Path ar File
fp = forall fp. FileOps fp => fp -> ErrIO (Maybe Text)
getMD5 (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp)

  getDirCont :: Path ar File -> ErrIO [Path ar File]
getDirCont Path ar File
fp =
    forall a. HasCallStack => FilePath -> a
error FilePath
"getDirCont cannot be implemented for Path"
  getDirContNonHidden :: Path ar File -> ErrIO [Path ar File]
getDirContNonHidden Path ar File
fp =
    forall a. HasCallStack => FilePath -> a
error FilePath
"getDirContentNonHidden cannot be implemented for Path"

  getFileModificationTime :: Path ar File -> ErrIO EpochTime
getFileModificationTime Path ar File
fp = forall fp. FileOps fp => fp -> ErrIO EpochTime
getFileModificationTime (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp)

  openFile2handle :: Path ar File -> IOMode -> ErrIO Handle
openFile2handle Path ar File
fp IOMode
mode = forall fp. FileOps fp => fp -> IOMode -> ErrIO Handle
openFile2handle (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp) IOMode
mode

  getFileAccess :: Path ar File -> (Bool, Bool, Bool) -> ErrIO Bool
getFileAccess Path ar File
fp (Bool
r, Bool
w, Bool
e) =
    forall a. IO a -> ErrIO a
callIO
      ( do
          FilePath -> Bool -> Bool -> Bool -> IO Bool
Posix.fileAccess (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp) Bool
r Bool
w Bool
e
          forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException
e -> do
            forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"getFileAccess error", forall {a}. Show a => a -> Text
showT Path ar File
fp, FilePath -> Text
s2t forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show (SomeException
e::SomeException)]
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      )

unL :: Path b t -> FilePath
unL = forall {b} {t}. Path b t -> FilePath
FN.toFilePath

readFileT :: Path ar File -> ErrIO Text
readFileT :: forall ar. Path ar File -> ErrIO Text
readFileT Path ar File
fp = forall a. IO a -> ErrIO a
callIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Text
T.readFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b} {t}. Path b t -> FilePath
unL forall a b. (a -> b) -> a -> b
$ Path ar File
fp

writeFileT :: Path ar File -> Text -> ErrIO ()
writeFileT :: forall ar. Path ar File -> Text -> ErrIO ()
writeFileT Path ar File
fp Text
st = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp) Text
st

-- attention - does not create file if not existing

instance (Show (Path ar File)) => FileOps2 (Path ar File) String where
  readFile2 :: Path ar File -> ErrIO FilePath
readFile2 Path ar File
fp = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp)

  -- a strict read (does cloes?)
  writeFile2 :: Path ar File -> FilePath -> ErrIO ()
writeFile2 Path ar File
fp FilePath
st = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp) FilePath
st
  appendFile2 :: Path ar File -> FilePath -> ErrIO ()
appendFile2 Path ar File
fp FilePath
st = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
appendFile (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp) FilePath
st

instance (Show (Path ar File)) => FileOps2 (Path ar File) Text where
  readFile2 :: Path ar File -> ErrIO Text
readFile2 Path ar File
fp = forall fp fc. FileOps2 fp fc => fp -> ErrIO fc
readFile2 (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp)

  writeFile2 :: Path ar File -> Text -> ErrIO ()
writeFile2 Path ar File
fp Text
st = forall fp fc. FileOps2 fp fc => fp -> fc -> ErrIO ()
writeFile2 (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp) Text
st
  appendFile2 :: Path ar File -> Text -> ErrIO ()
appendFile2 Path ar File
fp Text
st = forall fp fc. FileOps2 fp fc => fp -> fc -> ErrIO ()
appendFile2 (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp) Text
st

  writeFileOrCreate2 :: Path ar File -> Text -> ErrIO ()
writeFileOrCreate2 Path ar File
filepath Text
st = do
    let dir :: FilePath
dir = forall fp. Filenames1 fp => fp -> FilePath
getParentDir Path ar File
filepath

    forall fp. DirOps fp => fp -> ErrIO ()
createDirIfMissing' FilePath
dir
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
False forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"writeFileOrCreate2 dir created", forall {a}. Show a => a -> Text
showT FilePath
dir]
    Bool
t <- forall fp. DirOps fp => fp -> ErrIO Bool
doesDirExist' FilePath
dir
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
False forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"writeFileOrCreate2 dir test", forall {a}. Show a => a -> Text
showT Bool
t]
    forall fp fc. FileOps2 fp fc => fp -> fc -> ErrIO ()
writeFile2 Path ar File
filepath Text
st
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
False forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"writeFileOrCreate2 file written", forall {a}. Show a => a -> Text
showT Path ar File
filepath]

instance FileOps2 FilePath Text where
  readFile2 :: FilePath -> ErrIO Text
readFile2 FilePath
fp = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
T.readFile FilePath
fp
  writeFile2 :: FilePath -> Text -> ErrIO ()
writeFile2 FilePath
fp Text
st = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile FilePath
fp Text
st
  appendFile2 :: FilePath -> Text -> ErrIO ()
appendFile2 FilePath
fp Text
st = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.appendFile FilePath
fp Text
st

instance FileOps2 FilePath L.ByteString where
  readFile2 :: FilePath -> ErrIO ByteString
readFile2 FilePath
fp = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
L.readFile FilePath
fp
  writeFile2 :: FilePath -> ByteString -> ErrIO ()
writeFile2 FilePath
fp ByteString
st = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
L.writeFile FilePath
fp ByteString
st
  appendFile2 :: FilePath -> ByteString -> ErrIO ()
appendFile2 FilePath
fp ByteString
st = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
L.appendFile FilePath
fp ByteString
st

instance (Show (Path ar File)) => FileOps2 (Path ar File) L.ByteString where
  readFile2 :: Path ar File -> ErrIO ByteString
readFile2 Path ar File
fp = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
L.readFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b} {t}. Path b t -> FilePath
unL forall a b. (a -> b) -> a -> b
$ Path ar File
fp
  writeFile2 :: Path ar File -> ByteString -> ErrIO ()
writeFile2 Path ar File
fp ByteString
st = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
L.writeFile (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp) ByteString
st
  appendFile2 :: Path ar File -> ByteString -> ErrIO ()
appendFile2 Path ar File
fp ByteString
st = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
L.appendFile (forall {b} {t}. Path b t -> FilePath
unL Path ar File
fp) ByteString
st

instance FileOps2a FilePath FilePath where
  getDirContentFiles :: FilePath -> ErrIO [FilePath]
getDirContentFiles FilePath
dir =
    forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM forall fp. FileOps fp => fp -> ErrIO Bool
doesFileExist'
      forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall fp. FileOps fp => fp -> ErrIO [fp]
getDirCont FilePath
dir

  getDirContentNonHiddenFiles :: FilePath -> ErrIO [FilePath]
getDirContentNonHiddenFiles FilePath
dir =
    forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM forall fp. FileOps fp => fp -> ErrIO Bool
doesFileExist'
      forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall fp. FileOps fp => fp -> ErrIO [fp]
getDirContNonHidden FilePath
dir

instance FileOps2a (Path Abs Dir) (Path Abs File) where
  getDirContentFiles :: Path Abs Dir -> ErrIO [Path Abs File]
getDirContentFiles Path Abs Dir
dir = do
    [FilePath]
res <- forall fd ff. FileOps2a fd ff => fd -> ErrIO [ff]
getDirContentFiles (forall {b} {t}. Path b t -> FilePath
toFilePath Path Abs Dir
dir)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path Abs File
makeAbsFile [FilePath]
res)
  getDirContentNonHiddenFiles :: Path Abs Dir -> ErrIO [Path Abs File]
getDirContentNonHiddenFiles Path Abs Dir
dir = do
    [FilePath]
res <- forall fd ff. FileOps2a fd ff => fd -> ErrIO [ff]
getDirContentNonHiddenFiles (forall {b} {t}. Path b t -> FilePath
toFilePath Path Abs Dir
dir)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path Abs File
makeAbsFile [FilePath]
res)

instance FileOps2a (Path Rel Dir) (Path Rel File) where
  getDirContentFiles :: Path Rel Dir -> ErrIO [Path Rel File]
getDirContentFiles Path Rel Dir
dir = do
    [FilePath]
res <- forall fd ff. FileOps2a fd ff => fd -> ErrIO [ff]
getDirContentFiles (forall {b} {t}. Path b t -> FilePath
toFilePath Path Rel Dir
dir)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path Rel File
makeRelFile [FilePath]
res)
  getDirContentNonHiddenFiles :: Path Rel Dir -> ErrIO [Path Rel File]
getDirContentNonHiddenFiles Path Rel Dir
dir = do
    [FilePath]
res <- forall fd ff. FileOps2a fd ff => fd -> ErrIO [ff]
getDirContentNonHiddenFiles (forall {b} {t}. Path b t -> FilePath
toFilePath Path Rel Dir
dir)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path Rel File
makeRelFile [FilePath]
res)