auto-lift-example.hs

-----------------------------------
import System.IO
import Control.Monad.Reader
import Control.Monad.IO.Class
import Control.Exception.Base (evaluate)

data ColumnHeaders = FirstLine | None

withCSV :: FilePath -> (Handle -> IO r) -> IO r
withCSV path action = do
    putStrLn "opening file"
    h <- openFile path ReadWriteMode
    r <- action h
    hClose h
    putStrLn "file closed"
    return r

withCSVLifted :: MonadIO mIO => FilePath -> (Handle -> mIO r) -> mIO r
withCSVLifted path action = do
    liftIO $putStrLn "opening file"
    h <- liftIO $ openFile path ReadMode
    r <- action h
    liftIO $ hClose h
    liftIO $ putStrLn "file closed"
    return r

getFileContentsLifted :: ReaderT ColumnHeaders IO String
getFileContentsLifted = withCSVLifted "data.csv" myReadFile 
    where
        myReadFile :: Handle -> ReaderT ColumnHeaders IO String
        myReadFile handle = do
            header <- ask
            case header of
                None      -> return ""
                FirstLine -> liftIO $ hGetLine handle -- skip first line then
            text <- liftIO $ hGetContents handle
            liftIO $ evaluate (length text) -- force lazy IO
            return text

getFileContents :: ReaderT ColumnHeaders IO String
getFileContents = liftIO $ withCSV "data.csv" myReadFile
    where
        myReadFile :: Handle -> IO String
        myReadFile handle = do
            let header = None -- header <- ask --- OOOPPSss!!! Can't ask.
            case header of
                None      -> return ""
                FirstLine -> hGetLine handle -- skip first line
            text <- hGetContents handle
            evaluate (length text) -- force lazy IO
            return text

main = do
    cs <- runReaderT getFileContentsLifted FirstLine
    print cs

-----------------------------------