business logic

main.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}

module Main where

import Control.Monad.Identity
import Control.Monad.Trans.Either
import Control.Monad.Trans.Except

data User = User
  { name :: String
  , firstName :: String
  } deriving (Show)

class Monad m =>
      UserGetter m
  where
  getName :: Int -> m (Either String String)
  getFirstname :: Int -> m (Either String String)

class Monad m =>
      BusinessLogic m
  where
  getCompleteUser :: Int -> m (Either String User)

instance (UserGetter m, Monad m) => BusinessLogic m where
  getCompleteUser id = runExceptT $ do
      name <- ExceptT $ getName id
      firstName <- ExceptT $ getFirstname id
      return (User name firstName)

instance UserGetter IO where
  getName _ = do
    n <- getLine
    return (Right n)
  getFirstname _ = return (Right "ioUserFirstname")

instance (Monad m) => UserGetter (IdentityT m) where
  getName _ = return (Right "identityUserName")
  getFirstname _ = return (Right "identityUserFirstname")

main :: IO ()
main = do
  user1 <- runIdentityT (getCompleteUser 12)
  user2 <- getCompleteUser 13
  print user1
  print user2