Splitting app state rendering into parts using Contravariant Divisible

divisible-renderers.hs

-- Attempt splitting an 'App Renderer' into smaller renderers using the Contravariant Divisible class;
-- Didn't really work out great, seems better to just use simple contramaps to map each renderer into
-- a `Renderer AppState` and then use a monoid to fold them.
{-# language InstanceSigs #-}
module Main where

import Data.Foldable
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible

-- Pretend we have some monoidal html type
type HTML = String

-- | Renders some 'a' to html.
newtype Renderer a = Renderer
  { runRender :: a -> HTML }

-- Renderers are Contravariant in 'a'
instance Contravariant Renderer where
  contramap :: (a -> b) -> Renderer b -> Renderer a
  contramap f (Renderer r) = Renderer (r . f)

-- Divisible allows us to take a function which 'splits' an a, and use it to combine two 
-- Contravariant functors over the pieces. In this case we split the total app state into two smaller
-- bits which each have their own renderers.
instance Divisible Renderer where
  divide :: (a -> (b, c)) -> Renderer b -> Renderer c -> Renderer a
  divide split (Renderer renderB) (Renderer renderC) = Renderer (go . split)
    where go (b', c') = renderB b' `mappend` renderC c'

  -- The 'empty' piece, just renders empty string.
  conquer :: Renderer a
  conquer = Renderer (const mempty)

-- Dumb test objects
data User = User { firstName :: String, lastName :: String }
data Comment = Comment { author :: User, content :: String }

renderUser :: Renderer User
renderUser = Renderer $ \(User firstN lastN) ->
  "Hello " ++ firstN ++ " " ++ lastN ++ "\n"

renderListOf :: Renderer a -> Renderer [a]
renderListOf = Renderer . foldMap . runRender

renderComment :: Renderer Comment
renderComment = Renderer $ \(Comment auth cont) ->
  "Author: " ++ runRender renderUser auth ++ cont ++ "\n\n"

type Post = String

data AppState = AppState
  { users :: [User]
  , comments :: [Comment]
  , posts :: [Post]
  }

-- Use 'divide' to combine our two renderers given a 'split' function for appstate.
-- Unfortunately it gets tricky to generalize this to 'n' splits.
renderApp :: Renderer AppState
renderApp = divide splitAppState (renderListOf renderUser) (renderListOf renderComment)
  where splitAppState appstate = (users appstate, comments appstate)

steve, janet :: User
steve = User "Steve" "Smith"
janet = User "Janet" "Marcou"

listUsers :: [User]
listUsers = [steve, janet]

listComments :: [Comment]
listComments = [Comment steve "I wrote a thing", Comment janet "I'm a writer also"]

main :: IO ()
main = putStr . runRender renderApp $ AppState listUsers listComments ["ignored post"]

-------------------------------------------------------------------------------
-- Simpler method using just contramap

-- Rely on underlying function monoid instance; this could be derived, but w/e
instance Monoid (Renderer a) where
  mempty = Renderer mempty
  (Renderer a) `mappend` (Renderer b) = Renderer (a `mappend` b)

-- Contramap to act on appstate
liftedUserRender :: Renderer AppState
liftedUserRender = contramap users (renderListOf renderUser)

liftedCommentRender :: Renderer AppState
liftedCommentRender = contramap comments (renderListOf renderComment)

-- Just use monoid to fold all the renderers, which just monoidally appends all the
-- rendered HTML.
simpleRenderer :: Renderer AppState
simpleRenderer = fold [liftedUserRender, liftedCommentRender]

simplerWay :: IO ()
simplerWay = putStr . runRender simpleRenderer $ AppState listUsers listComments ["ignored post"]