Haskell The Legend of DSLs Alejandro Serrano ZuriHac 2022

Main.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}

module Main where

import Data.List
import Data.Text
import Numeric.Natural

data Card = PokemonCard { name    :: Text
                        , typ     :: Energy
                        , hp      :: HP
                        , attacks :: [Attack] }
          | EnergyCard  { typ     :: Energy }
          deriving Show

newtype HP = HP Natural
           deriving (Eq, Show, Num)

data Energy = Colorless
            | Grass
            | Fire
            | Water
            | Lightning
            | Fighting
            | Psychic
            | Darkness
            | Metal
            | Dragon
            deriving (Show)

instance Eq Energy where
  Colorless == _         = True
  _         == Colorless = True
  Grass     == Grass     = True
  Fire      == Fire      = True
  Water     == Water     = True
  Lightning == Lightning = True
  Psychic   == Psychic   = True
  Darkness  == Darkness  = True
  Metal     == Metal     = True
  Dragon    == Dragon    = True
  _         == _         = False

data Attack = Attack { attackName :: Text
                     , cost       :: [Energy]
                     , damage     :: Natural
                     } deriving Show

enoughEnergy :: [Energy] -> [Card] -> Bool
enoughEnergy []     _     = True
enoughEnergy (e:es) cards = if e `elem` energies
                            then enoughEnergy es newCards
                            else False
  where energies = typ <$> cards
        newCards = EnergyCard <$> delete e energies

missingEnergy :: [Energy] -> [Card] -> Maybe [Energy]
missingEnergy cost cards =
  case enoughEnergy cost cards of
    True  -> Nothing
    False -> Just $ go cost (typ <$> cards) []
  where go []     _     missing = missing
        go (e:es) cards missing = if e `elem` cards
                                  then go es (delete e cards) missing
                                  else go es cards (e:missing)

data FlipOutcome = Heads | Tails
                 deriving Show

data Action = FlipCoin (FlipOutcome -> Action)
            | Damage Natural

-- Flip a coin. If tails, this attack does nothing.
surpriseAttackAction :: Action
surpriseAttackAction = FlipCoin $ \case Heads -> Damage 30
                                        Tails -> Damage 0

-- Flip a coin until you get tails. This attack does 30 damage for each heads.
ironTailAction :: Action
ironTailAction = ironTailAction' 0

ironTailAction' :: Natural -> Action
ironTailAction' n = FlipCoin $ \case Heads -> ironTailAction' (n + 1)
                                     Tails -> Damage (30 * n)

scratch :: Attack
scratch = Attack "Scratch" [Colorless] 10

beat :: Attack
beat = Attack "Beat" [Grass, Colorless] 20

grookey :: Card
grookey = PokemonCard "Grookey" Grass 70 [scratch, beat]

main :: IO ()
main = putStrLn "Hello, Haskell!"