-- |
-- Module:     Control.Wire.Session
-- Copyright:  (c) 2013 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Control.Wire.Session
    ( -- * State delta types
      HasTime(..),
      Session(..),

      -- ** Wires with time
      Timed(..),
      clockSession,
      clockSession_,
      countSession,
      countSession_
    )
    where

import Control.Applicative
import Control.Monad.IO.Class
import Data.Data
import Data.Foldable (Foldable)
import Data.Semigroup
import Data.Time.Clock
import Data.Traversable (Traversable)


-- | State delta types with time deltas.

class (Monoid s, Real t) => HasTime t s | s -> t where
    -- | Extract the current time delta.
    dtime :: s -> t


-- | State delta generators as required for wire sessions, most notably
-- to generate time deltas.  These are mini-wires with the sole purpose
-- of generating these deltas.

newtype Session m s =
    Session {
      Session m s -> m (s, Session m s)
stepSession :: m (s, Session m s)
    }
    deriving (a -> Session m b -> Session m a
(a -> b) -> Session m a -> Session m b
(forall a b. (a -> b) -> Session m a -> Session m b)
-> (forall a b. a -> Session m b -> Session m a)
-> Functor (Session m)
forall a b. a -> Session m b -> Session m a
forall a b. (a -> b) -> Session m a -> Session m b
forall (m :: * -> *) a b.
Functor m =>
a -> Session m b -> Session m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Session m a -> Session m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Session m b -> Session m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> Session m b -> Session m a
fmap :: (a -> b) -> Session m a -> Session m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Session m a -> Session m b
Functor)

instance (Applicative m) => Applicative (Session m) where
    pure :: a -> Session m a
pure x :: a
x = let s :: Session m a
s = m (a, Session m a) -> Session m a
forall (m :: * -> *) s. m (s, Session m s) -> Session m s
Session ((a, Session m a) -> m (a, Session m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, Session m a
s)) in Session m a
s

    Session ff :: m (a -> b, Session m (a -> b))
ff <*> :: Session m (a -> b) -> Session m a -> Session m b
<*> Session fx :: m (a, Session m a)
fx =
        m (b, Session m b) -> Session m b
forall (m :: * -> *) s. m (s, Session m s) -> Session m s
Session (m (b, Session m b) -> Session m b)
-> m (b, Session m b) -> Session m b
forall a b. (a -> b) -> a -> b
$ ((a -> b, Session m (a -> b))
 -> (a, Session m a) -> (b, Session m b))
-> m (a -> b, Session m (a -> b))
-> m (a, Session m a)
-> m (b, Session m b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\(f :: a -> b
f, sf :: Session m (a -> b)
sf) (x :: a
x, sx :: Session m a
sx) -> (a -> b
f a
x, Session m (a -> b)
sf Session m (a -> b) -> Session m a -> Session m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Session m a
sx)) m (a -> b, Session m (a -> b))
ff m (a, Session m a)
fx


-- | This state delta type denotes time deltas.  This is necessary for
-- most FRP applications.

