{-
	Copyright (C) 2021 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	Defines a stop-watch for use by a single player; so two independent instances will be required to construct a game-clock.
-}

module BishBosh.Time.StopWatch(
-- * Types
-- ** Data-types
	StopWatch(
--		MkStopWatch,
--		deconstruct
	),
-- * Functions
	getElapsedTime,
-- ** Constructor
	mkStoppedWatch
 ) where

import			Control.Arrow((&&&), (|||))
import qualified	BishBosh.Data.Exception		as Data.Exception
import qualified	BishBosh.Property.ShowFloat	as Property.ShowFloat
import qualified	BishBosh.Property.Switchable	as Property.Switchable
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Default
import qualified	Data.Time.Clock

-- | The watch is either running & records the time at which it was started, or is stopped & records the elapsed duration.
newtype StopWatch	= MkStopWatch {
	StopWatch -> Either UTCTime NominalDiffTime
deconstruct	:: Either Data.Time.Clock.UTCTime Data.Time.Clock.NominalDiffTime	-- ^ Either the start-time or the previously elapsed duration.
} deriving (StopWatch -> StopWatch -> Bool
(StopWatch -> StopWatch -> Bool)
-> (StopWatch -> StopWatch -> Bool) -> Eq StopWatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopWatch -> StopWatch -> Bool
$c/= :: StopWatch -> StopWatch -> Bool
== :: StopWatch -> StopWatch -> Bool
$c== :: StopWatch -> StopWatch -> Bool
Eq, Int -> StopWatch -> ShowS
[StopWatch] -> ShowS
StopWatch -> String
(Int -> StopWatch -> ShowS)
-> (StopWatch -> String)
-> ([StopWatch] -> ShowS)
-> Show StopWatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopWatch] -> ShowS
$cshowList :: [StopWatch] -> ShowS
show :: StopWatch -> String
$cshow :: StopWatch -> String
showsPrec :: Int -> StopWatch -> ShowS
$cshowsPrec :: Int -> StopWatch -> ShowS
Show)

instance Control.DeepSeq.NFData StopWatch where
	rnf :: StopWatch -> ()
rnf MkStopWatch { deconstruct :: StopWatch -> Either UTCTime NominalDiffTime
deconstruct = Either UTCTime NominalDiffTime
e }	= UTCTime -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (UTCTime -> ())
-> (NominalDiffTime -> ()) -> Either UTCTime NominalDiffTime -> ()
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| NominalDiffTime -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (Either UTCTime NominalDiffTime -> ())
-> Either UTCTime NominalDiffTime -> ()
forall a b. (a -> b) -> a -> b
$ Either UTCTime NominalDiffTime
e

instance Data.Default.Default StopWatch where
	def :: StopWatch
def	= NominalDiffTime -> StopWatch
mkStoppedWatch NominalDiffTime
0

instance Property.ShowFloat.ShowFloat StopWatch where
	showsFloat :: (Double -> ShowS) -> StopWatch -> ShowS
showsFloat Double -> ShowS
fromDouble	= Double -> ShowS
fromDouble (Double -> ShowS) -> (StopWatch -> Double) -> StopWatch -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StopWatch -> Double
forall f. Fractional f => StopWatch -> f
getElapsedTime

instance Property.Switchable.Switchable StopWatch where
	on :: IO StopWatch
on	= StopWatch -> IO StopWatch
forall a. Switchable a => a -> IO a
Property.Switchable.toggle StopWatch
forall a. Default a => a
Data.Default.def

	toggle :: StopWatch -> IO StopWatch
toggle MkStopWatch { deconstruct :: StopWatch -> Either UTCTime NominalDiffTime
deconstruct = Either UTCTime NominalDiffTime
e }	= do
		(UTCTime -> NominalDiffTime
diffUTCTime', NominalDiffTime -> UTCTime
addUTCTime')	<- (UTCTime
 -> (UTCTime -> NominalDiffTime, NominalDiffTime -> UTCTime))
-> IO UTCTime
-> IO (UTCTime -> NominalDiffTime, NominalDiffTime -> UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UTCTime -> UTCTime -> NominalDiffTime
Data.Time.Clock.diffUTCTime (UTCTime -> UTCTime -> NominalDiffTime)
-> (UTCTime -> NominalDiffTime -> UTCTime)
-> UTCTime
-> (UTCTime -> NominalDiffTime, NominalDiffTime -> UTCTime)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (NominalDiffTime -> UTCTime -> UTCTime)
-> UTCTime -> NominalDiffTime -> UTCTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip NominalDiffTime -> UTCTime -> UTCTime
Data.Time.Clock.addUTCTime) IO UTCTime
Data.Time.Clock.getCurrentTime	-- Partially apply the functions to the current time.

		StopWatch -> IO StopWatch
forall (m :: * -> *) a. Monad m => a -> m a
return {-to IO-monad-} (StopWatch -> IO StopWatch)
-> (Either UTCTime NominalDiffTime -> StopWatch)
-> Either UTCTime NominalDiffTime
-> IO StopWatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either UTCTime NominalDiffTime -> StopWatch
MkStopWatch (Either UTCTime NominalDiffTime -> IO StopWatch)
-> Either UTCTime NominalDiffTime -> IO StopWatch
forall a b. (a -> b) -> a -> b
$ (NominalDiffTime -> Either UTCTime NominalDiffTime
forall a b. b -> Either a b
Right (NominalDiffTime -> Either UTCTime NominalDiffTime)
-> (UTCTime -> NominalDiffTime)
-> UTCTime
-> Either UTCTime NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> NominalDiffTime
diffUTCTime' (UTCTime -> Either UTCTime NominalDiffTime)
-> (NominalDiffTime -> Either UTCTime NominalDiffTime)
-> Either UTCTime NominalDiffTime
-> Either UTCTime NominalDiffTime
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| UTCTime -> Either UTCTime NominalDiffTime
forall a b. a -> Either a b
Left (UTCTime -> Either UTCTime NominalDiffTime)
-> (NominalDiffTime -> UTCTime)
-> NominalDiffTime
-> Either UTCTime NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> UTCTime
addUTCTime' (NominalDiffTime -> UTCTime)
-> (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a
negate) Either UTCTime NominalDiffTime
e	-- Complete the function-application. N.B.: Right & Left are reflected.

	isOn :: StopWatch -> Bool
isOn MkStopWatch { deconstruct :: StopWatch -> Either UTCTime NominalDiffTime
deconstruct = Left UTCTime
_ }	= Bool
True
	isOn StopWatch
_						= Bool
False

-- | Constructor.
mkStoppedWatch :: Data.Time.Clock.NominalDiffTime -> StopWatch
mkStoppedWatch :: NominalDiffTime -> StopWatch
mkStoppedWatch	= Either UTCTime NominalDiffTime -> StopWatch
MkStopWatch (Either UTCTime NominalDiffTime -> StopWatch)
-> (NominalDiffTime -> Either UTCTime NominalDiffTime)
-> NominalDiffTime
-> StopWatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Either UTCTime NominalDiffTime
forall a b. b -> Either a b
Right

-- | Extract the elapsed time from a stopped watch.
getElapsedTime :: Fractional f => StopWatch -> f
getElapsedTime :: StopWatch -> f
getElapsedTime MkStopWatch {
	deconstruct :: StopWatch -> Either UTCTime NominalDiffTime
deconstruct	= Right NominalDiffTime
nominalDiffTime
}			= NominalDiffTime -> f
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
nominalDiffTime
getElapsedTime StopWatch
_	= Exception -> f
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> f) -> Exception -> f
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkRequestFailure String
"BishBosh.Time.StopWatch.getElapsedTime:\tthe watch is still running."