----------------------------------------------------------------------
--
-- Module      :  piped
-- Copyright   :  andrew u frank -
--
---------------------------------------------------------------------
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}

-- | the recursive access to many files not blocking
module Uniform.Piped
  ( getRecursiveContents,
    --    , pipeMap, pipeStdoutLn
    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
--   ( ErrIO,
--     ErrorT,
--     Text,
--     putIOwords,
--     showT,
--     t2s,
--     when,
--   )
import Uniform.Strings 
import Uniform.FileStrings

getRecursiveContents :: -- (Path Abs File-> Pipe.Proxy Pipe.X () () String (ErrorT Text IO) ())
  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
  --    putIOwords ["recurseDir start", showT fp]
  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 -- callIO $ xisSymbolicLink 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.IO.sort (map unPath 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)
          --                            (Path.IO.sort (map unPath dirs))
          () -> Proxy X () () (Path Abs File) (ErrorT Text IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return () --    where processOneFile fp = Pipe.yield fp

--
---- examples how to use...
--
--pipedDo :: LegalPathname -> (LegalPathname -> Text) -> ErrIO ()
--pipedDo path transf =  do
--
--  runEffect $
--    getRecursiveContents path
--    >-> P.map (t2s . transf)
--    >-> P.stdoutLn
--
--testDir = fromJustNote "testdir" $ makeLegalPath "/home/frank/Workspace8/uniform-fileio/testDirFileIO"
--test_getRec = do
--    res <- runErr $ pipedDo testDir (showT)
--    assertEqual (Right ()) res
--    -- check manually
--
--
--
--

-- | a convenient function to go through a directory and
-- recursively apply a function to each
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) -- some IO type left?
      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 ()