{-|

Module      : CountEntries
Description : Count entries in a file path
Copyright   : © Frank Jung, 2020
License     : GPL-3

Function variations of counting directory entries from
<http://book.realworldhaskell.org/read/monad-transformers.html Chapter 18, Monad Transformers, Real World Haskell by Bryan O'Sullivan, Don Stewart, and John Goerzen>.
The original version in the book is `countEntriesTrad` which here is called
`countEntries0`.

The Monad Transformer version which in the book is `countEntries` is
`countEntries2` in this code.

The other versions `countEntries1` and `countEntries3` are my variations of
this code.

== GHCi Session

To test these functions in GHCi you need the following packages:

@
:m + Control.Monad
:m + System.Directory
:m + System.FilePath
@

=== Resources

This is a really good introduction to Monad Transformers,
<https://mmhaskell.com/monads/transformers Monday Morning Haskell: Monad Transformers>.

-}

module CountEntries ( countEntries0
                    , countEntries1
                    , countEntries2
                    , countEntries3
                    ) where

import           Control.Monad              (filterM, forM, forM_, when)
import           Control.Monad.Trans        (liftIO)
import           Control.Monad.Trans.Writer (WriterT, execWriterT, tell)
import           System.Directory           (doesDirectoryExist, listDirectory)
import           System.FilePath            ((</>))

-- | Count entries in directories for given path.
--
-- This is the standard version from "Real World Haskell".
--
-- >>> p = "public"
--
-- >>> :t listDirectory p
-- listDirectory p :: IO [FilePath]
--
-- >>> countEntries0 p
-- [("public",25),("public/src",16)]
--
countEntries0 :: FilePath -> IO [(FilePath, Int)]
countEntries0 :: FilePath -> IO [(FilePath, Int)]
countEntries0 FilePath
path = do
  [FilePath]
contents <- FilePath -> IO [FilePath]
listDirectory FilePath
path                      -- contents of p
  [[(FilePath, Int)]]