data Timed t s = Timed t s
    deriving (Typeable (Timed t s)
Constr
DataType
Typeable (Timed t s) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Timed t s -> c (Timed t s))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Timed t s))
-> (Timed t s -> Constr)
-> (Timed t s -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Timed t s)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Timed t s)))
-> ((forall b. Data b => b -> b) -> Timed t s -> Timed t s)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Timed t s -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Timed t s -> r)
-> (forall u. (forall d. Data d => d -> u) -> Timed t s -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Timed t s -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s))
-> Data (Timed t s)
Timed t s -> Constr
Timed t s -> DataType
(forall b. Data b => b -> b) -> Timed t s -> Timed t s
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timed t s -> c (Timed t s)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Timed t s)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Timed t s))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Timed t s -> u
forall u. (forall d. Data d => d -> u) -> Timed t s -> [u]
forall t s. (Data t, Data s) => Typeable (Timed t s)
forall t s. (Data t, Data s) => Timed t s -> Constr
forall t s. (Data t, Data s) => Timed t s -> DataType
forall t s.
(Data t, Data s) =>
(forall b. Data b => b -> b) -> Timed t s -> Timed t s
forall t s u.
(Data t, Data s) =>
Int -> (forall d. Data d => d -> u) -> Timed t s -> u
forall t s u.
(Data t, Data s) =>
(forall d. Data d => d -> u) -> Timed t s -> [u]
forall t s r r'.
(Data t, Data s) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timed t s -> r
forall t s r r'.
(Data t, Data s) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timed t s -> r
forall t s (m :: * -> *).
(Data t, Data s, Monad m) =>
(forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s)
forall t s (m :: * -> *).
(Data t, Data s, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s)
forall t s (c :: * -> *).
(Data t, Data s) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Timed t s)
forall t s (c :: * -> *).
(Data t, Data s) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timed t s -> c (Timed t s)
forall t s (t :: * -> *) (c :: * -> *).
(Data t, Data s, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Timed t s))
forall t s (t :: * -> * -> *) (c :: * -> *).
(Data t, Data s, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Timed t s))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timed t s -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timed t s -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Timed t s)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timed t s -> c (Timed t s)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Timed t s))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Timed t s))
$cTimed :: Constr
$tTimed :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s)
$cgmapMo :: forall t s (m :: * -> *).
(Data t, Data s, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s)
gmapMp :: (forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s)
$cgmapMp :: forall t s (m :: * -> *).
(Data t, Data s, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s)
gmapM :: (forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s)
$cgmapM :: forall t s (m :: * -> *).
(Data t, Data s, Monad m) =>
(forall d. Data d => d -> m d) -> Timed t s -> m (Timed t s)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Timed t s -> u
$cgmapQi :: forall t s u.
(Data t, Data s) =>
Int -> (forall d. Data d => d -> u) -> Timed t s -> u
gmapQ :: (forall d. Data d => d -> u) -> Timed t s -> [u]
$cgmapQ :: forall t s u.
(Data t, Data s) =>
(forall d. Data d => d -> u) -> Timed t s -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timed t s -> r
$cgmapQr :: forall t s r r'.
(Data t, Data s) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timed t s -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timed t s -> r
$cgmapQl :: forall t s r r'.
(Data t, Data s) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timed t s -> r
gmapT :: (forall b. Data b => b -> b) -> Timed t s -> Timed t s
$cgmapT :: forall t s.
(Data t, Data s) =>
(forall b. Data b => b -> b) -> Timed t s -> Timed t s
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Timed t s))
$cdataCast2 :: forall t s (t :: * -> * -> *) (c :: * -> *).
(Data t, Data s, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Timed t s))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Timed t s))
$cdataCast1 :: forall t s (t :: * -> *) (c :: * -> *).
(Data t, Data s, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Timed t s))
dataTypeOf :: Timed t s -> DataType
$cdataTypeOf :: forall t s. (Data t, Data s) => Timed t s -> DataType
toConstr :: Timed t s -> Constr
$ctoConstr :: forall t s. (Data t, Data s) => Timed t s -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Timed t s)
$cgunfold :: forall t s (c :: * -> *).
(Data t, Data s) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Timed t s)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timed t s -> c (Timed t s)
$cgfoldl :: forall t s (c :: * -> *).
(Data t, Data s) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timed t s -> c (Timed t s)
$cp1Data :: forall t s. (Data t, Data s) => Typeable (Timed t s)
Data, Timed t s -> Timed t s -> Bool
(Timed t s -> Timed t s -> Bool)
-> (Timed t s -> Timed t s -> Bool) -> Eq (Timed t s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t s. (Eq t, Eq s) => Timed t s -> Timed t s -> Bool
/= :: Timed t s -> Timed t s -> Bool
$c/= :: forall t s. (Eq t, Eq s) => Timed t s -> Timed t s -> Bool
== :: Timed t s -> Timed t s -> Bool
$c== :: forall t s. (Eq t, Eq s) => Timed t s -> Timed t s -> Bool
Eq, Timed t a -> Bool
(a -> m) -> Timed t a -> m
(a -> b -> b) -> b -> Timed t a -> b
(forall m. Monoid m => Timed t m -> m)
-> (forall m a. Monoid m => (a -> m) -> Timed t a -> m)
-> (forall m a. Monoid m => (a -> m) -> Timed t a -> m)
-> (forall a b. (a -> b -> b) -> b -> Timed t a -> b)
-> (forall a b. (a -> b -> b) -> b -> Timed t a -> b)
-> (forall b a. (b -> a -> b) -> b -> Timed t a -> b)
-> (forall b a. (b -> a -> b) -> b -> Timed t a -> b)
-> (forall a. (a -> a -> a) -> Timed t a -> a)
-> (forall a. (a -> a -> a) -> Timed t a -> a)
-> (forall a. Timed t a -> [a])
-> (forall a. Timed t a -> Bool)
-> (forall a. Timed t a -> Int)
-> (forall a. Eq a => a -> Timed t a -> Bool)
-> (forall a. Ord a => Timed t a -> a)
-> (forall a. Ord a => Timed t a -> a)
-> (forall a. Num a => Timed t a -> a)
-> (forall a. Num a => Timed t a -> a)
-> Foldable (Timed t)
forall a. Eq a => a -> Timed t a -> Bool
forall a. Num a => Timed t a -> a
forall a. Ord a => Timed t a -> a
forall m. Monoid m => Timed t m -> m
forall a. Timed t a -> Bool
forall a. Timed t a -> Int
forall a. Timed t a -> [a]
forall a. (a -> a -> a) -> Timed t a -> a
forall t a. Eq a => a -> Timed t a -> Bool
forall t a. Num a => Timed t a -> a
forall t a. Ord a => Timed t a -> a
forall m a. Monoid m => (a -> m) -> Timed t a -> m
forall t m. Monoid m => Timed t m -> m
forall t a. Timed t a -> Bool
forall t a. Timed t a -> Int
forall t a. Timed t a -> [a]
forall b a. (b -> a -> b) -> b -> Timed t a -> b
forall a b. (a -> b -> b) -> b -> Timed t a -> b
forall t a. (a -> a -> a) -> Timed t a -> a
forall t m a. Monoid m => (a -> m) -> Timed t a -> m
forall t b a. (b -> a -> b) -> b -> Timed t a -> b
forall t a b. (a -> b -> b) -> b -> Timed t a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Timed t a -> a
$cproduct :: forall t a. Num a => Timed t a -> a
sum :: Timed t a -> a
$csum :: forall t a. Num a => Timed t a -> a
minimum :: Timed t a -> a
$cminimum :: forall t a. Ord a => Timed t a -> a
maximum :: Timed t a -> a
$cmaximum :: forall t a. Ord a => Timed t a -> a
elem :: a -> Timed t a -> Bool
$celem :: forall t a. Eq a => a -> Timed t a -> Bool
length :: Timed t a -> Int
$clength :: forall t a. Timed t a -> Int
null :: Timed t a -> Bool
$cnull :: forall t a. Timed t a -> Bool
toList :: Timed t a -> [a]
$ctoList :: forall t a. Timed t a -> [a]
foldl1 :: (a -> a -> a) -> Timed t a -> a
$cfoldl1 :: forall t a. (a -> a -> a) -> Timed t a -> a
foldr1 :: (a -> a -> a) -> Timed t a -> a
$cfoldr1 :: forall t a. (a -> a -> a) -> Timed t a -> a
foldl' :: (b -> a -> b) -> b -> Timed t a -> b
$cfoldl' :: forall t b a. (b -> a -> b) -> b -> Timed t a -> b
foldl :: (b -> a -> b) -> b -> Timed t a -> b
$cfoldl :: forall t b a. (b -> a -> b) -> b -> Timed t a -> b
foldr' :: (a -> b -> b) -> b -> Timed t a -> b
$cfoldr' :: forall t a b. (a -> b -> b) -> b -> Timed t a -> b
foldr :: (a -> b -> b) -> b -> Timed t a -> b
$cfoldr :: forall t a b. (a -> b -> b) -> b -> Timed t a -> b
foldMap' :: (a -> m) -> Timed t a -> m
$cfoldMap' :: forall t m a. Monoid m => (a -> m) -> Timed t a -> m
foldMap :: (a -> m) -> Timed t a -> m
$cfoldMap :: forall t m a. Monoid m => (a -> m) -> Timed t a -> m
fold :: Timed t m -> m
$cfold :: forall t m. Monoid m => Timed t m -> m
Foldable, a -> Timed t b -> Timed t a
(a -> b) -> Timed t a -> Timed t b
(forall a b. (a -> b) -> Timed t a -> Timed t b)
-> (forall a b. a -> Timed t b -> Timed t a) -> Functor (Timed t)
forall a b. a -> Timed t b -> Timed t a
forall a b. (a -> b) -> Timed t a -> Timed t b
forall t a b. a -> Timed t b -> Timed t a
forall t a b. (a -> b) -> Timed t a -> Timed t b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Timed t b -> Timed t a
$c<$ :: forall t a b. a -> Timed t b -> Timed t a
fmap :: (a -> b) -> Timed t a -> Timed t b
$cfmap :: forall t a b. (a -> b) -> Timed t a -> Timed t b
Functor,
              Eq (Timed t s)
Eq (Timed t s) =>
(Timed t s -> Timed t s -> Ordering)
-> (Timed t s -> Timed t s -> Bool)
-> (Timed t s -> Timed t s -> Bool)
-> (Timed t s -> Timed t s -> Bool)
-> (Timed t s -> Timed t s -> Bool)
-> (Timed t s -> Timed t s -> Timed t s)
-> (Timed t s -> Timed t s -> Timed t s)
-> Ord (Timed t s)
Timed t s -> Timed t s -> Bool
Timed t s -> Timed t s -> Ordering
Timed t s -> Timed t s -> Timed t s
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
forall t s. (Ord t, Ord s) => Eq (Timed t s)
forall t s. (Ord t, Ord s) => Timed t s -> Timed t s -> Bool
forall t s. (Ord t, Ord s) => Timed t s -> Timed t s -> Ordering
forall t s. (Ord t, Ord s) => Timed t s -> Timed t s -> Timed t s
min :: Timed t s -> Timed t s -> Timed t s
$cmin :: forall t s. (Ord t, Ord s) => Timed t s -> Timed t s -> Timed t s
max :: Timed t s -> Timed t s -> Timed t s
$cmax :: forall t s. (Ord t, Ord s) => Timed t s -> Timed t s -> Timed t s
>= :: Timed t s -> Timed t s -> Bool
$c>= :: forall t s. (Ord t, Ord s) => Timed t s -> Timed t s -> Bool
> :: Timed t s -> Timed t s -> Bool
$c> :: forall t s. (Ord t, Ord s) => Timed t s -> Timed t s -> Bool
<= :: Timed t s -> Timed t s -> Bool
$c<= :: forall t s. (Ord t, Ord s) => Timed t s -> Timed t s -> Bool
< :: Timed t s -> Timed t s -> Bool
$c< :: forall t s. (Ord t, Ord s) => Timed t s -> Timed t s -> Bool
compare :: Timed t s -> Timed t s -> Ordering
$ccompare :: forall t s. (Ord t, Ord s) => Timed t s -> Timed t s -> Ordering
$cp1Ord :: forall t s. (Ord t, Ord s) => Eq (Timed t s)
Ord, ReadPrec [Timed t s]
ReadPrec (Timed t s)
Int -> ReadS (Timed t s)
ReadS [Timed t s]
(Int -> ReadS (Timed t s))
-> ReadS [Timed t s]
-> ReadPrec (Timed t s)
-> ReadPrec [Timed t s]
-> Read (Timed t s)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall t s. (Read t, Read s) => ReadPrec [Timed t s]
forall t s. (Read t, Read s) => ReadPrec (Timed t s)
forall t s. (Read t, Read s) => Int -> ReadS (Timed t s)
forall t s. (Read t, Read s) => ReadS [Timed t s]
readListPrec :: ReadPrec [Timed t s]
$creadListPrec :: forall t s. (Read t, Read s) => ReadPrec [Timed t s]
readPrec :: ReadPrec (Timed t s)
$creadPrec :: forall t s. (Read t, Read s) => ReadPrec (Timed t s)
readList :: ReadS [Timed t s]
$creadList :: forall t s. (Read t, Read s) => ReadS [Timed t s]
readsPrec :: Int -> ReadS (Timed t s)
$creadsPrec :: forall t s. (Read t, Read s) => Int -> ReadS (Timed t s)
Read, Int -> Timed t s -> ShowS
[Timed t s] -> ShowS
Timed t s -> String
(Int -> Timed t s -> ShowS)
-> (Timed t s -> String)
-> ([Timed t s] -> ShowS)
-> Show (Timed t s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t s. (Show t, Show s) => Int -> Timed t s -> ShowS
forall t s. (Show t, Show s) => [Timed t s] -> ShowS
forall t s. (Show t, Show s) => Timed t s -> String
showList :: [Timed t s] -> ShowS
$cshowList :: forall t s. (Show t, Show s) => [Timed t s] -> ShowS
show :: Timed t s -> String
$cshow :: forall t s. (Show t, Show s) => Timed t s -> String
showsPrec :: Int -> Timed t s -> ShowS
$cshowsPrec :: forall t s. (Show t, Show s) => Int -> Timed t s -> ShowS
Show, Functor (Timed t)
Foldable (Timed t)
(Functor (Timed t), Foldable (Timed t)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Timed t a -> f (Timed t b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Timed t (f a) -> f (Timed t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Timed t a -> m (Timed t b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Timed t (m a) -> m (Timed t a))
-> Traversable (Timed t)
(a -> f b) -> Timed t a -> f (Timed t b)
forall t. Functor (Timed t)
forall t. Foldable (Timed t)
forall t (m :: * -> *) a. Monad m => Timed t (m a) -> m (Timed t a)
forall t (f :: * -> *) a.
Applicative f =>
Timed t (f a) -> f (Timed t a)
forall t (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Timed t a -> m (Timed t b)
forall t (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Timed t a -> f (Timed t b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Timed t (m a) -> m (Timed t a)
forall (f :: * -> *) a.
Applicative f =>
Timed t (f a) -> f (Timed t a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Timed t a -> m (Timed t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Timed t a -> f (Timed t b)
sequence :: Timed t (m a) -> m (Timed t a)
$csequence :: forall t (m :: * -> *) a. Monad m => Timed t (m a) -> m (Timed t a)
mapM :: (a -> m b) -> Timed t a -> m (Timed t b)
$cmapM :: forall t (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Timed t a -> m (Timed t b)
sequenceA :: Timed t (f a) -> f (Timed t a)
$csequenceA :: forall t (f :: * -> *) a.
Applicative f =>
Timed t (f a) -> f (Timed t a)
traverse :: (a -> f b) -> Timed t a -> f (Timed t b)
$ctraverse :: forall t (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Timed t a -> f (Timed t b)
$cp2Traversable :: forall t. Foldable (Timed t)
$cp1Traversable :: forall t. Functor (Timed t)
Traversable, Typeable)

instance (Semigroup s, Monoid s, Real t) => HasTime t (Timed t s) where
    dtime :: Timed t s -> t
dtime (Timed dt :: t
dt _) = t
dt

instance (Semigroup s, Num t) => Semigroup (Timed t s) where
    Timed dt1 :: t
dt1 ds1 :: s
ds1 <> :: Timed t s -> Timed t s -> Timed t s
<> Timed dt2 :: t
dt2 ds2 :: s
ds2 =
        let dt :: t
dt = t
dt1 t -> t -> t
forall a. Num a => a -> a -> a
+ t
dt2
            ds :: s
ds = s
ds1 s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
ds2
        in t
dt t -> Timed t s -> Timed t s
forall a b. a -> b -> b
`seq` s
ds s -> Timed t s -> Timed t s
forall a b. a -> b -> b
`seq` t -> s -> Timed t s
forall t s. t -> s -> Timed t s
Timed t
dt s
ds

instance (Semigroup s, Monoid s, Num t) => Monoid (Timed t s) where
    mempty :: Timed t s
mempty = t -> s -> Timed t s
forall t s. t -> s -> Timed t s
Timed 0 s
forall a. Monoid a => a
mempty
    mappend :: Timed t s -> Timed t s -> Timed t s
mappend = Timed t s -> Timed t s -> Timed t s
forall a. Semigroup a => a -> a -> a
(<>)

-- | State delta generator for a real time clock.

clockSession :: (MonadIO m) => Session m (s -> Timed NominalDiffTime s)
clockSession :: Session m (s -> Timed NominalDiffTime s)
clockSession =
    m (s -> Timed NominalDiffTime s,
   Session m (s -> Timed NominalDiffTime s))
-> Session m (s -> Timed NominalDiffTime s)
forall (m :: * -> *) s. m (s, Session m s) -> Session m s
Session (m (s -> Timed NominalDiffTime s,
    Session m (s -> Timed NominalDiffTime s))
 -> Session m (s -> Timed NominalDiffTime s))
-> m (s -> Timed NominalDiffTime s,
      Session m (s -> Timed NominalDiffTime s))
-> Session m (s -> Timed NominalDiffTime s)
forall a b. (a -> b) -> a -> b
$ do
        UTCTime
t0 <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
        (s -> Timed NominalDiffTime s,
 Session m (s -> Timed NominalDiffTime s))
-> m (s -> Timed NominalDiffTime s,
      Session m (s -> Timed NominalDiffTime s))
forall (m :: * -> *) a. Monad m => a -> m a
return (NominalDiffTime -> s -> Timed NominalDiffTime s
forall t s. t -> s -> Timed t s
Timed 0, UTCTime -> Session m (s -> Timed NominalDiffTime s)
forall (m :: * -> *) s.
MonadIO m =>
UTCTime -> Session m (s -> Timed NominalDiffTime s)
loop UTCTime
t0)

    where
    loop :: UTCTime -> Session m (s -> Timed NominalDiffTime s)
loop t' :: UTCTime
t' =
        m (s -> Timed NominalDiffTime s,
   Session m (s -> Timed NominalDiffTime s))
-> Session m (s -> Timed NominalDiffTime s)
forall (m :: * -> *) s. m (s, Session m s) -> Session m s
Session (m (s -> Timed NominalDiffTime s,
    Session m (s -> Timed NominalDiffTime s))
 -> Session m (s -> Timed NominalDiffTime s))
-> m (s -> Timed NominalDiffTime s,
      Session m (s -> Timed NominalDiffTime s))
-> Session m (s -> Timed NominalDiffTime s)
forall a b. (a -> b) -> a -> b
$ do
            UTCTime
t <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
            let dt :: NominalDiffTime
dt = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t UTCTime
t'
            NominalDiffTime
dt NominalDiffTime
-> m (s -> Timed NominalDiffTime s,
      Session m (s -> Timed NominalDiffTime s))
-> m (s -> Timed NominalDiffTime s,
      Session m (s -> Timed NominalDiffTime s))
forall a b. a -> b -> b
`seq` (s -> Timed NominalDiffTime s,
 Session m (s -> Timed NominalDiffTime s))
-> m (s -> Timed NominalDiffTime s,
      Session m (s -> Timed NominalDiffTime s))
forall (m :: * -> *) a. Monad m => a -> m a
return (NominalDiffTime -> s -> Timed NominalDiffTime s
forall t s. t -> s -> Timed t s
Timed NominalDiffTime
dt, UTCTime -> Session m (s -> Timed NominalDiffTime s)
loop UTCTime
t)


-- | Non-extending version of 'clockSession'.

clockSession_ :: (Applicative m, MonadIO m) => Session m (Timed NominalDiffTime ())
clockSession_ :: Session m (Timed NominalDiffTime ())
clockSession_ = Session m (() -> Timed NominalDiffTime ())
forall (m :: * -> *) s.
MonadIO m =>
Session m (s -> Timed NominalDiffTime s)
clockSession Session m (() -> Timed NominalDiffTime ())
-> Session m () -> Session m (Timed NominalDiffTime ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> Session m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | State delta generator for a simple counting clock.  Denotes a fixed
-- framerate.  This is likely more useful than 'clockSession' for
-- simulations and real-time games.

countSession ::
    (Applicative m)
    => t  -- ^ Increment size.
    -> Session m (s -> Timed t s)
countSession :: t -> Session m (s -> Timed t s)
countSession dt :: t
dt =
    let loop :: Session m (s -> Timed t s)
loop = m (s -> Timed t s, Session m (s -> Timed t s))
-> Session m (s -> Timed t s)
forall (m :: * -> *) s. m (s, Session m s) -> Session m s
Session ((s -> Timed t s, Session m (s -> Timed t s))
-> m (s -> Timed t s, Session m (s -> Timed t s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> s -> Timed t s
forall t s. t -> s -> Timed t s
Timed t
dt, Session m (s -> Timed t s)
loop))
    in Session m (s -> Timed t s)
forall s. Session m (s -> Timed t s)
loop


-- | Non-extending version of 'countSession'.

countSession_ :: (Applicative m) => t -> Session m (Timed t ())
countSession_ :: t -> Session m (Timed t ())
countSession_ dt :: t
dt = t -> Session m (() -> Timed t ())
forall (m :: * -> *) t s.
Applicative m =>
t -> Session m (s -> Timed t s)
countSession t
dt Session m (() -> Timed t ())
-> Session m () -> Session m (Timed t ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> Session m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()