Tournament bracket recursive style with Haskell and Reflex

bracket.hs

{-# LANGUAGE OverloadedStrings, RankNTypes, ScopedTypeVariables, TypeFamilies, FlexibleInstances, FlexibleContexts #-}

module Main where

import           Control.Monad (void, when)
import           Data.Maybe (fromMaybe)
import           Data.Monoid
import qualified Data.List as List
import qualified Data.Text as T
import           Reflex
import           Reflex.Dom

type Score = (Int, Int)

type Game = (Maybe T.Text, Maybe T.Text)

games' = [ (Just "A", Just "B")
         , (Just "C", Just "D")
         , (Just "E", Just "F")
         , (Just "G", Just "H")]

main :: IO ()
main = mainWidget $ showGames games'

showGames :: MonadWidget t m => [Game] -> m (Behavior t [Game])
showGames [] = return $ constant []
showGames [game'] = do
  el "div" $ text "Final"
  void $ showGameEl game'
  return $ constant []
showGames games' = do
  when (List.length games' == 2) $ el "div" $ text "Half final"
  winners' <- sequence <$> mapM showGameEl games'
  next' <- dyn $ (showGames . mkRound) <$> winners'
  switcher (constant []) next'

-- [Winner] -> [Game]
mkRound :: [Maybe T.Text] -> [Game]
mkRound [] = []
mkRound rx = (head rx, rx !! 1) : mkRound (drop 2 rx)

-- Game -> Dynamic Winner
showGameEl :: MonadWidget t m => Game -> m (Dynamic t (Maybe T.Text))
showGameEl game = do
  el "div" $ text $ titleGame' game
  score' <- _textInput_value <$> textInput def
  return $ (winner game . readMay . T.unpack) <$> score'

titleGame' :: Game -> T.Text
titleGame' (t1, t2) = fromMaybe "tbd." t1 <> " vs " <> fromMaybe "tbd." t2

winner :: Game -> Maybe Score -> Maybe T.Text
winner (Just t1, Just t2) (Just (score1, score2))
  | score1 > score2 = Just t1
  | otherwise = Just t2
winner _ _ = Nothing