Render messages into HTML bubbles

gistfile1.txt

-- Initial bubbles.cabal generated by cabal init.  For further
-- documentation, see http://haskell.org/cabal/users-guide/

name:                bubbles
version:             0.1.0.0
-- synopsis:
-- description:
-- license:
license-file:        LICENSE
author:              Jean-Baptiste Potonnier
maintainer:          jb
-- copyright:
category:            Development
build-type:          Simple
-- extra-source-files:
cabal-version:       >=1.10

executable bubbles
  main-is:             Main.hs
  -- other-modules:
  -- other-extensions:
  build-depends:     base >=4.7 && <4.8
                   , text  >=1.2.0.4
                   , lucid >=2.9.2
  hs-source-dirs:      src
  default-language:    Haskell2010

Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

import Data.List (groupBy)
import Data.Function (on)
import Data.Text (Text)
import qualified Data.Text.Lazy as LT
import qualified Data.Text.IO as TextIO
import Lucid

type From = String

data Message = Message {
    messageFrom :: From,
    messageText :: Text
  }
  deriving Show

data Bubble = Bubble From [Text]
  deriving Show

makeBubbles :: [Message] -> [Bubble]
makeBubbles =
  map makeBubble . groupBy ((==) `on` messageFrom)

makeBubble :: [Message] -> Bubble
makeBubble [] = error "Cannot make bubble without message"
makeBubble ms@(m:_) = Bubble (messageFrom m) (map messageText ms)

renderBubble :: Bubble -> Html ()
renderBubble (Bubble _ texts) =
  div_ [class_ "bubble"] (mapM_ (p_ . toHtml) texts)

renderBubbles :: [Bubble] -> Html ()
renderBubbles bubbles = div_ (mapM_ renderBubble bubbles)

render :: [Message] -> Html ()
render = renderBubbles . makeBubbles

main :: IO ()
main = do
  let messages = [
          Message "JB" "Hello"
          , Message "JB"  "I have a question"
          , Message "David" "Hi"
          , Message "JB" "how to ..."
          , Message "David" "OK"
          , Message "David" "I understand!"
        ]
  TextIO.putStrLn $ (LT.toStrict . renderText . render ) messages