各种monad

monad_transformer.hs

{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving #-}
import System.FilePath (FilePath, (</>))
import System.Directory (getDirectoryContents, doesFileExist)
import Control.Monad
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Writer

type St = Int
data Conf = Conf {
    rootPath :: FilePath
}
type Log = [String]

newtype M a = M (ReaderT Conf (WriterT Log (StateT St IO)) a)
    deriving (Functor, Monad, MonadIO, MonadReader Conf, MonadWriter Log, MonadState St)

runM :: Conf -> St -> M a -> IO (a, Log, St)
runM conf st (M m) = do
    ((a, log), newst) <- runStateT (runWriterT (runReaderT m conf)) st
    return (a, log, newst)

getFileList :: M [String]
getFileList = do
    tell ["get list begin"]
    root <- asks rootPath
    files <- liftIO $ getDirectoryContents root
    tell ["list count "++(show . length) files]
    files <- liftIO $ filterM doesFileExist files
    tell ["file count "++(show . length) files]
    return files

getFile :: FilePath -> M String
getFile filename = do
    root <- asks rootPath
    tell ["read file "++filename]
    content <- (liftIO . readFile) (root </> filename)
    modify (+(length content))
    return content

getAllFile :: M String
getAllFile = fmap concat (getFileList >>= mapM getFile)

main :: IO ()
main = do
    (a, log, st) <- runM (Conf "/home/huangyi/") 0 getAllFile
    putStrLn ("log:"++(unlines log))
    putStrLn ("counter:"++(show st))
    putStrLn ("result:"++(show a))