Permalink
Browse files

consM and removeM

  • Loading branch information...
1 parent 4366879 commit 674d44b2d57b67e84fcdf6e22ac100bc83c75f04 @MedeaMelana committed Sep 3, 2012
Showing with 33 additions and 14 deletions.
  1. +6 −10 Engine.hs
  2. +27 −4 IdList.hs
View
16 Engine.hs
@@ -8,7 +8,7 @@ import Predicates
import Types
import Control.Applicative ((<$>))
-import Control.Monad (forever)
+import Control.Monad (forever, void)
import Control.Monad.Operational
import Control.Monad.Random (RandT, StdGen)
import Control.Monad.State (StateT)
@@ -145,14 +145,13 @@ compileEffect (DrawCard rp) = do
case IdList.toList lib of
[] -> players .^ listEl rp .^ failedCardDraw =: True
(ro, _) : _ -> executeEffect (MoveObject (Library rp, ro) (Hand rp))
-compileEffect (MoveObject rObject@(rFromZone, i) rToZone) = do
- mObject <- lookupObject rObject
+compileEffect (MoveObject (rFromZone, i) rToZone) = do
+ mObject <- IdList.removeM (compileZoneRef rFromZone) i
case mObject of
- Nothing -> return ()
+ Nothing -> return ()
Just object -> do
- tick >>= puts (compileZoneRef rToZone .^ listEl i .^ timestamp)
- compileZoneRef rFromZone ~: IdList.remove i
- compileZoneRef rToZone ~: IdList.cons object
+ t <- tick
+ void (IdList.consM (compileZoneRef rToZone) (set timestamp t object))
compileEffect (ShuffleLibrary rPlayer) = do
let libraryLabel = players .^ listEl rPlayer .^ library
lib <- gets libraryLabel
@@ -166,9 +165,6 @@ tick = do
time ~: succ
return t
-lookupObject :: ObjectRef -> Engine (Maybe Object)
-lookupObject (rz, i) = IdList.get i <$> gets (compileZoneRef rz)
-
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn = sortBy . comparing
View
31 IdList.hs
@@ -1,13 +1,19 @@
+{-# LANGUAGE TypeOperators #-}
+
module IdList
( Id, IdList
, empty, get, set, remove, cons, toList, filter, shuffle
+ , consM, removeM, shuffleM
) where
import Prelude hiding (filter)
import qualified Prelude
import Control.Arrow (second)
import Control.Monad.Random (MonadRandom)
+import Control.Monad.State (MonadState)
+import Data.Label.Pure ((:->))
+import Data.Label.PureM (gets, puts)
import System.Random.Shuffle (shuffleM)
type Id = Int
@@ -30,11 +36,14 @@ set i x (IdList ixs ni) = IdList (map f ixs) ni
| i == i' = (i, x)
| otherwise = ix'
-remove :: Id -> IdList a -> IdList a
-remove i = contents (Prelude.filter (\(i', _) -> i /= i'))
+remove :: Id -> IdList a -> Maybe (a, IdList a)
+remove i l =
+ case get i l of
+ Just x -> Just (x, contents (Prelude.filter (\(i', _) -> i /= i')) l)
+ Nothing -> Nothing
-cons :: a -> IdList a -> IdList a
-cons x (IdList ixs i) = IdList ((i, x) : ixs) (succ i)
+cons :: a -> IdList a -> (Id, IdList a)
+cons x (IdList ixs i) = (i, IdList ((i, x) : ixs) (succ i))
contents :: ([(Id, a)] -> [(Id, b)]) -> IdList a -> IdList b
contents f (IdList ixs i) = IdList (f ixs) i
@@ -49,3 +58,17 @@ shuffle :: MonadRandom m => IdList a -> m (IdList a)
shuffle (IdList ixs ni) = do
ixs' <- shuffleM ixs
return (IdList ixs' ni)
+
+removeM :: MonadState s m => (s :-> IdList a) -> Id -> m (Maybe a)
+removeM label i = do
+ list <- gets label
+ case remove i list of
+ Just (x, list') -> do puts label list'; return (Just x)
+ Nothing -> return Nothing
+
+consM :: MonadState s m => (s :-> IdList a) -> a -> m Id
+consM label x = do
+ list <- gets label
+ let (i, list') = cons x list
+ puts label list'
+ return i

0 comments on commit 674d44b

Please sign in to comment.