Bots2 Clone

Bots.hs

import Pipes
import qualified Pipes.Prelude as P
import qualified System.Random as R
import Lens.Family2 
import Lens.Family2.Stock 
import Lens.Family2.State.Lazy
import Control.Monad.Trans.State
import Control.Monad
import Control.Concurrent(threadDelay)

data Bot = Bot
    { _name :: String
    , _str :: Int
    , _dex :: Int
    , _con :: Int
    , _hp :: Int
    } deriving (Show, Eq)

name :: Lens' Bot String
str, dex, con, hp :: Lens' Bot Int
name k (Bot nm s d c h)  = fmap (\nm' -> Bot nm' s d c h) (k nm)
str  k (Bot nm s d c h)  = fmap (\s'  -> Bot nm s' d c h) (k s )
dex  k (Bot nm s d c h)  = fmap (\d'  -> Bot nm s d' c h) (k d )
con  k (Bot nm s d c h)  = fmap (\c'  -> Bot nm s d c' h) (k c )
hp   k (Bot nm s d c h)  = fmap (\h'  -> Bot nm s d c h') (k h )

type Event = (Int, Bool, Bool)

type BotState = (R.StdGen, (Bot, Bot))

generator :: Lens' BotState R.StdGen
generator = _1

player :: Lens' BotState Bot
player = _2._1

enemy :: Lens' BotState Bot
enemy = _2._2

genEvent :: Bot -> StateT R.StdGen IO Event
genEvent bot = do
    [n, m, r] <- replicateM 3 $ state (R.randomR (0, 100))
    let dodge = n < 100 * bot^.dex `div` (bot^.dex + 50)
        block = m < 100 * bot^.con `div` (bot^.con + 30)
        dmg   = bot^.str + (bot^.str * r) `div` 30
    return (dmg, dodge, block)

genEventPair :: StateT BotState IO (Event, Event)
genEventPair = do
    p <- use player
    e <- use enemy
    zoom generator $ liftM2 switchDmgs (genEvent p) (genEvent e)
  where
    switchDmgs (a, b, c) (d, e, f) = ( (d, b, c), (a, e, f) )

resolve :: (Monad m) => Event -> StateT Bot m ()
resolve (dmg, ddg, blk)
    | ddg       = return ()
    | blk       = hp -= dmg `div` 2
    | otherwise = hp -= dmg

resolveEvent :: (Monad m) => (Event, Event) -> StateT BotState m [(Bot, Event)]
resolveEvent (p_evt, e_evt) = do
    zoom player (resolve p_evt)
    zoom enemy  (resolve e_evt)
    p <- use player
    e <- use enemy
    return [(p, p_evt), (e, e_evt)]

printEvent :: Bot -> Event -> IO ()
printEvent bot (_, True, _) = putStrLn $ bot^.name ++ " dodges the attack and takes no damage!"
printEvent bot (d, _, True) = putStrLn $ bot^.name ++ " blocks and takes half (" ++ show (d `div` 2) ++ ") damage!"
printEvent bot (d, _,    _) = putStrLn $ bot^.name ++ " takes " ++ show d ++ " damage."

printBot :: Bot -> IO ()
printBot bot = putStrLn $ bot^.name ++ " has " ++ show (bot^.hp) ++ " hp remaining."


dead :: Bot -> Bool
dead = (<= 0) . view hp

printGame :: Consumer [(Bot, Event)] (StateT BotState IO) ()
printGame = do
    botEvents@[(b1, e1), (b2, e2)] <- await
    lift $ lift $ do
        forM_ botEvents $ \be@(bot, event) -> do
            uncurry printEvent be
            printBot bot
            threadDelay 500000
            when (dead bot) $ putStrLn $ bot^.name ++ " died!"
        putStrLn $ case (dead b1, dead b2) of
            (True , True ) -> "It was a tie!"
            (True , False) -> b2^.name ++ " wins!"
            (False, True ) -> b1^.name ++ " wins!"
            _              -> "-----------------"
    unless (any (dead . fst) botEvents) printGame

runGame :: IO ()
runGame = do
    gen <- R.getStdGen
    let player = Bot "The Good Guy" 10 13 12 300
        enemy  = Bot "The Bad Guy"  14 6  10 200
        startState = (gen, (player, enemy))
    flip evalStateT startState $
        runEffect $ lift (genEventPair >>= resolveEvent) >~ printGame