{-# LANGUAGE FlexibleContexts #-} module Dovin.Formatting where import Dovin.Helpers import Dovin.Matchers import Dovin.Monad import Dovin.Prelude import Dovin.Types 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) type FormatMonad = Writer [(String, GameMonad String)] blankFormatter :: Formatter blankFormatter :: Formatter blankFormatter Board _ = [Char] "" attributeFormatter :: FormatMonad () -> Formatter attributeFormatter :: FormatMonad () -> Formatter attributeFormatter FormatMonad () m = [([Char], GameMonad [Char])] -> Formatter f ([([Char], GameMonad [Char])] -> Formatter) -> [([Char], GameMonad [Char])] -> Formatter forall a b. (a -> b) -> a -> b $ FormatMonad () -> [([Char], GameMonad [Char])] forall w a. Writer w a -> w execWriter FormatMonad () m where f :: [(String, GameMonad String)] -> Formatter f :: [([Char], GameMonad [Char])] -> Formatter f [([Char], GameMonad [Char])] attrs Board board = [Char] "\n " [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> ([Char] -> [[Char]] -> [Char] forall a. [a] -> [[a]] -> [a] intercalate [Char] ", " ([[Char]] -> [Char]) -> ([([Char], [Char])] -> [[Char]]) -> [([Char], [Char])] -> [Char] forall b c a. (b -> c) -> (a -> b) -> a -> c . (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]] forall a b. (a -> b) -> [a] -> [b] map (\([Char] x, [Char] y) -> [Char] x [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] ": " [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] y) ([([Char], [Char])] -> [Char]) -> [([Char], [Char])] -> [Char] forall a b. (a -> b) -> a -> b $ (([Char], GameMonad [Char]) -> ([Char], [Char])) -> [([Char], GameMonad [Char])] -> [([Char], [Char])] forall a b. (a -> b) -> [a] -> [b] map ([Char], GameMonad [Char]) -> ([Char], [Char]) formatAttribute [([Char], GameMonad [Char])] attrs) where formatAttribute :: (String, GameMonad String) -> (String, String) formatAttribute :: ([Char], GameMonad [Char]) -> ([Char], [Char]) formatAttribute ([Char] label, GameMonad [Char] m) = let Right [Char] value = Board -> GameMonad [Char] -> Either [Char] [Char] forall a. Board -> GameMonad a -> Either [Char] a execMonad Board board GameMonad [Char] m in ([Char] label, [Char] value) stackFormatter :: Formatter stackFormatter :: Formatter stackFormatter Board board = let matchingCs :: [Card] matchingCs = ([Char] -> Card) -> [[Char]] -> [Card] forall a b. (a -> b) -> [a] -> [b] map [Char] -> Card lookupCard ([[Char]] -> [Card]) -> [[Char]] -> [Card] forall a b. (a -> b) -> a -> b $ Getting [[Char]] Board [[Char]] -> Board -> [[Char]] forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting [[Char]] Board [[Char]] Lens' Board [[Char]] stack Board board in [Char] "\n Stack:\n" [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Card] -> [Char] formatCards [Card] matchingCs where lookupCard :: [Char] -> Card lookupCard [Char] cn = let Right Card value = Board -> GameMonad Card -> Either [Char] Card forall a. Board -> GameMonad a -> Either [Char] a execMonad Board board ([Char] -> CardMatcher -> GameMonad Card requireCard [Char] cn CardMatcher forall a. Monoid a => a mempty) in Card value cardFormatter :: String -> CardMatcher -> Formatter cardFormatter :: [Char] -> CardMatcher -> Formatter cardFormatter [Char] title CardMatcher matcher Board board = let matchingCs :: [Card] matchingCs = (Card -> Card -> Ordering) -> [Card] -> [Card] forall a. (a -> a -> Ordering) -> [a] -> [a] sortBy ((Card -> [Char]) -> Card -> Card -> Ordering forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing ((Card -> [Char]) -> Card -> Card -> Ordering) -> (Card -> [Char]) -> Card -> Card -> Ordering forall a b. (a -> b) -> a -> b $ Getting [Char] Card [Char] -> Card -> [Char] forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting [Char] Card [Char] Lens' Card [Char] cardName) ([Card] -> [Card]) -> ([Card] -> [Card]) -> [Card] -> [Card] forall b c a. (b -> c) -> (a -> b) -> a -> c . (Card -> Bool) -> [Card] -> [Card] forall a. (a -> Bool) -> [a] -> [a] filter (CardMatcher -> Card -> Bool applyMatcher CardMatcher matcher) ([Card] -> [Card]) -> [Card] -> [Card] forall a b. (a -> b) -> a -> b $ [Card] cs in [Char] "\n " [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] title [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] ":\n" [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Card] -> [Char] formatCards [Card] matchingCs where cs :: [Card] cs = let Right [Card] value = Board -> GameMonad [Card] -> Either [Char] [Card] forall a. Board -> GameMonad a -> Either [Char] a execMonad Board board GameMonad [Card] allCards in [Card] value formatCards :: [Card] -> [Char] formatCards = [Char] -> [[Char]] -> [Char] forall a. [a] -> [[a]] -> [a] intercalate [Char] "\n" ([[Char]] -> [Char]) -> ([Card] -> [[Char]]) -> [Card] -> [Char] forall b c a. (b -> c) -> (a -> b) -> a -> c . (Card -> [Char]) -> [Card] -> [[Char]] forall a b. (a -> b) -> [a] -> [b] map (([Char] " " [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <>) ([Char] -> [Char]) -> (Card -> [Char]) -> Card -> [Char] forall b c a. (b -> c) -> (a -> b) -> a -> c . Card -> [Char] formatCard) formatCard :: Card -> [Char] formatCard Card c = [Char] " " [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> Getting [Char] Card [Char] -> Card -> [Char] forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting [Char] Card [Char] Lens' Card [Char] cardName Card c [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] " (" [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> ([Char] -> [[Char]] -> [Char] forall a. [a] -> [[a]] -> [a] intercalate [Char] "," ([[Char]] -> [Char]) -> (Set [Char] -> [[Char]]) -> Set [Char] -> [Char] forall b c a. (b -> c) -> (a -> b) -> a -> c . [[Char]] -> [[Char]] forall a. Ord a => [a] -> [a] sort ([[Char]] -> [[Char]]) -> (Set [Char] -> [[Char]]) -> Set [Char] -> [[Char]] forall b c a. (b -> c) -> (a -> b) -> a -> c . Set [Char] -> [[Char]] forall a. Set a -> [a] S.toList (Set [Char] -> [Char]) -> Set [Char] -> [Char] forall a b. (a -> b) -> a -> b $ Getting (Set [Char]) Card (Set [Char]) -> Card -> Set [Char] forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting (Set [Char]) Card (Set [Char]) Lens' Card (Set [Char]) cardAttributes Card c) [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] ")" [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> if [Char] -> Card -> Bool hasAttribute [Char] "creature" Card c then [Char] " (" [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> Int -> [Char] forall a. Show a => a -> [Char] show (Getting Int Card Int -> Card -> Int forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting Int Card Int Lens' Card Int cardPower Card c) [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] "/" [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> Int -> [Char] forall a. Show a => a -> [Char] show (Getting Int Card Int -> Card -> Int forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting Int Card Int Lens' Card Int cardToughness Card c) [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> (let n :: Int n = Getting Int Card Int -> Card -> Int forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting Int Card Int Lens' Card Int cardPlusOneCounters Card c in if Int n Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int 0 then [Char] ", +" [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> Int -> [Char] forall a. Show a => a -> [Char] show Int n [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] "/+" [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> Int -> [Char] forall a. Show a => a -> [Char] show Int n else [Char] forall a. Monoid a => a mempty) [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> (let n :: Int n = Getting Int Card Int -> Card -> Int forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting Int Card Int Lens' Card Int cardMinusOneCounters Card c in if Int n Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int 0 then [Char] ", -" [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> Int -> [Char] forall a. Show a => a -> [Char] show Int n [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] "/-" [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> Int -> [Char] forall a. Show a => a -> [Char] show Int n else [Char] forall a. Monoid a => a mempty) [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> (if Getting Int Card Int -> Card -> Int forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting Int Card Int Lens' Card Int cardDamage Card c Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int 0 then [Char] ", " [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> Int -> [Char] forall a. Show a => a -> [Char] show (Getting Int Card Int -> Card -> Int forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting Int Card Int Lens' Card Int cardDamage Card c) else [Char] forall a. Monoid a => a mempty) [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] ")" else if [Char] -> Card -> Bool hasAttribute [Char] "planeswalker" Card c then [Char] " (" [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> Int -> [Char] forall a. Show a => a -> [Char] show (Getting Int Card Int -> Card -> Int forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting Int Card Int Lens' Card Int cardLoyalty Card c) [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> [Char] ")" else [Char] "" boardFormatter :: Formatter boardFormatter :: Formatter boardFormatter Board board = let allLocations :: [(Player, Location)] allLocations = [(Player, Location)] -> [(Player, Location)] forall a. Eq a => [a] -> [a] nub ([(Player, Location)] -> [(Player, Location)]) -> ([Card] -> [(Player, Location)]) -> [Card] -> [(Player, Location)] forall b c a. (b -> c) -> (a -> b) -> a -> c . [(Player, Location)] -> [(Player, Location)] forall a. Ord a => [a] -> [a] sort ([(Player, Location)] -> [(Player, Location)]) -> ([Card] -> [(Player, Location)]) -> [Card] -> [(Player, Location)] forall b c a. (b -> c) -> (a -> b) -> a -> c . (Card -> (Player, Location)) -> [Card] -> [(Player, Location)] forall a b. (a -> b) -> [a] -> [b] map (Getting (Player, Location) Card (Player, Location) -> Card -> (Player, Location) forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting (Player, Location) Card (Player, Location) Lens' Card (Player, Location) location) ([Card] -> [(Player, Location)]) -> [Card] -> [(Player, Location)] forall a b. (a -> b) -> a -> b $ [Card] cs in let formatters :: [Formatter] formatters = ((Player, Location) -> Formatter) -> [(Player, Location)] -> [Formatter] forall a b. (a -> b) -> [a] -> [b] map (Player, Location) -> Formatter formatLocation [(Player, Location)] allLocations in [Formatter] -> Formatter forall a. Monoid a => [a] -> a mconcat [Formatter] formatters Board board where cs :: [Card] cs = let Right [Card] value = Board -> GameMonad [Card] -> Either [Char] [Card] forall a. Board -> GameMonad a -> Either [Char] a execMonad Board board GameMonad [Card] allCards in [Card] value formatLocation :: (Player, Location) -> Formatter formatLocation (Player Active, Location Stack) = Formatter stackFormatter formatLocation (Player, Location) l = [Char] -> CardMatcher -> Formatter cardFormatter ((Player, Location) -> [Char] forall a. Show a => a -> [Char] show (Player, Location) l) ((Player, Location) -> CardMatcher matchLocation (Player, Location) l) attribute :: Show a => String -> GameMonad a -> FormatMonad () attribute :: [Char] -> GameMonad a -> FormatMonad () attribute [Char] label GameMonad a m = [([Char], GameMonad [Char])] -> FormatMonad () forall w (m :: * -> *). MonadWriter w m => w -> m () tell [([Char] label, a -> [Char] forall a. Show a => a -> [Char] show (a -> [Char]) -> GameMonad a -> GameMonad [Char] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GameMonad a m)] countLife :: Player -> GameMonad Int countLife :: Player -> GameMonad Int countLife Player player = Getting Int Board Int -> GameMonad Int forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use ((HashMap Player Int -> Const Int (HashMap Player Int)) -> Board -> Const Int Board Lens' Board (HashMap Player Int) life ((HashMap Player Int -> Const Int (HashMap Player Int)) -> Board -> Const Int Board) -> ((Int -> Const Int Int) -> HashMap Player Int -> Const Int (HashMap Player Int)) -> Getting Int Board Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Index (HashMap Player Int) -> Lens' (HashMap Player Int) (Maybe (IxValue (HashMap Player Int))) forall m. At m => Index m -> Lens' m (Maybe (IxValue m)) at Index (HashMap Player Int) Player player ((Maybe Int -> Const Int (Maybe Int)) -> HashMap Player Int -> Const Int (HashMap Player Int)) -> ((Int -> Const Int Int) -> Maybe Int -> Const Int (Maybe Int)) -> (Int -> Const Int Int) -> HashMap Player Int -> Const Int (HashMap Player Int) forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Iso' (Maybe Int) Int forall a. Eq a => a -> Iso' (Maybe a) a non Int 0) countValue :: String -> GameMonad Int countValue :: [Char] -> GameMonad Int countValue [Char] name = Getting Int Board Int -> GameMonad Int forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use ((HashMap [Char] Int -> Const Int (HashMap [Char] Int)) -> Board -> Const Int Board Lens' Board (HashMap [Char] Int) counters ((HashMap [Char] Int -> Const Int (HashMap [Char] Int)) -> Board -> Const Int Board) -> ((Int -> Const Int Int) -> HashMap [Char] Int -> Const Int (HashMap [Char] Int)) -> Getting Int Board Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Index (HashMap [Char] Int) -> Lens' (HashMap [Char] Int) (Maybe (IxValue (HashMap [Char] Int))) forall m. At m => Index m -> Lens' m (Maybe (IxValue m)) at [Char] Index (HashMap [Char] Int) name ((Maybe Int -> Const Int (Maybe Int)) -> HashMap [Char] Int -> Const Int (HashMap [Char] Int)) -> ((Int -> Const Int Int) -> Maybe Int -> Const Int (Maybe Int)) -> (Int -> Const Int Int) -> HashMap [Char] Int -> Const Int (HashMap [Char] Int) forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Iso' (Maybe Int) Int forall a. Eq a => a -> Iso' (Maybe a) a non Int 0) countCards :: CardMatcher -> GameMonad Int countCards :: CardMatcher -> GameMonad Int countCards CardMatcher matcher = [Card] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([Card] -> Int) -> ([Card] -> [Card]) -> [Card] -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . (Card -> Bool) -> [Card] -> [Card] forall a. (a -> Bool) -> [a] -> [a] filter (CardMatcher -> Card -> Bool applyMatcher CardMatcher matcher) ([Card] -> Int) -> GameMonad [Card] -> GameMonad Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GameMonad [Card] allCards countManaPool :: Player -> GameMonad Int countManaPool :: Player -> GameMonad Int countManaPool Player p = [Char] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([Char] -> Int) -> GameMonad [Char] -> GameMonad Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Getting [Char] Board [Char] -> GameMonad [Char] forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use (Player -> Getting [Char] Board [Char] forall (f :: * -> *). Functor f => Player -> ([Char] -> f [Char]) -> Board -> f Board manaPoolFor Player p)