Formatting.hs

{-# LANGUAGE FlexibleContexts #-}
module Dovin.Formatting where

import Control.Monad.Writer (Writer, execWriter, tell)

import qualified Data.HashMap.Strict as M
import qualified Data.Set as S
import Data.List (intercalate, sort, sortBy, nub)
import Data.Ord (comparing)

import Dovin.Helpers
import Dovin.Monad
import Dovin.Prelude
import Dovin.Types

type FormatMonad = Writer [(String, GameMonad String)]

blankFormatter :: Formatter
blankFormatter _ = ""

attributeFormatter :: FormatMonad () -> Formatter
attributeFormatter m =
  f $ execWriter m
  where
    f :: [(String, GameMonad String)] -> Formatter
    f attrs board =
      "\n      " <> (intercalate ", " . map (\(x, y) -> x <> ": " <> y) $
        map formatAttribute attrs)

      where
        formatAttribute :: (String, GameMonad String) -> (String, String)
        formatAttribute (label, m) =
          let Right value = execMonad board m in
          (label, value)

stackFormatter :: Formatter
stackFormatter board =
  let matchingCs = map lookupCard $ view stack board in

  "\n      Stack:\n" <> formatCards matchingCs

  where
    lookupCard cn =
      let Right value = execMonad board (requireCard cn mempty) in value


cardFormatter :: String -> CardMatcher -> Formatter
cardFormatter title matcher board =
  let matchingCs = sortBy (comparing $ view cardName) . filter (applyMatcher matcher) $ cs in

    "\n      " <> title <> ":\n" <> formatCards matchingCs

  where
    cs = let Right value = execMonad board allCards in value

formatCards = intercalate "\n" . map (("      " <>) . formatCard)

formatCard c =
  "  " <> view cardName c <>
  " (" <> (intercalate "," . sort . S.toList $ view cardAttributes c) <> ")"
  <> if hasAttribute "creature" c then
       " ("
         <> show (view cardPower c)
         <> "/"
         <> show (view cardToughness c)
         <> (let n = view cardPlusOneCounters c in
              if n > 0 then
                ", +" <> show n <> "/+" <> show n
              else
                mempty)
         <> (let n = view cardMinusOneCounters c in
              if n > 0 then
                ", -" <> show n <> "/-" <> show n
              else
                mempty)
         <> (if view cardDamage c > 0 then
              ", " <> show (view cardDamage c)
            else
              mempty)
         <> ")"
     else if hasAttribute "planeswalker" c then
       " ("
         <> show (view cardLoyalty c)
         <> ")"
     else
      ""

boardFormatter :: Formatter
boardFormatter board =
  let allLocations = nub . sort . map (view location) $ cs in

  let formatters = map
                     formatLocation
                     allLocations in

  mconcat formatters board

  where
    cs = let Right value = execMonad board allCards in value
    formatLocation (Active, Stack) = stackFormatter
    formatLocation l = cardFormatter (show l) (matchLocation l)

attribute :: Show a => String -> GameMonad a -> FormatMonad ()
attribute label m = tell [(label, show <$> m)]

countLife :: Player -> GameMonad Int
countLife player = use (life . at player . non 0)

countValue :: String -> GameMonad Int
countValue name = use (counters . at name . non 0)

countCards :: CardMatcher -> GameMonad Int
countCards matcher =
  length . filter (applyMatcher matcher) <$> allCards

countManaPool :: Player -> GameMonad Int
countManaPool p = length <$> use (manaPoolFor p)