Search code examples
haskellhappstack

Reducing redundancy in happstack tutorial code


The happstack tutorial provides the following sample:

main :: IO ()
main = simpleHTTP nullConf $ msum 
       [ do methodM GET
            ok $ "You did a GET request.\n"
       , do methodM POST
            ok $ "You did a POST request.\n"
       , dir "foo" $ do methodM GET
                        ok $ "You did a GET request on /foo.\n"
       ]

It seems that ok $ is redundant here -- is there any way of pulling that out of msum so that you don't have to write ok $ three times? I tried the following, but it doesn't even compile:

main :: IO ()
main = simpleHTTP nullConf $ ok $ msum 
       [ do methodM GET
            "You did a GET request.\n"
       , do methodM POST
            "You did a POST request.\n"
       , dir "foo" $ do methodM GET
                        "You did a GET request on /foo.\n"
       ]

Is there a correct way to do this (or even better, pulling out the entirety of ok $ "You did a " and ".\n"), or is it just not possible?

I'm still getting up to speed on how monads work in Haskell, but if the above is not possible, then can you explain from a high level why there's no reasonable way to make this work, or what would need to be changed in order to allow it to be possible? I'm just trying to wrap my head around what can and cannot be done here.


Solution

  • Not sure about the type of dir, but something like this should work:

    main :: IO ()
    main = simpleHTTP nullConf $ msum 
           [ do methodM GET
                return "GET request"
           , do methodM POST
                return "POST request"
           , dir "foo" $ do methodM GET
                            return "GET request on /foo"
           ] >>= ok . (\s -> "You did a " ++ s ++ ".\n")
    

    With such short blocks, I'd be tempted to un-do them:

    main :: IO ()
    main = simpleHTTP nullConf $ msum 
           [ methodM GET  >> return "GET request"
           , methodM POST >> return "POST request"
           , dir "foo" $ methodM GET >> return "GET request on /foo"
           ] >>= ok . (\s -> "You did a " ++ s ++ ".\n")