Haskell Clean Architecture

Pseudo.hs

{-
This is from:
https://www.reddit.com/r/haskell/comments/73jj32/snapservant_servant_scotty_snap_spockthe_sweet/dnsz25v/
Basically:
Domain doesn't know about persistence
Persistence knows about domain, but doesn't know Routing
Routing knows about domain, but doesn't know Persistence
Main know all of them and tie them all together
If you want to expose the application via command line, you can just create a "CommandLine.hs" that basically parse command line args into domain types. Domain + Persistence need not to change.
-}

-----------------------------
-- Domain.hs

type SessionId = Text
type UserId = Text
type User = Text

class (Monad m) => UserRepo m where
  getUserById :: UserId -> m User

class (Monad m) => SessionRepo m where
  getUserIdBySession :: SessionId -> m UserId

getUser :: (UserRepo m, SessionRepo m)
        => SessionId -> m User
getUser sId = getUserIdBySession sId 
          >>= getUserById

-----------------------------
-- Routes.hs

import qualified Domain

routes :: (Domain.UserRepo m, Domain.SessionRepo m) => m ()
routes =
  get "/user" $ do
    sId <- parseSessionFromCookiesSomehow
    user <- Domain.getUser sId
    displayUserSomeHow user

-----------------------------
-- Redis.hs

import qualified Domain

acquireConnection :: IO Connection
acquireConnection = ...

getUserById :: (Reader Connection m) 
            => Domain.UserId -> m Domain.User
getUserById = ...

getUserIdBySession :: (Reader Connection m) 
                   => Domain.Session -> m Domain.UserId
getUserIdBySession = ...

-----------------------------
-- Main.hs

import qualified Domain
import qualified Redis
import qualified Routes

newtype App a = App 
  { unApp :: ReaderT Connection IO a
  } deriving ( Applicative, Functor, Monad
             , MonadReader Connection, MonadIO
             )

instance Domain.UserRepo App where
  getUserById = Redis.getUserById

instance Domain.SessionRepo App where
  getUserIdBySession = Redis.getUserIdBySession

main = do
  conn <- Redis.acquireConnection
  flip runReaderT conn . unApp $ Routes.routes