module BishBosh.State.TurnsByLogicalColour(
TurnsByLogicalColour(
getNPlies
),
inferNextLogicalColour,
countPlies,
dereference,
fromAssocs,
update,
prepend
) where
import Control.Arrow((&&&), (***))
import Data.Array.IArray((!), (//))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Property.Empty as Property.Empty
import qualified BishBosh.Property.Null as Property.Null
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Reflectable as Property.Reflectable
import qualified BishBosh.Type.Count as Type.Count
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Default
import qualified Data.Foldable
import qualified Data.List.Extra
data TurnsByLogicalColour turn = MkTurnsByLogicalColour {
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour :: Attribute.LogicalColour.ArrayByLogicalColour [turn],
TurnsByLogicalColour turn -> NPlies
getNPlies :: Type.Count.NPlies
}
instance Eq turn => Eq (TurnsByLogicalColour turn) where
MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
aL } == :: TurnsByLogicalColour turn -> TurnsByLogicalColour turn -> Bool
== MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
aR } = ArrayByLogicalColour [turn]
aL ArrayByLogicalColour [turn] -> ArrayByLogicalColour [turn] -> Bool
forall a. Eq a => a -> a -> Bool
== ArrayByLogicalColour [turn]
aR
instance (Read turn, Show turn) => Read (TurnsByLogicalColour turn) where
readsPrec :: NPlies -> ReadS (TurnsByLogicalColour turn)
readsPrec NPlies
precedence String
s = ([(LogicalColour, [turn])] -> TurnsByLogicalColour turn)
-> ([(LogicalColour, [turn])], String)
-> (TurnsByLogicalColour turn, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first [(LogicalColour, [turn])] -> TurnsByLogicalColour turn
forall turn.
Show turn =>
[(LogicalColour, [turn])] -> TurnsByLogicalColour turn
fromAssocs (([(LogicalColour, [turn])], String)
-> (TurnsByLogicalColour turn, String))
-> [([(LogicalColour, [turn])], String)]
-> [(TurnsByLogicalColour turn, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` NPlies -> ReadS [(LogicalColour, [turn])]
forall a. Read a => NPlies -> ReadS a
readsPrec NPlies
precedence String
s
instance Show turn => Show (TurnsByLogicalColour turn) where
showsPrec :: NPlies -> TurnsByLogicalColour turn -> ShowS
showsPrec NPlies
precedence MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour } = NPlies -> [(LogicalColour, [turn])] -> ShowS
forall a. Show a => NPlies -> a -> ShowS
showsPrec NPlies
precedence ([(LogicalColour, [turn])] -> ShowS)
-> [(LogicalColour, [turn])] -> ShowS
forall a b. (a -> b) -> a -> b
$ ArrayByLogicalColour [turn] -> [(LogicalColour, [turn])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs ArrayByLogicalColour [turn]
byLogicalColour
instance Control.DeepSeq.NFData turn => Control.DeepSeq.NFData (TurnsByLogicalColour turn) where
rnf :: TurnsByLogicalColour turn -> ()
rnf MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour } = ArrayByLogicalColour [turn] -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf ArrayByLogicalColour [turn]
byLogicalColour
instance Data.Default.Default (TurnsByLogicalColour turn) where
def :: TurnsByLogicalColour turn
def = MkTurnsByLogicalColour :: forall turn.
ArrayByLogicalColour [turn] -> NPlies -> TurnsByLogicalColour turn
MkTurnsByLogicalColour {
getTurnsByLogicalColour :: ArrayByLogicalColour [turn]
getTurnsByLogicalColour = [[turn]] -> ArrayByLogicalColour [turn]
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([[turn]] -> ArrayByLogicalColour [turn])
-> [[turn]] -> ArrayByLogicalColour [turn]
forall a b. (a -> b) -> a -> b
$ [turn] -> [[turn]]
forall a. a -> [a]
repeat [],
getNPlies :: NPlies
getNPlies = NPlies
0
}
instance Property.Empty.Empty (TurnsByLogicalColour turn) where
empty :: TurnsByLogicalColour turn
empty = TurnsByLogicalColour turn
forall a. Default a => a
Data.Default.def
instance Property.Null.Null (TurnsByLogicalColour turn) where
isNull :: TurnsByLogicalColour turn -> Bool
isNull MkTurnsByLogicalColour { getNPlies :: forall turn. TurnsByLogicalColour turn -> NPlies
getNPlies = NPlies
0 } = Bool
True
isNull TurnsByLogicalColour turn
_ = Bool
False
instance Property.Reflectable.ReflectableOnX turn => Property.Reflectable.ReflectableOnX (TurnsByLogicalColour turn) where
reflectOnX :: TurnsByLogicalColour turn -> TurnsByLogicalColour turn
reflectOnX turnsByLogicalColour :: TurnsByLogicalColour turn
turnsByLogicalColour@MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour } = TurnsByLogicalColour turn
turnsByLogicalColour {
getTurnsByLogicalColour :: ArrayByLogicalColour [turn]
getTurnsByLogicalColour = [(LogicalColour, [turn])] -> ArrayByLogicalColour [turn]
forall (a :: * -> * -> *) e.
IArray a e =>
[(LogicalColour, e)] -> a LogicalColour e
Attribute.LogicalColour.arrayByLogicalColour ([(LogicalColour, [turn])] -> ArrayByLogicalColour [turn])
-> ([(LogicalColour, [turn])] -> [(LogicalColour, [turn])])
-> [(LogicalColour, [turn])]
-> ArrayByLogicalColour [turn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LogicalColour, [turn]) -> (LogicalColour, [turn]))
-> [(LogicalColour, [turn])] -> [(LogicalColour, [turn])]
forall a b. (a -> b) -> [a] -> [b]
map (
LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite (LogicalColour -> LogicalColour)
-> ([turn] -> [turn])
-> (LogicalColour, [turn])
-> (LogicalColour, [turn])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [turn] -> [turn]
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX
) ([(LogicalColour, [turn])] -> ArrayByLogicalColour [turn])
-> [(LogicalColour, [turn])] -> ArrayByLogicalColour [turn]
forall a b. (a -> b) -> a -> b
$ ArrayByLogicalColour [turn] -> [(LogicalColour, [turn])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs ArrayByLogicalColour [turn]
byLogicalColour
}
fromAssocs :: Show turn => [(Attribute.LogicalColour.LogicalColour, [turn])] -> TurnsByLogicalColour turn
fromAssocs :: [(LogicalColour, [turn])] -> TurnsByLogicalColour turn
fromAssocs [(LogicalColour, [turn])]
assocs
| NPlies -> NPlies
forall a b. (Integral a, Num b) => a -> b
fromIntegral (
[(LogicalColour, [turn])] -> NPlies
forall (t :: * -> *) a. Foldable t => t a -> NPlies
length [(LogicalColour, [turn])]
assocs
) NPlies -> NPlies -> Bool
forall a. Eq a => a -> a -> Bool
/= NPlies
Attribute.LogicalColour.nDistinctLogicalColours = Exception -> TurnsByLogicalColour turn
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> TurnsByLogicalColour turn)
-> (String -> Exception) -> String -> TurnsByLogicalColour turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInsufficientData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.TurnsByLogicalColour.fromAssocs:\tboth logical colours must be defined; " (String -> TurnsByLogicalColour turn)
-> String -> TurnsByLogicalColour turn
forall a b. (a -> b) -> a -> b
$ [(LogicalColour, [turn])] -> ShowS
forall a. Show a => a -> ShowS
shows [(LogicalColour, [turn])]
assocs String
"."
| [LogicalColour] -> Bool
forall a. Eq a => [a] -> Bool
Data.List.Extra.anySame ([LogicalColour] -> Bool) -> [LogicalColour] -> Bool
forall a b. (a -> b) -> a -> b
$ ((LogicalColour, [turn]) -> LogicalColour)
-> [(LogicalColour, [turn])] -> [LogicalColour]
forall a b. (a -> b) -> [a] -> [b]
map (LogicalColour, [turn]) -> LogicalColour
forall a b. (a, b) -> a
fst [(LogicalColour, [turn])]
assocs = Exception -> TurnsByLogicalColour turn
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> TurnsByLogicalColour turn)
-> (String -> Exception) -> String -> TurnsByLogicalColour turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkDuplicateData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.TurnsByLogicalColour.fromAssocs:\tduplicates specified; " (String -> TurnsByLogicalColour turn)
-> String -> TurnsByLogicalColour turn
forall a b. (a -> b) -> a -> b
$ [(LogicalColour, [turn])] -> ShowS
forall a. Show a => a -> ShowS
shows [(LogicalColour, [turn])]
assocs String
"."
| (NPlies -> NPlies -> Bool
forall a. Ord a => a -> a -> Bool
> NPlies
1) (NPlies -> Bool)
-> ((NPlies, NPlies) -> NPlies) -> (NPlies, NPlies) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPlies -> NPlies
forall a. Num a => a -> a
abs (NPlies -> NPlies)
-> ((NPlies, NPlies) -> NPlies) -> (NPlies, NPlies) -> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NPlies -> NPlies -> NPlies) -> (NPlies, NPlies) -> NPlies
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((NPlies, NPlies) -> Bool) -> (NPlies, NPlies) -> Bool
forall a b. (a -> b) -> a -> b
$ (
[turn] -> NPlies
forall (t :: * -> *) a. Foldable t => t a -> NPlies
length ([turn] -> NPlies)
-> (Array LogicalColour [turn] -> [turn])
-> Array LogicalColour [turn]
-> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array LogicalColour [turn] -> LogicalColour -> [turn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
Attribute.LogicalColour.White) (Array LogicalColour [turn] -> NPlies)
-> (Array LogicalColour [turn] -> NPlies)
-> Array LogicalColour [turn]
-> (NPlies, NPlies)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [turn] -> NPlies
forall (t :: * -> *) a. Foldable t => t a -> NPlies
length ([turn] -> NPlies)
-> (Array LogicalColour [turn] -> [turn])
-> Array LogicalColour [turn]
-> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array LogicalColour [turn] -> LogicalColour -> [turn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
Attribute.LogicalColour.Black)
) Array LogicalColour [turn]
byLogicalColour = Exception -> TurnsByLogicalColour turn
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> TurnsByLogicalColour turn)
-> (String -> Exception) -> String -> TurnsByLogicalColour turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.TurnsByLogicalColour.fromAssocs:\tany difference in the number of turns taken by each player, can't exceed one " (String -> TurnsByLogicalColour turn)
-> String -> TurnsByLogicalColour turn
forall a b. (a -> b) -> a -> b
$ [(LogicalColour, [turn])] -> ShowS
forall a. Show a => a -> ShowS
shows [(LogicalColour, [turn])]
assocs String
"."
| Bool
otherwise = TurnsByLogicalColour turn
turnsByLogicalColour
where
byLogicalColour :: Array LogicalColour [turn]
byLogicalColour = [(LogicalColour, [turn])] -> Array LogicalColour [turn]
forall (a :: * -> * -> *) e.
IArray a e =>
[(LogicalColour, e)] -> a LogicalColour e
Attribute.LogicalColour.arrayByLogicalColour [(LogicalColour, [turn])]
assocs
turnsByLogicalColour :: TurnsByLogicalColour turn
turnsByLogicalColour = MkTurnsByLogicalColour :: forall turn.
ArrayByLogicalColour [turn] -> NPlies -> TurnsByLogicalColour turn
MkTurnsByLogicalColour {
getTurnsByLogicalColour :: Array LogicalColour [turn]
getTurnsByLogicalColour = Array LogicalColour [turn]
byLogicalColour,
getNPlies :: NPlies
getNPlies = TurnsByLogicalColour turn -> NPlies
forall turn. TurnsByLogicalColour turn -> NPlies
countPlies TurnsByLogicalColour turn
turnsByLogicalColour
}
inferNextLogicalColour :: TurnsByLogicalColour turn -> Attribute.LogicalColour.LogicalColour
inferNextLogicalColour :: TurnsByLogicalColour turn -> LogicalColour
inferNextLogicalColour MkTurnsByLogicalColour { getNPlies :: forall turn. TurnsByLogicalColour turn -> NPlies
getNPlies = NPlies
nPlies }
| NPlies -> Bool
forall a. Integral a => a -> Bool
even NPlies
nPlies = LogicalColour
Attribute.LogicalColour.White
| Bool
otherwise = LogicalColour
Attribute.LogicalColour.Black
countPlies :: TurnsByLogicalColour turn -> Type.Count.NPlies
countPlies :: TurnsByLogicalColour turn -> NPlies
countPlies MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour } = NPlies -> NPlies
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPlies -> NPlies) -> NPlies -> NPlies
forall a b. (a -> b) -> a -> b
$ (NPlies -> [turn] -> NPlies)
-> NPlies -> ArrayByLogicalColour [turn] -> NPlies
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (\NPlies
acc -> (NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
+ NPlies
acc) (NPlies -> NPlies) -> ([turn] -> NPlies) -> [turn] -> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [turn] -> NPlies
forall (t :: * -> *) a. Foldable t => t a -> NPlies
length) NPlies
0 ArrayByLogicalColour [turn]
byLogicalColour
dereference :: Attribute.LogicalColour.LogicalColour -> TurnsByLogicalColour turn -> [turn]
dereference :: LogicalColour -> TurnsByLogicalColour turn -> [turn]
dereference LogicalColour
logicalColour MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour } = ArrayByLogicalColour [turn]
byLogicalColour ArrayByLogicalColour [turn] -> LogicalColour -> [turn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour
update :: TurnsByLogicalColour turn -> [(Attribute.LogicalColour.LogicalColour, [turn])] -> TurnsByLogicalColour turn
update :: TurnsByLogicalColour turn
-> [(LogicalColour, [turn])] -> TurnsByLogicalColour turn
update MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour } [(LogicalColour, [turn])]
assocs = TurnsByLogicalColour turn
turnsByLogicalColour where
turnsByLogicalColour :: TurnsByLogicalColour turn
turnsByLogicalColour = MkTurnsByLogicalColour :: forall turn.
ArrayByLogicalColour [turn] -> NPlies -> TurnsByLogicalColour turn
MkTurnsByLogicalColour {
getTurnsByLogicalColour :: ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour ArrayByLogicalColour [turn]
-> [(LogicalColour, [turn])] -> ArrayByLogicalColour [turn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [(LogicalColour, [turn])]
assocs,
getNPlies :: NPlies
getNPlies = TurnsByLogicalColour turn -> NPlies
forall turn. TurnsByLogicalColour turn -> NPlies
countPlies TurnsByLogicalColour turn
turnsByLogicalColour
}
type Transformation turn = TurnsByLogicalColour turn -> TurnsByLogicalColour turn
prepend :: Attribute.LogicalColour.LogicalColour -> turn -> Transformation turn
prepend :: LogicalColour -> turn -> Transformation turn
prepend LogicalColour
logicalColour turn
turn MkTurnsByLogicalColour {
getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour,
getNPlies :: forall turn. TurnsByLogicalColour turn -> NPlies
getNPlies = NPlies
nPlies
} = MkTurnsByLogicalColour :: forall turn.
ArrayByLogicalColour [turn] -> NPlies -> TurnsByLogicalColour turn
MkTurnsByLogicalColour {
getTurnsByLogicalColour :: ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour ArrayByLogicalColour [turn]
-> [(LogicalColour, [turn])] -> ArrayByLogicalColour [turn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [
(
LogicalColour
logicalColour,
turn
turn turn -> [turn] -> [turn]
forall a. a -> [a] -> [a]
: ArrayByLogicalColour [turn]
byLogicalColour ArrayByLogicalColour [turn] -> LogicalColour -> [turn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour
)
],
getNPlies :: NPlies
getNPlies = NPlies -> NPlies
forall a. Enum a => a -> a
succ NPlies
nPlies
}