[Haskell-beginners] How to unnest "do"

David McBride toad3k at gmail.com
Sun Jan 27 21:06:47 CET 2013


Here's what I would do.  There's a MaybeT monad in the transormers library
that is pretty good for this sort of stuff.  I might restructure it like
this:

module Main where

import Control.Monad.Trans.Maybe (runMaybeT, MaybeT)
import Control.Monad.Trans (liftIO)
import System.Environment (getArgs)
import Control.Applicative ((<|>))

margs :: MaybeT IO ()
margs = do
  [fname] <- liftIO $ getArgs
  fstr <- liftIO $ readFile fname
  let nWords = length . words $ fstr
      nLines = length . lines $ fstr
      nChars = length fstr
  liftIO . putStrLn . unwords $ [ show nLines, show nWords, show nChars]

mnoargs :: MaybeT IO ()
mnoargs = liftIO $ print "No args"

main = runMaybeT (margs <|> mnoargs)

This exploits the alternative instance of MaybeT.  If the pattern match for
arguments fails, then the whole function returns nothing.  That causes the
alternative to be run instead.  Also since MaybeT has an instance for
MonadIO, you can do any IO you need by using liftIO.

There is also an EitherT type in the errors package that can return *why*
something failed, but I haven't messed with it a ton, so I can't really
give a tutorial.

On Sun, Jan 27, 2013 at 12:27 PM, Martin Drautzburg <
Martin.Drautzburg at web.de> wrote:

> Hello all,
>
> in the code snippet below, is there a way to factor out the second "do"?
>
> import System (getArgs)
> main :: IO ()
> main = do
>         args <- getArgs
>         case args of
>                 [fname] ->  do fstr <- readFile fname
>                                let nWords = length . words $ fstr
>                                    nLines = length . lines $ fstr
>                                    nChars = length fstr
>                                putStrLn . unwords $ [ show nLines
>                                              , show nWords
>                                              , show nChars
>                                              , fname]
>                 _ ->putStrLn "usage: wc fname"
>
>
>
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20130127/8f9386f9/attachment.htm>


More information about the Beginners mailing list