{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Uniform.Piped
( getRecursiveContents,
pipedDoIO,
)
where
import Data.List (sort)
import qualified Path.IO (readable, searchable)
import Pipes ((>->))
import qualified Pipes as Pipe
import qualified Pipes.Prelude as PipePrelude
import Uniform.Error
import Uniform.Strings
import Uniform.FileStrings
getRecursiveContents ::
Path Abs Dir ->
Pipe.Proxy Pipe.X () () (Path Abs File) (ErrorT Text IO) ()
getRecursiveContents :: Path Abs Dir -> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
getRecursiveContents Path Abs Dir
fp = do
Permissions
perm <- ErrorT Text IO Permissions
-> Proxy X () () (Path Abs File) (ErrorT Text IO) Permissions
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift (ErrorT Text IO Permissions
-> Proxy X () () (Path Abs File) (ErrorT Text IO) Permissions)
-> ErrorT Text IO Permissions
-> Proxy X () () (Path Abs File) (ErrorT Text IO) Permissions
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> ErrorT Text IO Permissions
forall fp. FileSystemOps fp => fp -> ErrorT Text IO Permissions
getPermissions' Path Abs Dir
fp
if Bool -> Bool
not (Permissions -> Bool
Path.IO.readable Permissions
perm Bool -> Bool -> Bool
&& Permissions -> Bool
Path.IO.searchable Permissions
perm)
then ErrorT Text IO ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift (ErrorT Text IO ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ())
-> ErrorT Text IO ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall a b. (a -> b) -> a -> b
$ [Text] -> ErrorT Text IO ()
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"recurseDir not readable or not searchable", Path Abs Dir -> Text
forall a. Show a => a -> Text
showT Path Abs Dir
fp]
else do
Bool
symLink <- ErrorT Text IO Bool
-> Proxy X () () (Path Abs File) (ErrorT Text IO) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift (ErrorT Text IO Bool
-> Proxy X () () (Path Abs File) (ErrorT Text IO) Bool)
-> ErrorT Text IO Bool
-> Proxy X () () (Path Abs File) (ErrorT Text IO) Bool
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> ErrorT Text IO Bool
forall fp. FileSystemOps fp => fp -> ErrorT Text IO Bool
checkSymbolicLink Path Abs Dir
fp
if Bool
symLink
then ErrorT Text IO ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift (ErrorT Text IO ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ())
-> ErrorT Text IO ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall a b. (a -> b) -> a -> b
$ [Text] -> ErrorT Text IO ()
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"recurseDir symlink", Path Abs Dir -> Text
forall a. Show a => a -> Text
showT Path Abs Dir
fp]
else do
([Path Abs Dir]
dirs, [Path Abs File]
files) <- ErrorT Text IO ([Path Abs Dir], [Path Abs File])
-> Proxy
X
()
()
(Path Abs File)
(ErrorT Text IO)
([Path Abs Dir], [Path Abs File])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift (ErrorT Text IO ([Path Abs Dir], [Path Abs File])
-> Proxy
X
()
()
(Path Abs File)
(ErrorT Text IO)
([Path Abs Dir], [Path Abs File]))
-> ErrorT Text IO ([Path Abs Dir], [Path Abs File])
-> Proxy
X
()
()
(Path Abs File)
(ErrorT Text IO)
([Path Abs Dir], [Path Abs File])
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> ErrorT Text IO ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
(MonadIO m, MonadThrow m) =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir' Path Abs Dir
fp
Bool
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
False (Proxy X () () (Path Abs File) (ErrorT Text IO) ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ())
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall a b. (a -> b) -> a -> b
$ do
ErrorT Text IO ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift (ErrorT Text IO ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ())
-> ErrorT Text IO ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall a b. (a -> b) -> a -> b
$ [Text] -> ErrorT Text IO ()
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"recurseDir files\n", [Path Abs File] -> Text
forall a. Show a => a -> Text
showT [Path Abs File]
files]
ErrorT Text IO ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift (ErrorT Text IO ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ())
-> ErrorT Text IO ()
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall a b. (a -> b) -> a -> b
$ [Text] -> ErrorT Text IO ()
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"recurseDir directories\n", [Path Abs Dir] -> Text
forall a. Show a => a -> Text
showT [Path Abs Dir]
dirs]
(Path Abs File
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ())
-> [Path Abs File]
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Prelude.mapM_ Path Abs File -> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
Pipe.yield ([Path Abs File] -> [Path Abs File]
forall a. Ord a => [a] -> [a]
sort [Path Abs File]
files)
(Path Abs Dir -> Proxy X () () (Path Abs File) (ErrorT Text IO) ())
-> [Path Abs Dir]
-> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Prelude.mapM_ Path Abs Dir -> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
getRecursiveContents ([Path Abs Dir] -> [Path Abs Dir]
forall a. Ord a => [a] -> [a]
sort [Path Abs Dir]
dirs)
() -> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pipedDoIO :: Path Abs File -> Path Abs Dir -> (Path Abs File -> Text) -> ErrIO ()
pipedDoIO :: Path Abs File
-> Path Abs Dir -> (Path Abs File -> Text) -> ErrorT Text IO ()
pipedDoIO Path Abs File
file Path Abs Dir
path Path Abs File -> Text
transf = do
Handle
hand <- Path Abs File -> IOMode -> ErrIO Handle
forall fp. FileOps fp => fp -> IOMode -> ErrIO Handle
openFile2handle Path Abs File
file IOMode
WriteMode
Effect (ErrorT Text IO) () -> ErrorT Text IO ()
forall (m :: * -> *) r. Monad m => Effect m r -> m r
Pipe.runEffect (Effect (ErrorT Text IO) () -> ErrorT Text IO ())
-> Effect (ErrorT Text IO) () -> ErrorT Text IO ()
forall a b. (a -> b) -> a -> b
$
Path Abs Dir -> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
getRecursiveContents Path Abs Dir
path
Proxy X () () (Path Abs File) (ErrorT Text IO) ()
-> Proxy () (Path Abs File) () String (ErrorT Text IO) ()
-> Proxy X () () String (ErrorT Text IO) ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (Path Abs File -> String)
-> Proxy () (Path Abs File) () String (ErrorT Text IO) ()
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
PipePrelude.map (Text -> String
t2s (Text -> String)
-> (Path Abs File -> Text) -> Path Abs File -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> Text
transf)
Proxy X () () String (ErrorT Text IO) ()
-> Proxy () String () X (ErrorT Text IO) ()
-> Effect (ErrorT Text IO) ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Handle -> Consumer' String (ErrorT Text IO) ()
forall (m :: * -> *) r. MonadIO m => Handle -> Consumer' String m r
PipePrelude.toHandle Handle
hand
Handle -> ErrorT Text IO ()
closeFile2 Handle
hand
() -> ErrorT Text IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()