[Haskell-cafe] Re: Cont, ContT and IO() - Code on hpaste

[Matthias Görgens]

P.P.S. Strange it does not seem to work with the paste.  So here comes
the solution by mail:

module Consolidator.BusinessLogic.ConflictsResolved
(consolidateDuplicates) where

import System.FilePath
import System.Directory

import Control.Monad (filterM)
import Control.Exception (throwIO)

import System.Environment

import Data.Maybe
import Control.Monad
import Control.Monad.Trans

newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }

instance (Monad m) => Monad (MaybeT m) where
    (>>=) tmb_v  f =
        MaybeT (runMaybeT tmb_v
                >>= \b_v -> case b_v of
                              Nothing -> return Nothing
                              Just v -> runMaybeT $ f v
               )
    return = MaybeT . return . return

instance MonadTrans MaybeT where
    lift mon = MaybeT (mon >>= return . Just)


abort :: String -> MaybeT IO a
abort reason = do lift . putStrLn $ reason
                  MaybeT (return Nothing)

{-
The traversal is one directory deep only.
I try to find out if every immediate subdirectory contains exactly one
"*.gdr" file,
and collect the path names in a list, sgls.

Afterwards I append the contents of each such file to another file.

I want to abort the whole process as soon as I encounter a directory
that does not
include exactly one *.gdr file.

Currently I'm throwing exceptions but I'd prefer to rewrite this code
to use continuations.

-}



consolidateDuplicates :: FilePath -> MaybeT IO ()
consolidateDuplicates fp
    = do dirs <- lift (getDirectoryContents fp)
         recs <- lift (filterM doesDirectoryExist $ map (fp </>) $
filter (not . flip elem [".", ".."]) dirs)
         sgls <- mapM checkForSingle recs
         let cpy = fp </> "Korrigiert.gdr"
         lift (copyFile (fp </> "Konsolidiert.gdr") cpy)
         lift (mapM_ (\sgl -> do
                        str <- readFile sgl
                        appendFile cpy str) sgls)


checkForSingle :: FilePath -> MaybeT IO FilePath
checkForSingle fp = do
  cnt <- lift (getDirectoryContents fp)
  let fltr = filter ((== ".gdr") . takeExtension)
  case fltr cnt of
    []  -> abort ("The directory " ++ fp ++ " is empty")
    [f] -> return (fp </> f)
    _   -> abort ("There is more than one file in the directory " ++ fp)