3
\$\begingroup\$

I'm attempting to learn more about Haskell by completing a "hobby" project - a simple API to save/retrieve content for pages - used with Hakyll to generate static sites.

I have got something working for the tasks of retrieving all of the content for a site, and for adding a new page to a site. Hooray!

However, the code suffers from extraordinary verbosity. I suspect I could improve things by bringing in some kind of monad transformer to deal with the IO (Either String ()), but I am not familiar enough with monad transformers to even be able to work out where to start.

siteServer :: Server SiteAPI
siteServer = site :<|> addPage
    where
          site :: Int -> Handler Site
          site i = do
              s <- liftIO $ loadSite i
              case s of 
                  Left err -> throwError err404 { errBody = "Site not found!" `BS.append` (BS.pack err) }
                  Right s' -> return s'

          addPage :: Int -> Page -> Handler ()
          addPage i p = do
              s <- liftIO $ savePage i p
              case s of
                Left err -> throwError err404 { errBody = "Site not found!" `BS.append` (BS.pack err) }
                Right _ -> return ()

          savePage :: Int -> Page -> IO (Either String ())
          savePage i p = do
              s <- loadSite i
              case s of
                Left err -> return $ Left err
                Right s' -> savePage' s' p

              where savePage' :: Site -> Page -> IO (Either String ())
                    savePage' (Site name pages) p = saveSite (Site name (p:pages))

                    saveSite :: Site -> IO (Either String ())
                    saveSite s = catch writeSiteToFile returnError
                              where --returnError :: IOException -> IO (Either String ())
                                    returnError e = return $ Left ("Failed to write to file: " ++ show i ++ ". " ++ show (e :: IOException))
                                    --writeSiteToFile :: IOException -> IO (Either String ())
                                    writeSiteToFile = Right <$> BS.writeFile (getSiteFilename i) (encode s)
\$\endgroup\$
2
\$\begingroup\$

Here's how to use ExceptT to brighten the day a little. You may have hoped for a way to do handle only once after combining the Handlers with :<|>... but I also don't know how to do that. If withExceptT went to arbitrary MonadError instances, handle could have been more concise.

import Control.Monad.Trans.Except

siteServer :: Server SiteAPI
siteServer = site :<|> addPage where
  handle :: ExceptT String IO a -> Handler a
  handle = liftIO . runExceptT >=> \case
    Left err -> throwError $ err404 { errBody = "Site not found!" <> BS.pack err }
    Right x -> return x

  site :: Int -> Handler Site
  site i = handle $ ExceptT $ loadSite i

  addPage :: Int -> Page -> Handler ()
  addPage i p = handle $ do
    Site name pages <- ExceptT $ loadSite i
    withExceptT (\e -> "Failed to write to file: " ++ show i ++ ". " ++ show (e :: IOException))
      $ ExceptT $ try $ BS.writeFile (getSiteFilename i) $ encode $ Site name $ p:pages
| improve this answer | |
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.