Action.hs

{-# LANGUAGE RankNTypes, FlexibleContexts #-}

{-
  This module is part of Antisplice.
  Copyleft (c) 2014 Marvin Cohrs

  All wrongs reversed. Sharing is an act of love, not crime.
  Please share Antisplice with everyone you like.

  Antisplice is free software: you can redistribute it and/or modify
  it under the terms of the GNU Affero General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  Antisplice is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  GNU Affero General Public License for more details.

  You should have received a copy of the GNU Affero General Public License
  along with Antisplice. If not, see <http://www.gnu.org/licenses/>.
-}

-- | Provides brick-by-brick composition for general actions, which may be used for skills and gates.
module Game.Antisplice.Action where

import Control.Monad
import Data.Monoid
import Game.Antisplice.Monad.Dungeon
import Game.Antisplice.Rooms
import Game.Antisplice.Stats
import Game.Antisplice.Utils.Counter
import Game.Antisplice.Utils.None

-- | A typeclass for all action types carrying an execution condition.
class IsAction a where
  -- | Conjunction _with_ short evaluation.
  infixl 6 #&&
  (#&&) :: a -> a -> a
  -- | Disjunction _with_ short evaulation.
  infixl 6 #||
  (#||) :: a -> a -> a
  -- | Conjunction _without_ short evaluation.
  infixl 6 !&&
  (!&&) :: a -> a -> a
  -- | Disjunction _without_ short evaluation.
  infixl 6 !||
  (!||) :: a -> a -> a

instance Monoid PrerequisiteBox where
  mempty = none
  p `mappend` q = Prerequisite $ do
    a <- runPrerequisite p
    b <- runPrerequisite q
    return (a && b)

instance IsAction PrerequisiteBox where
  p #&& q = Prerequisite $ do
    a <- runPrerequisite p
    if a then runPrerequisite q
         else return False
  p #|| q = Prerequisite $ do
    a <- runPrerequisite p
    if a then return True
         else runPrerequisite q
  p !&& q = p <> q
  p !|| q = Prerequisite $ do
    a <- runPrerequisite p
    b <- runPrerequisite q
    return (a || b)

-- | A general action, which may be used for skills and gates.
data Action = Action { askAction :: Prerequisite, runAction :: Handler }

instance None Action where
  none = Action (return True) noneM

instance Monoid Action where
  mempty = none
  a `mappend` b = Action (runPrerequisite $ Prerequisite (askAction a) <> Prerequisite (askAction b)) (runAction a >> runAction b)

instance IsAction Action where
  a #&& b = Action
    (runPrerequisite $ Prerequisite (askAction a) #&& Prerequisite (askAction b))
    (runAction a >> runAction b)
  a #|| b = Action
    (runPrerequisite $ Prerequisite (askAction a) #|| Prerequisite (askAction b))
    (askAction a >>= \q -> if q then runAction a else runAction b)
  a !&& b = a <> b
  a !|| b = Action
    (runPrerequisite $ Prerequisite (askAction a) !|| Prerequisite (askAction b))
    (askAction a >>= \q -> askAction b >> if q then runAction a else runAction b)

-- | An action that is run /after/ a specific event.
newtype ActionAfter = ActionAfter { runActionAfter :: Action }
-- | An action that is run /before/ a specific event.
newtype ActionBefore = ActionBefore { runActionBefore :: Action }

instance None ActionAfter where
  none = ActionAfter none
instance None ActionBefore where
  none = ActionBefore none

instance Monoid ActionAfter where
  mempty = none
  a `mappend` b = ActionAfter $ runActionAfter a <> runActionAfter b
instance Monoid ActionBefore where
  mempty = none
  a `mappend` b = ActionBefore $ runActionBefore a <> runActionBefore b

instance IsAction ActionAfter where
  a #&& b = ActionAfter $ runActionAfter a #&& runActionAfter b
  a #|| b = ActionAfter $ runActionAfter a #|| runActionAfter b
  a !&& b = ActionAfter $ runActionAfter a !&& runActionAfter b
  a !|| b = ActionAfter $ runActionAfter a !|| runActionAfter b
instance IsAction ActionBefore where
  a #&& b = ActionBefore $ runActionBefore a #&& runActionBefore b
  a #|| b = ActionBefore $ runActionBefore a #|| runActionBefore b
  a !&& b = ActionBefore $ runActionBefore a !&& runActionBefore b
  a !|| b = ActionBefore $ runActionBefore a !|| runActionBefore b

-- | Use for actions that consume a given currency.
consumeCurrencyA :: CurrencyId -> Int -> Action
consumeCurrencyA c h = Action
  (do
      c1 <- getCurrency c
      return (c1 > h))
  (modifyCurrency c (subtract h))

-- | Deal damage to opponent
dealDamageA :: ChattyDungeonM Int -> Action
dealDamageA m = Action (return True) (dealDamage =<< m)

-- | Use for actions that require a cooldown time.
implyCooldownA :: MonadCounter m => Integer -> m Action
implyCooldownA ms = do
  cid <- liftM CooldownId countOn
  return (Action
    (liftM not $ getCooldown cid)
    (setCooldown cid True >> schedule ms (setCooldown cid False)))

-- | Use for actions that suffer from global cooldown.
implyGlobalCooldownA :: Action
implyGlobalCooldownA = Action
  (liftM not $ getCooldown GlobalCooldown)
  (do
    setCooldown GlobalCooldown True
    cd <- calcStat CooldownDuration
    schedule (fromIntegral cd) $ setCooldown GlobalCooldown False)