module BishBosh.Time.GameClock(
GameClock(
deconstruct
),
showsElapsedTimes
) where
import Control.Arrow((***))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Property.ShowFloat as Property.ShowFloat
import qualified BishBosh.Property.SelfValidating as Property.SelfValidating
import qualified BishBosh.Property.Switchable as Property.Switchable
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Time.StopWatch as Time.StopWatch
import qualified BishBosh.Type.Count as Type.Count
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Default
import qualified Data.Foldable
newtype GameClock = MkGameClock {
GameClock -> ArrayByLogicalColour StopWatch
deconstruct :: Attribute.LogicalColour.ArrayByLogicalColour Time.StopWatch.StopWatch
}
instance Property.Switchable.Switchable GameClock where
on :: IO GameClock
on = (StopWatch -> GameClock) -> IO StopWatch -> IO GameClock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
ArrayByLogicalColour StopWatch -> GameClock
MkGameClock (ArrayByLogicalColour StopWatch -> GameClock)
-> (StopWatch -> ArrayByLogicalColour StopWatch)
-> StopWatch
-> GameClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StopWatch] -> ArrayByLogicalColour StopWatch
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([StopWatch] -> ArrayByLogicalColour StopWatch)
-> (StopWatch -> [StopWatch])
-> StopWatch
-> ArrayByLogicalColour StopWatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
StopWatch
forall a. Default a => a
Data.Default.def StopWatch -> [StopWatch] -> [StopWatch]
forall a. a -> [a] -> [a]
:
) ([StopWatch] -> [StopWatch])
-> (StopWatch -> [StopWatch]) -> StopWatch -> [StopWatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StopWatch -> [StopWatch]
forall (m :: * -> *) a. Monad m => a -> m a
return
) IO StopWatch
forall a. Switchable a => IO a
Property.Switchable.on
toggle :: GameClock -> IO GameClock
toggle GameClock
gameClock
| errorMessages :: [String]
errorMessages@(String
_ : [String]
_) <- GameClock -> [String]
forall a. SelfValidating a => a -> [String]
Property.SelfValidating.findInvalidity GameClock
gameClock = Exception -> IO GameClock
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (Exception -> IO GameClock)
-> (String -> Exception) -> String -> IO GameClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInsufficientData (String -> Exception) -> (String -> String) -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"Duel.Process.Intermediary.initialise:\tinvalid gameClock; " (String -> IO GameClock) -> String -> IO GameClock
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Show a => a -> String
show [String]
errorMessages
| Bool
otherwise = ([StopWatch] -> GameClock) -> IO [StopWatch] -> IO GameClock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
ArrayByLogicalColour StopWatch -> GameClock
MkGameClock (ArrayByLogicalColour StopWatch -> GameClock)
-> ([StopWatch] -> ArrayByLogicalColour StopWatch)
-> [StopWatch]
-> GameClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StopWatch] -> ArrayByLogicalColour StopWatch
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour
) (IO [StopWatch] -> IO GameClock)
-> (ArrayByLogicalColour StopWatch -> IO [StopWatch])
-> ArrayByLogicalColour StopWatch
-> IO GameClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StopWatch -> IO StopWatch) -> [StopWatch] -> IO [StopWatch]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM StopWatch -> IO StopWatch
forall a. Switchable a => a -> IO a
Property.Switchable.toggle ([StopWatch] -> IO [StopWatch])
-> (ArrayByLogicalColour StopWatch -> [StopWatch])
-> ArrayByLogicalColour StopWatch
-> IO [StopWatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByLogicalColour StopWatch -> [StopWatch]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems (ArrayByLogicalColour StopWatch -> IO GameClock)
-> ArrayByLogicalColour StopWatch -> IO GameClock
forall a b. (a -> b) -> a -> b
$ GameClock -> ArrayByLogicalColour StopWatch
deconstruct GameClock
gameClock
switchOff :: GameClock -> IO GameClock
switchOff = ([StopWatch] -> GameClock) -> IO [StopWatch] -> IO GameClock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
ArrayByLogicalColour StopWatch -> GameClock
MkGameClock (ArrayByLogicalColour StopWatch -> GameClock)
-> ([StopWatch] -> ArrayByLogicalColour StopWatch)
-> [StopWatch]
-> GameClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StopWatch] -> ArrayByLogicalColour StopWatch
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour
) (IO [StopWatch] -> IO GameClock)
-> (GameClock -> IO [StopWatch]) -> GameClock -> IO GameClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StopWatch -> IO StopWatch) -> [StopWatch] -> IO [StopWatch]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM StopWatch -> IO StopWatch
forall a. Switchable a => a -> IO a
Property.Switchable.switchOff ([StopWatch] -> IO [StopWatch])
-> (GameClock -> [StopWatch]) -> GameClock -> IO [StopWatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByLogicalColour StopWatch -> [StopWatch]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems (ArrayByLogicalColour StopWatch -> [StopWatch])
-> (GameClock -> ArrayByLogicalColour StopWatch)
-> GameClock
-> [StopWatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameClock -> ArrayByLogicalColour StopWatch
deconstruct
isOn :: GameClock -> Bool
isOn = (StopWatch -> Bool) -> ArrayByLogicalColour StopWatch -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.any StopWatch -> Bool
forall a. Switchable a => a -> Bool
Property.Switchable.isOn (ArrayByLogicalColour StopWatch -> Bool)
-> (GameClock -> ArrayByLogicalColour StopWatch)
-> GameClock
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameClock -> ArrayByLogicalColour StopWatch
deconstruct
isOff :: GameClock -> Bool
isOff = (StopWatch -> Bool) -> ArrayByLogicalColour StopWatch -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.all StopWatch -> Bool
forall a. Switchable a => a -> Bool
Property.Switchable.isOff (ArrayByLogicalColour StopWatch -> Bool)
-> (GameClock -> ArrayByLogicalColour StopWatch)
-> GameClock
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameClock -> ArrayByLogicalColour StopWatch
deconstruct
instance Property.SelfValidating.SelfValidating GameClock where
findInvalidity :: GameClock -> [String]
findInvalidity = [(GameClock -> Bool, String)] -> GameClock -> [String]
forall selfValidator.
[(selfValidator -> Bool, String)] -> selfValidator -> [String]
Property.SelfValidating.findErrors [
((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (Int -> Bool) -> (GameClock -> Int) -> GameClock -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StopWatch] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([StopWatch] -> Int)
-> (GameClock -> [StopWatch]) -> GameClock -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StopWatch -> Bool) -> [StopWatch] -> [StopWatch]
forall a. (a -> Bool) -> [a] -> [a]
filter StopWatch -> Bool
forall a. Switchable a => a -> Bool
Property.Switchable.isOn ([StopWatch] -> [StopWatch])
-> (GameClock -> [StopWatch]) -> GameClock -> [StopWatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByLogicalColour StopWatch -> [StopWatch]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems (ArrayByLogicalColour StopWatch -> [StopWatch])
-> (GameClock -> ArrayByLogicalColour StopWatch)
-> GameClock
-> [StopWatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameClock -> ArrayByLogicalColour StopWatch
deconstruct, String
"The two stop-watches must be in opposite states")
]
showsElapsedTimes :: Type.Count.NDecimalDigits -> GameClock -> IO ShowS
showsElapsedTimes :: Int -> GameClock -> IO (String -> String)
showsElapsedTimes Int
nDecimalDigits = (GameClock -> String -> String)
-> IO GameClock -> IO (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
[(String, String -> String)] -> String -> String
Text.ShowList.showsAssociationList' ([(String, String -> String)] -> String -> String)
-> (GameClock -> [(String, String -> String)])
-> GameClock
-> String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LogicalColour, StopWatch) -> (String, String -> String))
-> [(LogicalColour, StopWatch)] -> [(String, String -> String)]
forall a b. (a -> b) -> [a] -> [b]
map (
LogicalColour -> String
forall a. Show a => a -> String
show (LogicalColour -> String)
-> (StopWatch -> String -> String)
-> (LogicalColour, StopWatch)
-> (String, String -> String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Int -> StopWatch -> String -> String
forall a. ShowFloat a => Int -> a -> String -> String
Property.ShowFloat.showsFloatToN Int
nDecimalDigits
) ([(LogicalColour, StopWatch)] -> [(String, String -> String)])
-> (GameClock -> [(LogicalColour, StopWatch)])
-> GameClock
-> [(String, String -> String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByLogicalColour StopWatch -> [(LogicalColour, StopWatch)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (ArrayByLogicalColour StopWatch -> [(LogicalColour, StopWatch)])
-> (GameClock -> ArrayByLogicalColour StopWatch)
-> GameClock
-> [(LogicalColour, StopWatch)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameClock -> ArrayByLogicalColour StopWatch
deconstruct
) (IO GameClock -> IO (String -> String))
-> (GameClock -> IO GameClock)
-> GameClock
-> IO (String -> String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameClock -> IO GameClock
forall a. Switchable a => a -> IO a
Property.Switchable.switchOff