{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DataKinds, TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Control.Moffy.Event.Time (
	-- * Time Event
	TimeEv,
	-- * Elapsed
	DeltaTime(..), pattern OccDeltaTime, deltaTime, elapsed,
	-- * Sleep
	TryWait(..), pattern OccTryWait, sleep ) where

import Prelude hiding (repeat, scanl)

import GHC.Stack (HasCallStack)
import Control.Moffy (Sig, React, Request(..), await, repeat, scanl)
import Data.Type.Set (numbered, pattern Nil, Singleton, (:-))
import Data.Bool (bool)
import Data.Time (DiffTime)

---------------------------------------------------------------------------

-- * ELAPSED
-- * SLEEP
-- * TIME EVENT

---------------------------------------------------------------------------

---------------------------------------------------------------------------
-- ELAPSED
---------------------------------------------------------------------------

data DeltaTime = DeltaTimeReq deriving (Int -> DeltaTime -> ShowS
[DeltaTime] -> ShowS
DeltaTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeltaTime] -> ShowS
$cshowList :: [DeltaTime] -> ShowS
show :: DeltaTime -> String
$cshow :: DeltaTime -> String
showsPrec :: Int -> DeltaTime -> ShowS
$cshowsPrec :: Int -> DeltaTime -> ShowS
Show, DeltaTime -> DeltaTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeltaTime -> DeltaTime -> Bool
$c/= :: DeltaTime -> DeltaTime -> Bool
== :: DeltaTime -> DeltaTime -> Bool
$c== :: DeltaTime -> DeltaTime -> Bool
Eq, Eq DeltaTime
DeltaTime -> DeltaTime -> Bool
DeltaTime -> DeltaTime -> Ordering
DeltaTime -> DeltaTime -> DeltaTime
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeltaTime -> DeltaTime -> DeltaTime
$cmin :: DeltaTime -> DeltaTime -> DeltaTime
max :: DeltaTime -> DeltaTime -> DeltaTime
$cmax :: DeltaTime -> DeltaTime -> DeltaTime
>= :: DeltaTime -> DeltaTime -> Bool
$c>= :: DeltaTime -> DeltaTime -> Bool
> :: DeltaTime -> DeltaTime -> Bool
$c> :: DeltaTime -> DeltaTime -> Bool
<= :: DeltaTime -> DeltaTime -> Bool
$c<= :: DeltaTime -> DeltaTime -> Bool
< :: DeltaTime -> DeltaTime -> Bool
$c< :: DeltaTime -> DeltaTime -> Bool
compare :: DeltaTime -> DeltaTime -> Ordering
$ccompare :: DeltaTime -> DeltaTime -> Ordering
Ord)
numbered [t| DeltaTime |]
instance Request DeltaTime where data Occurred DeltaTime = OccDeltaTime DiffTime

deltaTime :: React s (Singleton DeltaTime) DiffTime
deltaTime :: forall s. React s (Singleton DeltaTime) DiffTime
deltaTime = forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await DeltaTime
DeltaTimeReq \(OccDeltaTime DiffTime
t) -> DiffTime
t

elapsed :: Sig s (Singleton DeltaTime) DiffTime r
elapsed :: forall s r. Sig s (Singleton DeltaTime) DiffTime r
elapsed = forall b a s (es :: Set (*)) r.
(b -> a -> b) -> b -> Sig s es a r -> Sig s es b r
scanl forall a. Num a => a -> a -> a
(+) DiffTime
0 forall a b. (a -> b) -> a -> b
$ forall s (es :: Set (*)) a r. React s es a -> Sig s es a r
repeat forall s. React s (Singleton DeltaTime) DiffTime
deltaTime

---------------------------------------------------------------------------
-- SLEEP
---------------------------------------------------------------------------

newtype TryWait = TryWaitReq DiffTime deriving (Int -> TryWait -> ShowS
[TryWait] -> ShowS
TryWait -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TryWait] -> ShowS
$cshowList :: [TryWait] -> ShowS
show :: TryWait -> String
$cshow :: TryWait -> String
showsPrec :: Int -> TryWait -> ShowS
$cshowsPrec :: Int -> TryWait -> ShowS
Show, TryWait -> TryWait -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TryWait -> TryWait -> Bool
$c/= :: TryWait -> TryWait -> Bool
== :: TryWait -> TryWait -> Bool
$c== :: TryWait -> TryWait -> Bool
Eq, Eq TryWait
TryWait -> TryWait -> Bool
TryWait -> TryWait -> Ordering
TryWait -> TryWait -> TryWait
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TryWait -> TryWait -> TryWait
$cmin :: TryWait -> TryWait -> TryWait
max :: TryWait -> TryWait -> TryWait
$cmax :: TryWait -> TryWait -> TryWait
>= :: TryWait -> TryWait -> Bool
$c>= :: TryWait -> TryWait -> Bool
> :: TryWait -> TryWait -> Bool
$c> :: TryWait -> TryWait -> Bool
<= :: TryWait -> TryWait -> Bool
$c<= :: TryWait -> TryWait -> Bool
< :: TryWait -> TryWait -> Bool
$c< :: TryWait -> TryWait -> Bool
compare :: TryWait -> TryWait -> Ordering
$ccompare :: TryWait -> TryWait -> Ordering
Ord)
numbered [t| TryWait |]
instance Request TryWait where data Occurred TryWait = OccTryWait DiffTime

tryWait :: DiffTime -> React s (Singleton TryWait) DiffTime
tryWait :: forall s. DiffTime -> React s (Singleton TryWait) DiffTime
tryWait DiffTime
t = forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await (DiffTime -> TryWait
TryWaitReq DiffTime
t) \(OccTryWait DiffTime
t') -> DiffTime
t'

sleep :: HasCallStack => DiffTime -> React s (Singleton TryWait) ()
sleep :: forall s.
HasCallStack =>
DiffTime -> React s (Singleton TryWait) ()
sleep DiffTime
t | DiffTime
t forall a. Ord a => a -> a -> Bool
<= DiffTime
0 = forall a. HasCallStack => String -> a
error String
"sleep t: t (seconds) should be positive"
sleep DiffTime
t = forall s. DiffTime -> React s (Singleton TryWait) DiffTime
tryWait DiffTime
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DiffTime
t' -> forall a. a -> a -> Bool -> a
bool (forall s.
HasCallStack =>
DiffTime -> React s (Singleton TryWait) ()
sleep (DiffTime
t forall a. Num a => a -> a -> a
- DiffTime
t')) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (DiffTime
t' forall a. Eq a => a -> a -> Bool
== DiffTime
t)

---------------------------------------------------------------------------
-- TIME EVENT
---------------------------------------------------------------------------

type TimeEv = DeltaTime :- TryWait :- 'Nil