Dir Tree Prog

TrentTree.hs

module TrentTree where

import           Control.Monad.Trans.Class  -- from the `transformers` package
import           Control.Monad.Trans.Except -- from the `errors` package
import           Data.Monoid                ((<>))
import           Data.Tree
import           System.Directory           (doesDirectoryExist,
                                             getDirectoryContents)
import           System.FilePath            (combine, takeFileName)

-- | Error data type
data FileSystemError = DirectoryMissing String deriving (Show)

-- | Alias for our long-winded exception monad transformer type
type FilesM a = ExceptT FileSystemError IO a

-- | A period string
dot :: String
dot = "."

-- | Semigroup appended periods ((<>) == mappend == (++) for [Char] == String)
dotDot :: String
dotDot = dot <> dot

-- | Applicative filter with predicated if not dot and if not dotDot
children :: [FilePath] -> [FilePath]
children = filter ((&&) <$> (/=) dot <*> (/=) dotDot)

-- | Safely capture exception thrown by dir missing
--   discard excp with handleError and return the busted filepath
safeDirContents :: FilePath -> FilesM [FilePath]
safeDirContents p = handleError $ lift $ getDirectoryContents p
  where handleError = withExceptT (\_ -> DirectoryMissing p)

-- | Run our safe dir contents function and apply children over the result
listDirectory :: FilePath -> FilesM [FilePath]
listDirectory p = children <$> safeDirContents p

-- | This fn can be pure - no need to wrap in monadic context here
stepFile :: FilePath -> (String, [FilePath])
stepFile p = (takeFileName p, [])

-- | Less lambdas is generally considered good style - here using the alias of </>
prependPath :: FilePath
            -> [FilePath]
            -> [FilePath]
prependPath p = fmap (combine p)

-- | Do notation is perhaps cleaner here
stepDirectory :: FilePath -> FilesM (String, [FilePath])
stepDirectory p = do
 nodes <- listDirectory p
 return (takeFileName p, prependPath p nodes)

-- | Lift the IO monad action into our FilesM monad
--   Could also do a case match on the Bool datatype
--   but it makes no difference and this is clearer like you had it
stepNode :: FilePath -> FilesM (String, [FilePath])
stepNode p = do
  isDir <- lift $ doesDirectoryExist p
  if isDir
     then (stepDirectory p)
     else (return $ stepFile p)

-- | Run the ExceptT action and match the result - printing the error if encountered
main :: IO ()
main = do
  treeResult <- runExceptT $ unfoldTreeM stepNode "."
  case treeResult of
    Right t  -> putStr $ drawTree t
    Left err -> putStrLn $ "File system error: " <> show err