monadic business logic

main.hs

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

module Main where

import Control.Monad.Identity

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

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

instance UserGetter IO where
  getName _ = getLine
  getFirstname _ = return "ioUserFirstname"

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


class Monad m => BusinessLogic m where
  getCompleteUser :: Int -> m User

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


main :: IO ()
main = do
  user1 <- runIdentityT (getCompleteUser 12)
  user2 <- getCompleteUser 13
  print user1 -- User {name = "identityUserName", firstName = "identityUserFirstname"}
  print user2 -- User {name = "text typed as input", firstName = "ioUserFirstname"}