Three layer example (based on http://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html)

Combined.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Combined where

import           Protolude
import qualified Data.ByteString as BS
import           Control.Monad.Trans (lift)
import           Control.Monad.Reader (ask, runReaderT, ReaderT, MonadReader, MonadTrans)
import           Control.Concurrent.STM (TVar, modifyTVar', newTVar, atomically, readTVar, writeTVar)

--------------------------------------------------------------------------------------------------------
-- Layer 1 (orchestration)
--------------------------------------------------------------------------------------------------------
data AppState = AppState { apText :: !(TVar ByteString)
                         , apScore :: !(TVar Int)
                         , apDb :: !(TVar FilePath)
                         } 

newtype AppT m a = AppT { unAppT :: ReaderT AppState m a 
                        } deriving (Functor, Applicative, Monad, MonadReader AppState, MonadTrans)

askApp :: (AppState -> TVar a) -> AppT IO a
askApp getter = do
  app <- ask
  lift . atomically . readTVar $ getter app

modifyApp :: (AppState -> TVar a) -> (a -> a) -> AppT IO ()
modifyApp getter modify' = do
  app <- ask
  lift . atomically $ modifyTVar' (getter app) modify'
--------------------------------------------------------------------------------------------------------



--------------------------------------------------------------------------------------------------------
-- Layer 2 (bridge / external services)
--  Avoid IO by using mtl
--------------------------------------------------------------------------------------------------------
class (Monad m) => MonadModel m where
  loadModel :: m ByteString
  storeModel :: ByteString -> m ()

type InMemDb = ReaderT (TVar ByteString) 
instance MonadModel (InMemDb IO) where
  loadModel = liftIO . atomically . readTVar =<< ask
  storeModel x = liftIO . atomically . flip writeTVar x =<< ask

type OnDiskDb = ReaderT FilePath
instance (MonadIO m) => MonadModel (OnDiskDb m) where
  loadModel = liftIO . BS.readFile =<< ask
  storeModel x = liftIO . flip BS.writeFile x =<< ask
--------------------------------------------------------------------------------------------------------


--------------------------------------------------------------------------------------------------------
-- Layer 3 (Business logic, pure code only)
--------------------------------------------------------------------------------------------------------
manipulatedData :: ByteString -> (ByteString, Int)
manipulatedData s =
  let s' = s <> ".added" in
  (s', BS.length s')
--------------------------------------------------------------------------------------------------------


-- ========
--  L1
-- ========
run :: IO ()
run = do
  let dbPath = "db1.txt"
  BS.writeFile dbPath "orig-file"

  app <- atomically $ do
    txt <- newTVar "orig"
    score <- newTVar 0
    db <- newTVar dbPath

    pure AppState { apText = txt
                  , apScore = score
                  , apDb = db
                  }

  let pipeline = startup >> process >> finalise
  runReaderT (unAppT pipeline) app


startup :: AppT IO ()
startup = do
  db <- askApp apDb
  v1 <- lift $ runReaderT load db
  modifyApp apText (const v1)

process :: AppT IO ()
process = do
  txt <- askApp apText
  -- E.g. of L1 calling L3 manipulateData, and L2 askApp & modifyApp
  let (s1, v1) = manipulatedData txt 
  modifyApp apText (const s1)
  modifyApp apScore (const v1)

finalise :: AppT IO ()
finalise = do
  txt <- askApp apText
  db <- askApp apDb
  lift $ runReaderT (save txt) db
  lift . print $ txt


-- ========
--  L2
-- ========
load :: (MonadModel m) => m ByteString
load = loadModel

save :: (MonadModel m) => ByteString -> m ()
save = storeModel
-- ========

Separate.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Separate where

import           Protolude
import qualified Data.ByteString as BS
import           Control.Monad.Trans (lift)
import           Control.Monad.Reader (ask, runReaderT, ReaderT, MonadReader, MonadTrans)
import           Control.Concurrent.STM (TVar, modifyTVar', newTVar, atomically, readTVar, writeTVar)

--------------------------------------------------------------------------------------------------------
-- Layer 1 (orchestration)
--------------------------------------------------------------------------------------------------------
data AppState = AppState { apText :: !(TVar ByteString)
                         , apScore :: !(TVar Int)
                         , apDb :: !(TVar FilePath)
                         } 

newtype AppT m a = AppT { unAppT :: ReaderT AppState m a 
                        } deriving (Functor, Applicative, Monad, MonadReader AppState, MonadTrans)

askApp :: (AppState -> TVar a) -> AppT IO a
askApp getter = do
  app <- ask
  lift . atomically . readTVar $ getter app

modifyApp :: (AppState -> TVar a) -> (a -> a) -> AppT IO ()
modifyApp getter modify' = do
  app <- ask
  lift . atomically $ modifyTVar' (getter app) modify'

--
demoAdd5 :: Int -> AppT IO Int
demoAdd5 x =
  pure $ x + 5

demoStoreVal :: Int -> AppT IO ()
demoStoreVal v =
  modifyApp apScore (const v)

dumpAppT :: AppT IO ()
dumpAppT = do
  modifyApp apText (<> ".")
  lift . print =<< askApp apText
  lift . print =<< askApp apScore
  lift . print =<< askApp apDb
--------------------------------------------------------------------------------------------------------



--------------------------------------------------------------------------------------------------------
-- Layer 2 (bridge / external services)
--  Avoid IO by using mtl
--------------------------------------------------------------------------------------------------------
class (Monad m) => MonadModel m where
  loadModel :: m ByteString
  storeModel :: ByteString -> m ()

type InMemDb = ReaderT (TVar ByteString) 
instance MonadModel (InMemDb IO) where
  loadModel = liftIO . atomically . readTVar =<< ask
  storeModel x = liftIO . atomically . flip writeTVar x =<< ask

type OnDiskDb = ReaderT FilePath
instance (MonadIO m) => MonadModel (OnDiskDb m) where
  loadModel = liftIO . BS.readFile =<< ask
  storeModel x = liftIO . flip BS.writeFile x =<< ask

--
demoDb :: MonadModel m => m ByteString
demoDb = do
  v1 <- loadModel
  let v2 = v1 <> ".loaded, "
  storeModel v2
  pure v2

demoInMemDb :: IO ()
demoInMemDb = do
  m <- atomically $ newTVar ("orig-mem" :: ByteString)
  r <- runReaderT demoDb m
  print r

demoOnDiskDb :: IO ()
demoOnDiskDb = do
  let dbPath = "db.txt"
  BS.writeFile dbPath "orig-file"
  r <- runReaderT demoDb dbPath
  print r
--------------------------------------------------------------------------------------------------------


--------------------------------------------------------------------------------------------------------
-- Layer 3 (Business logic, pure code only)
--------------------------------------------------------------------------------------------------------
manipulateData :: Text -> Text
manipulateData t =
  t <> ".manipulated"
--------------------------------------------------------------------------------------------------------


run :: IO ()
run = do
  -- Demo layer 1 only
  app <- atomically $ do
    txt <- newTVar "orig"
    score <- newTVar 0
    db <- newTVar "db.txt"

    pure AppState { apText = txt
                  , apScore = score
                  , apDb = db
                  }

  let fs = demoAdd5 10 >>= demoAdd5 >>= demoStoreVal >> dumpAppT
  runReaderT (unAppT fs) app

  -- Demo layer 2 only
  demoInMemDb
  demoOnDiskDb