Style proposal

natstyle.hs

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
module Main where

import Control.Monad.Morph
import Control.Monad.Reader hiding (reader)
import Control.Monad.State hiding (state)
import Control.Monad.Except
import Control.Monad.IO.Class

-- Boilerplate
data RawQueueResponse
data QueueResponse
data HTTPRequest
data HTTPResponse
data DBModel
data QueuePayload

data AppEnv = AppEnv
data AppState = AppState

-- The full context of a program
type Program = StateT AppState (ReaderT AppEnv IO)

runProgram :: AppEnv -> AppState -> Program a -> IO a
runProgram env s = undefined 

-- Mappings from specific running contexts to the final one
type f :-> g = forall a. f a -> g a

io :: IO :-> Program
io = liftIO

reader :: Reader AppEnv :-> Program
reader = lift . hoist generalize

state :: State AppState :-> Program
state = hoist generalize

stateReader :: StateT AppState (Reader AppEnv) :-> Program
stateReader = hoist (hoist generalize)

-- Domain logic

-- Pull a message from a queue
pullMessage :: IO RawQueueResponse
pullMessage = undefined

-- Construct some HTTP call based off of its response
constructHTTPRequest :: RawQueueResponse -> Reader AppEnv HTTPRequest
constructHTTPRequest = undefined

-- Send the HTTP call
makeHTTPCall :: HTTPRequest -> IO HTTPResponse
makeHTTPCall = undefined

-- Construct a database model based off of the HTTP response and some internals
constructDBModel :: HTTPResponse -> StateT AppState (Reader AppEnv) DBModel
constructDBModel= undefined

-- Save the model
saveDBModel :: DBModel -> IO ()
saveDBModel = undefined

-- Construct a queue payload using some internal state
constructQueuePayload :: State AppState QueuePayload
constructQueuePayload = undefined

-- Push a queue payload over http
pushQueuePayload :: QueuePayload -> IO HTTPResponse
pushQueuePayload = undefined

program :: Program ()
program = do
    message <- io pullMessage
    httpPayload <- reader (constructHTTPRequest message)
    res <- io (makeHTTPCall httpPayload)
    model <- stateReader (constructDBModel res)
    io (saveDBModel model)
    payload <- state constructQueuePayload
    io (pushQueuePayload payload)
    pure ()

main :: IO ()
main = runProgram AppEnv AppState program