{-# LANGUAGE LambdaCase #-}
module BishBosh.Rule.Result(
Result(
),
findMaybeVictor,
mkResult,
isDraw
) where
import qualified BishBosh.Colour.LogicalColour as Colour.LogicalColour
import qualified BishBosh.Property.FixedMembership as Property.FixedMembership
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified Control.DeepSeq
import qualified Data.List.Extra
data Result
= VictoryBy Colour.LogicalColour.LogicalColour
| Draw
deriving Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq
instance Control.DeepSeq.NFData Result where
rnf :: Result -> ()
rnf (VictoryBy LogicalColour
logicalColour) = LogicalColour -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf LogicalColour
logicalColour
rnf Result
Draw = ()
instance Show Result where
showsPrec :: Int -> Result -> ShowS
showsPrec Int
_ = (
\(ShowS
showsWhiteResult, ShowS
showsBlackResult) -> ShowS
showsWhiteResult ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'-' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showsBlackResult
) ((ShowS, ShowS) -> ShowS)
-> (Result -> (ShowS, ShowS)) -> Result -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
VictoryBy LogicalColour
Colour.LogicalColour.Black -> (ShowS
lose, ShowS
win)
VictoryBy LogicalColour
_ -> (ShowS
win, ShowS
lose)
Result
_ -> (ShowS
draw, ShowS
draw)
where
lose :: ShowS
lose = Char -> ShowS
showChar Char
'0'
win :: ShowS
win = Char -> ShowS
showChar Char
'1'
draw :: ShowS
draw = String -> ShowS
showString String
"1/2"
instance Read Result where
readsPrec :: Int -> ReadS Result
readsPrec Int
_ String
s = case ShowS
Data.List.Extra.trimStart String
s of
Char
'0' : Char
'-' : Char
'1' : String
remainder -> [(LogicalColour -> Result
VictoryBy LogicalColour
Colour.LogicalColour.Black, String
remainder)]
Char
'1' : Char
'-' : Char
'0' : String
remainder -> [(LogicalColour -> Result
VictoryBy LogicalColour
Colour.LogicalColour.White, String
remainder)]
Char
'1' : Char
'/' : Char
'2' : Char
'-' : Char
'1' : Char
'/' : Char
'2' : String
remainder -> [(Result
Draw, String
remainder)]
String
_ -> []
instance Property.Opposable.Opposable Result where
getOpposite :: Result -> Result
getOpposite (VictoryBy LogicalColour
logicalColour) = LogicalColour -> Result
VictoryBy (LogicalColour -> Result) -> LogicalColour -> Result
forall a b. (a -> b) -> a -> b
$ LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
getOpposite Result
_ = Result
Draw
instance Property.FixedMembership.FixedMembership Result where
members :: [Result]
members = Result
Draw Result -> [Result] -> [Result]
forall a. a -> [a] -> [a]
: (LogicalColour -> Result) -> [LogicalColour] -> [Result]
forall a b. (a -> b) -> [a] -> [b]
map LogicalColour -> Result
VictoryBy [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
mkResult :: Maybe Colour.LogicalColour.LogicalColour -> Result
mkResult :: Maybe LogicalColour -> Result
mkResult (Just LogicalColour
logicalColour) = LogicalColour -> Result
VictoryBy LogicalColour
logicalColour
mkResult Maybe LogicalColour
_ = Result
Draw
isDraw :: Result -> Bool
isDraw :: Result -> Bool
isDraw Result
Draw = Bool
True
isDraw Result
_ = Bool
False
findMaybeVictor :: Result -> Maybe Colour.LogicalColour.LogicalColour
findMaybeVictor :: Result -> Maybe LogicalColour
findMaybeVictor (VictoryBy LogicalColour
logicalColour) = LogicalColour -> Maybe LogicalColour
forall a. a -> Maybe a
Just LogicalColour
logicalColour
findMaybeVictor Result
_ = Maybe LogicalColour
forall a. Maybe a
Nothing