{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE BangPatterns #-}

import System.Random
import Control.Monad
import Data.Bits
import Control.Monad.Trans.State
import Control.Monad.IO.Class

------------------------------------------------------------------------------
monstersNum :: Int
monstersNum = 12


------------------------------------------------------------------------------
data Player = Player { pHealth :: Int,
                       pAgility :: Int,
                       pStrength :: Int }


instance Show Player where
    show (Player h a s) =
        "You are a valiant knight with a health of " ++ show h ++
        ", an agility of " ++ show a ++
        ", and a strenght of " ++ show s ++ "."


------------------------------------------------------------------------------
type HitPoint = Int


------------------------------------------------------------------------------
class Monster a where
    health :: a -> Int
    description :: a -> String
    hit :: a -> HitPoint -> a
    attack :: a -> Player -> IO (Player, MonsterInstance)


------------------------------------------------------------------------------
data MonsterInstance = forall a. Monster a => MonsterInstance a


------------------------------------------------------------------------------
data Orc = Orc { oHealth :: Int,
                 clubLevel :: Int }


instance Monster Orc where
    health (Orc h _) = h
    description (Orc _ cl) = "A wicked Orc with a level " ++ show cl ++ " club."
    hit orc hitPoints = orc { oHealth = oHealth orc - hitPoints }
    attack orc (Player h a s) = do
        blowPower <- randVal $ clubLevel orc
        putStrLn $ "An orc swings his club at you and knocks off "
                 ++ show blowPower ++ " of your healths points."
        return (Player (h - blowPower) a s, MonsterInstance orc)


orcBuilder :: IO MonsterInstance
orcBuilder = do
    orcHealth <- randVal 10
    orcClubLevel <- randVal 8
    return (MonsterInstance $ Orc orcHealth orcClubLevel)


------------------------------------------------------------------------------
-- | Returns a random int in the range 1 .. n
randVal :: Int -> IO Int
randVal n = randomRIO (1, n)


------------------------------------------------------------------------------
data Hydra = Hydra { hHealth :: Int }


instance Monster Hydra where
    health (Hydra h) = h
    description (Hydra h) = "A malicious Hydra with " ++ show h
                                  ++ " heads."
    hit hydra hitPoints = hydra { hHealth = hHealth hydra - hitPoints }

    attack hydra@(Hydra hh) (Player h a s) = do
        blowPower <- randVal (hHealth hydra `shiftR` 1)
        putStrLn $ "A hydra attacks you with " ++ show hh ++ " of its heads!"
        putStrLn "It also grows back one more head!"
        return (Player (h - blowPower) a s, MonsterInstance (Hydra (hh + 1)))


hydraBuilder :: IO MonsterInstance
hydraBuilder = do
    hydraHealth <- randVal 10
    return (MonsterInstance $ Hydra hydraHealth)


------------------------------------------------------------------------------
data Brigand = Brigand { bHealth :: Int }


instance Monster Brigand where
    health (Brigand h) = h
    description (Brigand _) = "A fierce Brigand."
    hit brig hitPoints = brig { bHealth = bHealth brig - hitPoints }
    attack brig (Player h a s) = chooseBest $ maximum [h,a,s]
      where
        chooseBest b
          | b == h = do
              putStrLn "A brigand hits you with his slingshot, taking off 2 health points!"
              return (Player (h - 2) a s, MonsterInstance brig)
          | b == a = do
              putStrLn "A brigand catches your leg with his whip, taking off 2 agility points!"
              return (Player h (a - 2) s, MonsterInstance brig)
          | otherwise = do
              putStrLn "A brigand cuts your arm with his whip, taking off 2 strength points!"
              return (Player h a (s - 2), MonsterInstance brig)


brigandBuilder :: IO MonsterInstance
brigandBuilder = do
    brigandHealth <- randVal 10
    return (MonsterInstance $ Brigand brigandHealth)


------------------------------------------------------------------------------
data Slime = Slime { sHealth :: Int,
                     sSliminess :: Int}


instance Monster Slime where
    health (Slime h _) = h
    description (Slime _ s) = "A slime mold with a sliminess of "
                              ++ show s
    hit slime hitPoints = slime { sHealth = sHealth slime - hitPoints }
    attack slime (Player h a s) = do
        blowPower <- randVal $ sSliminess slime
        putStrLn $ "A slime mold wraps around your legs and "
                 ++ "decreases your agility by " ++ show blowPower ++ "!"
        squirtProbability <- randVal 3
        if squirtProbability == 1
          then do
              putStrLn "It also squirts in your face, taking away a health point!"
              return (Player (h - 1) (a - blowPower) s, MonsterInstance slime)
          else return (Player h (a - blowPower) s, MonsterInstance slime)


slimeBuilder :: IO MonsterInstance
slimeBuilder = do
    slimeHealth <- randVal 10
    sliminess <- randVal 5
    return (MonsterInstance $ Slime slimeHealth sliminess)


------------------------------------------------------------------------------
hitInstance :: MonsterInstance -> HitPoint -> MonsterInstance
hitInstance (MonsterInstance m) hp = MonsterInstance $ hit m hp


------------------------------------------------------------------------------
monsterBuilders :: [IO MonsterInstance]
monsterBuilders = [orcBuilder, hydraBuilder, brigandBuilder, slimeBuilder]


------------------------------------------------------------------------------
type WorldState = (Player, [MonsterInstance])


------------------------------------------------------------------------------
type Game = StateT WorldState IO ()


------------------------------------------------------------------------------
main :: IO ()
main = do
    world <- initWorld
    evalStateT gameLoop world
    print "Thanks for playing."
    return ()


------------------------------------------------------------------------------
initWorld :: IO WorldState
initWorld =
    let player = Player 30 30 30
    in do
        monsters <- forM [1 .. monstersNum] (\_ ->
            do
                builderNum <- randVal $ length monsterBuilders
                monsterBuilders !! (builderNum - 1))
        return (player, monsters)


------------------------------------------------------------------------------
gameLoop :: Game
gameLoop = do
    (player, monsters) <- get
    let endCondition = isPlayerDead player || areMonstersDead monsters
    when (isPlayerDead player) (liftIO $ print "You are dead.")
    when (areMonstersDead monsters) (liftIO $ print "You win!.")
    unless endCondition $ do
      liftIO $ print player
      liftIO $ showMonsters monsters
      playerAttack
      monstersAttack
      gameLoop


------------------------------------------------------------------------------
isPlayerDead :: Player -> Bool
isPlayerDead p = pHealth p <= 0


------------------------------------------------------------------------------
isMonsterDead :: MonsterInstance -> Bool
isMonsterDead (MonsterInstance m) = health m <= 0


------------------------------------------------------------------------------
areMonstersDead :: [MonsterInstance] -> Bool
areMonstersDead = all isMonsterDead


------------------------------------------------------------------------------
showMonsters :: [MonsterInstance] -> IO ()
showMonsters ms = do
    putStrLn ""
    putStrLn "Your foes:"
    forM_ [1 .. length ms] showMonsterAtPos
      where
       showMonsterAtPos :: Int -> IO ()
       showMonsterAtPos idx =
           let monster = ms !! (idx - 1)
               in if isMonsterDead monster
                    then putStrLn $ "   " ++ show idx ++ ".  *DEAD*"
                    else showAliveMonster monster
              where
                showAliveMonster :: MonsterInstance -> IO ()
                showAliveMonster (MonsterInstance m) =
                  putStrLn $ "   " ++ show idx ++ ".  (Health="
                             ++ show (health m) ++ ") "
                             ++ show (description m)


------------------------------------------------------------------------------
playerAttack :: Game
playerAttack = do
    liftIO $ putStrLn ""
    liftIO $ putStrLn "Attack style: [s]tab [d]ouble swing [r]oundhouse:"
    liftIO $ putStr "?> "
    !attackType <- liftIO getLine
    case attackType of
      "s" -> performStab
      "d" -> performDoubleSwing
      "r" -> performRoundhouse
      _   -> do
          liftIO $ putStrLn "Wrong attack type. Choose between s,d or r."
          playerAttack

    where
      performStab :: Game
      performStab = do
          (p, m) <- get
          damage <- liftIO $ randomStrength p
          liftIO $ putStrLn $ "You are stabbing a random monster with a power of " 
                 ++ show damage
          !newMonsterPark <- liftIO $ monsterHit m damage
          put (p, newMonsterPark)
          where
            randomStrength p = do
                r <- randVal $ shiftR (pStrength p - 1) 1
                return (r + 2)

      performDoubleSwing :: Game
      performDoubleSwing = do
          (p,m) <- get
          let upperBound = truncate (fromIntegral (pStrength p) / 6 :: Double)
          swingPower <- liftIO $ randVal upperBound
          mIdx <- liftIO $ pickMonster m
          liftIO $ putStrLn $ "Double swing at monster #" ++ show (mIdx + 1)

          --Attack twice
          attackMonsterAt mIdx swingPower
          attackMonsterAt mIdx swingPower

      performRoundhouse :: Game
      performRoundhouse = do
          (p,_) <- get
          let times = 1 + truncate (fromIntegral (pStrength p) / 3 :: Double)
          forM_ [0..times]
            (\_ -> do
               (_,m) <- get
               newPark <- liftIO $ monsterHit m 1
               put (p, newPark))


------------------------------------------------------------------------------
pickMonster :: [MonsterInstance] -> IO Int
pickMonster monsters = do
        putStrLn "Choose the monster to attack: "
        mIdx <- getLine --todo, handle gargabe
        let idx = read mIdx
        if idx >= 1 && idx <= length monsters
            then return $ idx - 1
            else do
                putStrLn "Please choose a valid monster."
                pickMonster monsters


------------------------------------------------------------------------------
attackMonsterAt :: Int -> Int -> Game
attackMonsterAt idx pow = do
        (p,m) <- get
        newPark <- liftIO $ forM [ 0 .. (length m - 1)]
                  (\i -> if i == idx
                        then return (hitInstance (m !! idx) pow)
                        else return (m !! i))
        put (p, newPark)


------------------------------------------------------------------------------
-- | Hit a random monster and return the new monsterPark.
monsterHit :: [MonsterInstance] -> HitPoint -> IO [MonsterInstance]
monsterHit monsters hp = do
    !mIdx <- randomMonster monsters
    monstersHitAux mIdx
    where
      monstersHitAux mIdx =
        forM [0 .. (length monsters - 1)]
        (\i ->
            if i == mIdx
              then return (hitInstance (monsters !! mIdx) hp)
              else return (monsters !! i))


------------------------------------------------------------------------------
-- | Minor change of the original Land of Lisp function.
-- It returns a valid monster idx, i.e. a idx in the
-- monster list corresponding to an alive monster
randomMonster :: [MonsterInstance] -> IO Int
randomMonster monsters = do
    randomIdx <- randVal $ length monsters
    let pickedMonster = monsters !! (randomIdx - 1)
        in if isMonsterDead pickedMonster
             then  randomMonster monsters
             else  return (randomIdx - 1)


------------------------------------------------------------------------------
-- | After the player attack, is monsters' turn.
monstersAttack :: Game
monstersAttack = do
        ws <- get
        newState <- liftIO $ aux ws []
        put newState

  where
    aux :: WorldState -> [MonsterInstance] -> IO WorldState
    aux (p,[]) newPark = return (p, newPark)
    aux (p, MonsterInstance monster : xs) park =
        if isMonsterDead (MonsterInstance monster)
            then aux (p, xs) (park ++ [MonsterInstance monster])
            else do
                (newP, newM) <- attack monster p
                aux (newP, xs) (park ++ [newM])