Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Dir Tree Prog
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment