Skip to content

Instantly share code, notes, and snippets.

@err0r500
Last active September 5, 2018 12:51
Show Gist options
  • Save err0r500/71cb643c9d1649ea7ec7369e35d870f0 to your computer and use it in GitHub Desktop.
Save err0r500/71cb643c9d1649ea7ec7369e35d870f0 to your computer and use it in GitHub Desktop.
business logic
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment