Skip to content
Browse files

Moved Target-related functions to new module Magic.Target

  • Loading branch information...
1 parent 62c1c10 commit 28d57fd90dcc943c360d38eaddc51085e8819127 @MedeaMelana committed Nov 8, 2012
Showing with 72 additions and 46 deletions.
  1. +1 −0 Magic.cabal
  2. +1 −45 Magic/Core.hs
  3. +1 −0 Magic/Engine.hs
  4. +1 −1 Magic/M12.hs
  5. +68 −0 Magic/Target.hs
View
1 Magic.cabal
@@ -23,6 +23,7 @@ library
Magic.M12,
Magic.ObjectTypes,
Magic.Predicates,
+ Magic.Target
Magic.Types,
Magic.Utils
-- other-modules:
View
46 Magic/Core.hs
@@ -15,7 +15,7 @@ import Magic.Types
import Control.Applicative
import qualified Control.Monad.Operational as Operational
-import Control.Monad (forM, filterM)
+import Control.Monad (forM)
import Control.Monad.Reader (runReaderT)
import qualified Control.Monad.State as State
import Control.Monad.Trans (lift)
@@ -34,50 +34,6 @@ compileZoneRef z =
Exile -> exile
Command -> command
-evaluateTargetList :: TargetList Target a -> ([Target], a)
-evaluateTargetList (Nil x) = ([], x)
-evaluateTargetList (Snoc xs t) = (ts ++ [t], f t) where (ts, f) = evaluateTargetList xs
-evaluateTargetList (Test f _ xs) = (ts, f x) where (ts, x) = evaluateTargetList xs
-
-singleTarget :: TargetList () Target
-singleTarget = Snoc (Nil id) ()
-
-infixl 4 <?>
-(<?>) :: TargetList t a -> (a -> View Bool) -> TargetList t a
-xs <?> ok = Test id ok xs
-
-askTargets :: forall a. ([Target] -> Magic Target) -> [Target] -> TargetList () a -> Magic (TargetList Target a)
-askTargets choose = askTargets' (const (return True))
- where
- askTargets' :: forall b. (b -> View Bool) -> [Target] -> TargetList () b -> Magic (TargetList Target b)
- askTargets' ok ts scheme =
- case scheme of
- Nil x -> return (Nil x)
- Snoc xs () -> do
- xs' <- askTargets choose ts xs
- let (_, f) = evaluateTargetList xs'
- eligibleTargets <- view (filterM (ok . f) ts)
- chosen <- choose eligibleTargets
- return (Snoc xs' chosen)
- Test f ok' scheme' -> do
- z <- askTargets' (\x -> (&&) <$> ok (f x) <*> ok' x) ts scheme'
- return (f <$> z)
-
-askMagicTargets :: PlayerRef -> TargetList () a -> Magic (TargetList Target a)
-askMagicTargets p ts = do
- ats <- allTargets
- askTargets (lift . Operational.singleton . AskTarget p) ats ts
-
-allTargets :: Magic [Target]
-allTargets = do
- ps <- IdList.ids <$> asks players
- let zrs = [Exile, Battlefield, Stack, Command] ++
- [ z p | z <- [Library, Hand, Graveyard], p <- ps ]
- oss <- forM zrs $ \zr -> do
- os <- IdList.ids <$> asks (compileZoneRef zr)
- return (map (\o -> (zr, o)) os)
- return (map TargetPlayer ps ++ map TargetObject (concat oss))
-
allObjects :: Magic [(ObjectRef, Object)]
allObjects = do
ps <- IdList.ids <$> asks players
View
1 Magic/Engine.hs
@@ -9,6 +9,7 @@ import qualified Magic.IdList as IdList
import Magic.Labels
import Magic.ObjectTypes
import Magic.Predicates
+import Magic.Target
import Magic.Types
import Magic.Utils hiding (object)
View
2 Magic/M12.hs
@@ -2,9 +2,9 @@
module Magic.M12 where
-import Magic.Core
import Magic.Types
import Magic.ObjectTypes
+import Magic.Target
import Magic.Utils
import Control.Applicative
View
68 Magic/Target.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE RankNTypes #-}
+
+module Magic.Target (
+ -- * Types
+ TargetList(..), Target(..),
+
+ -- * Producing target lists
+ singleTarget, (<?>),
+
+ -- * Compiling target lists
+ evaluateTargetList, askMagicTargets
+ ) where
+
+import qualified Magic.IdList as IdList
+import Magic.Core
+import Magic.Types
+
+import Control.Applicative
+import Control.Monad (forM, filterM)
+import qualified Control.Monad.Operational as Operational
+import Control.Monad.Trans (lift)
+import Data.Label.PureM (asks)
+
+
+evaluateTargetList :: TargetList Target a -> ([Target], a)
+evaluateTargetList (Nil x) = ([], x)
+evaluateTargetList (Snoc xs t) = (ts ++ [t], f t) where (ts, f) = evaluateTargetList xs
+evaluateTargetList (Test f _ xs) = (ts, f x) where (ts, x) = evaluateTargetList xs
+
+singleTarget :: TargetList () Target
+singleTarget = Snoc (Nil id) ()
+
+infixl 4 <?>
+(<?>) :: TargetList t a -> (a -> View Bool) -> TargetList t a
+xs <?> ok = Test id ok xs
+
+askTargets :: forall a. ([Target] -> Magic Target) -> [Target] -> TargetList () a -> Magic (TargetList Target a)
+askTargets choose = askTargets' (const (return True))
+ where
+ askTargets' :: forall b. (b -> View Bool) -> [Target] -> TargetList () b -> Magic (TargetList Target b)
+ askTargets' ok ts scheme =
+ case scheme of
+ Nil x -> return (Nil x)
+ Snoc xs () -> do
+ xs' <- askTargets choose ts xs
+ let (_, f) = evaluateTargetList xs'
+ eligibleTargets <- view (filterM (ok . f) ts)
+ chosen <- choose eligibleTargets
+ return (Snoc xs' chosen)
+ Test f ok' scheme' -> do
+ z <- askTargets' (\x -> (&&) <$> ok (f x) <*> ok' x) ts scheme'
+ return (f <$> z)
+
+askMagicTargets :: PlayerRef -> TargetList () a -> Magic (TargetList Target a)
+askMagicTargets p ts = do
+ ats <- allTargets
+ askTargets (lift . Operational.singleton . AskTarget p) ats ts
+
+allTargets :: Magic [Target]
+allTargets = do
+ ps <- IdList.ids <$> asks players
+ let zrs = [Exile, Battlefield, Stack, Command] ++
+ [ z p | z <- [Library, Hand, Graveyard], p <- ps ]
+ oss <- forM zrs $ \zr -> do
+ os <- IdList.ids <$> asks (compileZoneRef zr)
+ return (map (\o -> (zr, o)) os)
+ return (map TargetPlayer ps ++ map TargetObject (concat oss))
+

0 comments on commit 28d57fd

Please sign in to comment.
Something went wrong with that request. Please try again.