----------------------------------------------------------------------
--
-- 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,
    pipedDoIOwithFilter
  )
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) ErrIO ()
getRecursiveContents :: Path Abs Dir -> Proxy X () () (Path Abs File) ErrIO ()
getRecursiveContents Path Abs Dir
fp = do
  --    putIOwords ["recurseDir start", showT fp]
  Permissions
perm <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift forall a b. (a -> b) -> a -> b
$ forall fp. FileSystemOps fp => fp -> ErrIO 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 forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"recurseDir not readable or not searchable", forall {a}. Show a => a -> Text
showT Path Abs Dir
fp]
    else do
      Bool
symLink <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift forall a b. (a -> b) -> a -> b
$ forall fp. FileSystemOps fp => fp -> ErrIO Bool
checkSymbolicLink Path Abs Dir
fp -- callIO $ xisSymbolicLink fp
      if Bool
symLink
        then forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"recurseDir symlink", forall {a}. Show a => a -> Text
showT Path Abs Dir
fp]
        else do
          ([Path Abs Dir]
dirs, [Path Abs File]
files) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
(MonadIO m, MonadThrow m) =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir' Path Abs Dir
fp
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
False forall a b. (a -> b) -> a -> b
$ do
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"recurseDir files\n", forall {a}. Show a => a -> Text
showT [Path Abs File]
files]
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Pipe.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"recurseDir directories\n", forall {a}. Show a => a -> Text
showT [Path Abs Dir]
dirs]

          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Prelude.mapM_ forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
Pipe.yield (forall a. Ord a => [a] -> [a]
sort [Path Abs File]
files)
          --                                (Path.IO.sort (map unPath files))
          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) ErrIO ()
getRecursiveContents (forall a. Ord a => [a] -> [a]
sort [Path Abs Dir]
dirs)
          --                            (Path.IO.sort (map unPath dirs))
          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) -> ErrIO ()
pipedDoIO Path Abs File
file Path Abs Dir
path Path Abs File -> Text
transf = do
        -- pipedDoIOwithFilter file path ?? transf
  Handle
hand <- forall fp. FileOps fp => fp -> IOMode -> ErrIO Handle
openFile2handle Path Abs File
file IOMode
WriteMode
  forall (m :: * -> *) r. Monad m => Effect m r -> m r
Pipe.runEffect forall a b. (a -> b) -> a -> b
$
    Path Abs Dir -> Proxy X () () (Path Abs File) ErrIO ()
getRecursiveContents Path Abs Dir
path
      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
>-> forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
PipePrelude.map (Text -> String
t2s forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> Text
transf) -- some IO type left?
      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
>-> forall (m :: * -> *) r. MonadIO m => Handle -> Consumer' String m r
PipePrelude.toHandle Handle
hand
  Handle -> ErrIO ()
closeFile2 Handle
hand
  forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- a convenient function to go through a directory and
-- recursively apply a function to each file or directory
-- filters for extension (e.g. md)
-- file for error messages 
pipedDoIOwithFilter :: Path Abs File -> Path Abs Dir -> Extension -> (Path Abs File -> ErrIO String) -> ErrIO ()
pipedDoIOwithFilter :: Path Abs File
-> Path Abs Dir
-> Extension
-> (Path Abs File -> ErrIO String)
-> ErrIO ()
pipedDoIOwithFilter Path Abs File
file Path Abs Dir
path Extension
ext Path Abs File -> ErrIO String
opex = do
  Handle
hand <- forall fp. FileOps fp => fp -> IOMode -> ErrIO Handle
openFile2handle Path Abs File
file IOMode
WriteMode
  forall (m :: * -> *) r. Monad m => Effect m r -> m r
Pipe.runEffect forall a b. (a -> b) -> a -> b
$
    Path Abs Dir -> Proxy X () () (Path Abs File) ErrIO ()
getRecursiveContents Path Abs Dir
path
      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
>-> forall (m :: * -> *) a r. Functor m => (a -> Bool) -> Pipe a a m r
PipePrelude.filter (forall fp. Extensions fp => ExtensionType fp -> fp -> Bool
hasExtension Extension
ext)
      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
>-> forall (m :: * -> *) a b r. Monad m => (a -> m b) -> Pipe a b m r
PipePrelude.mapM Path Abs File -> ErrIO String
opex
      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
>-> forall (m :: * -> *) r. MonadIO m => Handle -> Consumer' String m r
PipePrelude.toHandle Handle
hand
  Handle -> ErrIO ()
closeFile2 Handle
hand
  forall (m :: * -> *) a. Monad m => a -> m a
return ()