rest <- [FilePath]
-> (FilePath -> IO [(FilePath, Int)]) -> IO [[(FilePath, Int)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
contents ((FilePath -> IO [(FilePath, Int)]) -> IO [[(FilePath, Int)]])
-> (FilePath -> IO [(FilePath, Int)]) -> IO [[(FilePath, Int)]]
forall a b. (a -> b) -> a -> b
$ \FilePath
name -> do                 -- for each entry
            let newName :: FilePath
newName = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
name               -- full path name
            Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
newName       -- is directory
            if Bool
isDir
              then FilePath -> IO [(FilePath, Int)]
countEntries0 FilePath
newName              -- recurse
              else [(FilePath, Int)] -> IO [(FilePath, Int)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []                          -- termination
  [(FilePath, Int)] -> IO [(FilePath, Int)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FilePath, Int)] -> IO [(FilePath, Int)])
-> [(FilePath, Int)] -> IO [(FilePath, Int)]
forall a b. (a -> b) -> a -> b
$ (FilePath
path, [FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
contents) (FilePath, Int) -> [(FilePath, Int)] -> [(FilePath, Int)]
forall a. a -> [a] -> [a]
: [[(FilePath, Int)]] -> [(FilePath, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(FilePath, Int)]]
rest      -- list and concat tuples

-- | Count entries for a list of paths. (My version.)
--
-- == Example
--
-- What the function returns is a list of tuples of directory and count of
-- entries in that directory:
--
-- >>> countEntries1 "public"
-- [("public",25),("public/src",16)]
--
-- === Explanation
--
-- The function composes a number of different system calls. But the
-- process is simple but clunky using traditional methods. The process will
-- be much simplified once when Monad Transformers are used in
-- `countEntries2`.
--
-- >>> p = "public"
--
-- Get contents of path ... and filter to report directories only:
--
-- >>> (getDirectoryContents p) >>= filterM (\n -> doesDirectoryExist (p </> n))
-- ["..","src","."]
--
-- List directory ignores current and parent directories:
--
-- >>> listDirectory p >>= filterM (\n -> doesDirectoryExist (p </> n))
-- ["src"]
--
-- Some ways to count number of entries in the path:
--
-- >>> ps <- listDirectory p
--
-- >>> length ps
-- 25
--
-- Same as:
--
-- >>> listDirectory p >>= return . length
-- 25
--
-- Which is equivalent to:
--
-- >>> liftM length (listDirectory p)
-- 25
--
-- Recurse into subdirectories:
--
-- >>> listDirectory p >>= filterM (\n -> doesDirectoryExist (p </> n)) >>= mapM_ print
-- "src"
--
countEntries1 :: FilePath -> IO [(FilePath, Int)]
countEntries1 :: FilePath -> IO [(FilePath, Int)]
countEntries1 FilePath
p =
  if Bool -> Bool
not (FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
p)
    then
      FilePath -> IO [FilePath]
listDirectory FilePath
p                                         -- contents of path
      IO [FilePath]
-> ([FilePath] -> IO [(FilePath, Int)]) -> IO [(FilePath, Int)]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[FilePath]
ps -> (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\FilePath
n -> FilePath -> IO Bool
doesDirectoryExist (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
n)) [FilePath]
ps -- sub-directories
      IO [FilePath]
-> ([FilePath] -> IO [[(FilePath, Int)]]) -> IO [[(FilePath, Int)]]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO [(FilePath, Int)])
-> [FilePath] -> IO [[(FilePath, Int)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\FilePath
n -> FilePath -> IO [(FilePath, Int)]
countEntries1 (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
n))                -- recurse
      IO [[(FilePath, Int)]]
-> ([[(FilePath, Int)]] -> IO [(FilePath, Int)])
-> IO [(FilePath, Int)]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[(FilePath, Int)]
ces -> [(FilePath, Int)] -> IO [(FilePath, Int)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FilePath, Int)] -> IO [(FilePath, Int)])
-> [(FilePath, Int)] -> IO [(FilePath, Int)]
forall a b. (a -> b) -> a -> b
$ (FilePath
p, [FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ps) (FilePath, Int) -> [(FilePath, Int)] -> [(FilePath, Int)]
forall a. a -> [a] -> [a]
: [(FilePath, Int)]
ces) ([(FilePath, Int)] -> IO [(FilePath, Int)])
-> ([[(FilePath, Int)]] -> [(FilePath, Int)])
-> [[(FilePath, Int)]]
-> IO [(FilePath, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(FilePath, Int)]] -> [(FilePath, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat    -- concat then list tuples
    else [(FilePath, Int)] -> IO [(FilePath, Int)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []                                            -- termination

-- | My updated version to count entries in directories for given path.
--
-- This updated version of `countEntries1` uses `Control.Monad.Writer.WriterT`.
countEntries2 :: FilePath -> IO [(FilePath, Int)]
countEntries2 :: FilePath -> IO [(FilePath, Int)]
countEntries2 = WriterT [(FilePath, Int)] IO () -> IO [(FilePath, Int)]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT [(FilePath, Int)] IO () -> IO [(FilePath, Int)])
-> (FilePath -> WriterT [(FilePath, Int)] IO ())
-> FilePath
-> IO [(FilePath, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> WriterT [(FilePath, Int)] IO ()
countEntries2'
  where
    countEntries2' :: FilePath -> WriterT [(FilePath, Int)] IO ()
    countEntries2' :: FilePath -> WriterT [(FilePath, Int)] IO ()
countEntries2' FilePath
path = do
      [FilePath]
contents <- IO [FilePath] -> WriterT [(FilePath, Int)] IO [FilePath]
forall a. IO a -> WriterT [(FilePath, Int)] IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> WriterT [(FilePath, Int)] IO [FilePath])
-> (FilePath -> IO [FilePath])
-> FilePath
-> WriterT [(FilePath, Int)] IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [FilePath]
listDirectory (FilePath -> WriterT [(FilePath, Int)] IO [FilePath])
-> FilePath -> WriterT [(FilePath, Int)] IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
path               -- contents of path
      [(FilePath, Int)] -> WriterT [(FilePath, Int)] IO ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [(FilePath
path, [FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
contents)]                          -- show tuple
      [FilePath]
-> (FilePath -> WriterT [(FilePath, Int)] IO ())
-> WriterT [(FilePath, Int)] IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
contents ((FilePath -> WriterT [(FilePath, Int)] IO ())
 -> WriterT [(FilePath, Int)] IO ())
-> (FilePath -> WriterT [(FilePath, Int)] IO ())
-> WriterT [(FilePath, Int)] IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
name -> do                            -- for each entry
        let newName :: FilePath
newName = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
name
        Bool
isDir <- IO Bool -> WriterT [(FilePath, Int)] IO Bool
forall a. IO a -> WriterT [(FilePath, Int)] IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> WriterT [(FilePath, Int)] IO Bool)
-> (FilePath -> IO Bool)
-> FilePath
-> WriterT [(FilePath, Int)] IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
doesDirectoryExist (FilePath -> WriterT [(FilePath, Int)] IO Bool)
-> FilePath -> WriterT [(FilePath, Int)] IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
newName        -- is directory
        Bool
-> WriterT [(FilePath, Int)] IO ()
-> WriterT [(FilePath, Int)] IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isDir (WriterT [(FilePath, Int)] IO ()
 -> WriterT [(FilePath, Int)] IO ())
-> WriterT [(FilePath, Int)] IO ()
-> WriterT [(FilePath, Int)] IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> WriterT [(FilePath, Int)] IO ()
countEntries2' FilePath
newName                   -- recurse in sub-directories

-- | Count entries in directories for given path.
--
-- My version using `Control.Monad.Writer.WriterT`.
--
-- This function takes a `FilePath` argument and returns an IO action that,
-- when executed, returns a list of @(FilePath, Int)@ pairs representing
-- the number of entries in each directory.
--
-- The implementation of `countEntries3` uses the `execWriterT` function
-- from the `Control.Monad.Trans.Writer` module to extract the final value
-- of the writer monad and discard the log. The writer monad is used to
-- accumulate a list of @(FilePath, Int)@ pairs representing the number of
-- entries in each directory.
--
-- The `countEntries3` function is defined in terms of a helper function
-- `go` that uses WriterT to accumulate the log of @(FilePath, Int)@ pairs.
-- The `go` function first uses `listDirectory` to get the contents of the
-- directory specified by the `FilePath` argument.
-- It then uses `tell` to add a tuple of the directory path and the number
-- of entries in the directory to the log. Next, it uses `filterM` and
-- `doesDirectoryExist` to get a list of sub-directories in the directory.
-- Finally, it uses `mapM_` to recurse into each sub-directory and
-- accumulate the log.
--
-- The `countEntries3` function is defined using function composition,
-- where `go` is composed with `execWriterT` using the @.@ operator. This
-- creates a new function that first applies `go` to its input, and then
-- applies `execWriterT` to the output of `go`.
--
countEntries3 :: FilePath -> IO [(FilePath, Int)]
countEntries3 :: FilePath -> IO [(FilePath, Int)]
countEntries3 = WriterT [(FilePath, Int)] IO () -> IO [(FilePath, Int)]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT [(FilePath, Int)] IO () -> IO [(FilePath, Int)])
-> (FilePath -> WriterT [(FilePath, Int)] IO ())
-> FilePath
-> IO [(FilePath, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> WriterT [(FilePath, Int)] IO ()
go
  where
    go :: FilePath -> WriterT [(FilePath, Int)] IO ()
    go :: FilePath -> WriterT [(FilePath, Int)] IO ()
go FilePath
p =
      IO [FilePath] -> WriterT [(FilePath, Int)] IO [FilePath]
forall a. IO a -> WriterT [(FilePath, Int)] IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
listDirectory FilePath
p)                                -- contents of path
      WriterT [(FilePath, Int)] IO [FilePath]
-> ([FilePath] -> WriterT [(FilePath, Int)] IO ())
-> WriterT [(FilePath, Int)] IO ()
forall a b.
WriterT [(FilePath, Int)] IO a
-> (a -> WriterT [(FilePath, Int)] IO b)
-> WriterT [(FilePath, Int)] IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[FilePath]
ps -> [(FilePath, Int)] -> WriterT [(FilePath, Int)] IO ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [(FilePath
p, [FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ps)]                        -- show tuple
      WriterT [(FilePath, Int)] IO ()
-> WriterT [(FilePath, Int)] IO [FilePath]
-> WriterT [(FilePath, Int)] IO [FilePath]
forall a b.
WriterT [(FilePath, Int)] IO a
-> WriterT [(FilePath, Int)] IO b -> WriterT [(FilePath, Int)] IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO [FilePath] -> WriterT [(FilePath, Int)] IO [FilePath]
forall a. IO a -> WriterT [(FilePath, Int)] IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\FilePath
n -> FilePath -> IO Bool
doesDirectoryExist (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
n)) [FilePath]
ps) -- sub-directories
      WriterT [(FilePath, Int)] IO [FilePath]
-> ([FilePath] -> WriterT [(FilePath, Int)] IO ())
-> WriterT [(FilePath, Int)] IO ()
forall a b.
WriterT [(FilePath, Int)] IO a
-> (a -> WriterT [(FilePath, Int)] IO b)
-> WriterT [(FilePath, Int)] IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[FilePath]
pss -> (FilePath -> WriterT [(FilePath, Int)] IO ())
-> [FilePath] -> WriterT [(FilePath, Int)] IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\FilePath
n -> FilePath -> WriterT [(FilePath, Int)] IO ()
go (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
n)) [FilePath]
pss              -- recurse into sub-directories