Make enumerateUnits a Traversal instad of just a Fold

This commit is contained in:
Emi Simpson 2023-12-06 14:57:43 -05:00
parent 70d8b0d1b0
commit 1f65275d5b
Signed by: Emi
GPG key ID: A12F2C2FFDC3D847

View file

@ -938,16 +938,26 @@ cidsInRange board range locus = board ^.. inner
ofPlayer :: Player -> Traversal' CharacterIdentifier CharacterIdentifier ofPlayer :: Player -> Traversal' CharacterIdentifier CharacterIdentifier
ofPlayer player = filtered (owner >>> (== player)) ofPlayer player = filtered (owner >>> (== player))
lookupCIDs :: Monoid r => [CharacterIdentifier] -> Getting r BoardState (CharacterIdentifier, Character) -- | A traversal over pairs in the form (`CharacterIdentifier`, `Character`)
lookupCIDs chars = to lookupCIDs' . each --
-- On modifying these pairs: Modifications to the `Character` will be applied to the
-- original character, but __changes to the `CharacterIdentifier` will be completely
-- ignored__. This means you /cannot/ use this traversal to change the order of
-- characters, switch characters between players, or anything like that.
enumerateUnits :: Traversal' BoardState (CharacterIdentifier, Character)
enumerateUnits = enumerateUnits'
where where
ixCharacter' :: CharacterIdentifier -> Getting (First Character) BoardState Character enumerateUnits' :: forall f. Applicative f
ixCharacter' cid = ixCharacter cid => ((CharacterIdentifier, Character) -> f (CharacterIdentifier, Character))
lookupCIDs' :: BoardState -> [(CharacterIdentifier, Character)] -> BoardState -> f BoardState
lookupCIDs' boardstate = mapMaybe (liftA2 (fmap . (,)) id ((boardstate ^?) . ixCharacter')) chars enumerateUnits' f = characters fCharacters
where
enumerateUnits :: SimpleFold BoardState (CharacterIdentifier, Character) fUnit :: Player -> Int -> Character -> f Character
enumerateUnits f board = lookupCIDs (board ^.. eachCID) f board fUnit player indx c = snd <$> f ((player, indx), c)
fRoster :: Player -> [Character] -> f [Character]
fRoster player roster = zipWithM (fUnit player) [0..] roster
fCharacters :: PPair [Character] -> f (PPair [Character])
fCharacters (PPair p1 p2) = PPair <$> fRoster Min p1 <*> fRoster Max p2
untappedUnits :: SimpleFold BoardState CharacterIdentifier untappedUnits :: SimpleFold BoardState CharacterIdentifier
untappedUnits = enumerateUnits . filtered (untapped . snd) . _1 untappedUnits = enumerateUnits . filtered (untapped . snd) . _1