{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -Wall #-} ---------------------------------------------------------------------- -- | -- Module : FRP.Reactive.Internal.Future -- Copyright : (c) Conal Elliott 2008 -- License : BSD3 -- -- Maintainer : conal@conal.net -- Stability : experimental -- -- Representation of future values ---------------------------------------------------------------------- module FRP.Reactive.Internal.Future ( -- * Time & futures Time , FutureG(..), inFuture, inFuture2 , runF ) where import Control.Applicative (Applicative(..)) import Test.QuickCheck import FRP.Reactive.Internal.Misc (Sink) import Data.Max import Data.AddBounds import Data.PairMonad () -- | Time used in futures. The parameter @t@ can be any @Ord@ type. The -- added bounds represent -Infinity and +Infinity. Pure values have time -- minBound (-Infinity), while never-occurring futures have time maxBound -- (+Infinity). type Time t = Max (AddBounds t) -- | A future value of type @a@ with time type @t@. Simply a -- time\/value pair. Particularly useful with time types that have -- non-flat structure. newtype FutureG t a = Future { unFuture :: (Time t, a) } deriving (Functor, Applicative, Monad, Show, Arbitrary) -- TODO: see if the following definition is really necessary, instead of deriving. -- -- This instance needs to be lazy; automatic deriving doesn't work. -- -- Probably the other instances need this too! TODO (find out). -- instance Functor (FutureG t) where -- fmap f (Future ~(t,x)) = Future (t, f x) -- The 'Applicative' and 'Monad' instances rely on the 'Monoid' instance -- of 'Max'. -- | Apply a unary function within the 'FutureG' representation. inFuture :: ((Time t, a) -> (Time t', b)) -> FutureG t a -> FutureG t' b inFuture f = Future . f . unFuture -- | Apply a binary function within the 'FutureG' representation. inFuture2 :: ((Time t, a) -> (Time t', b) -> (Time t', c)) -> FutureG t a -> FutureG t' b -> FutureG t' c inFuture2 f = inFuture . f . unFuture -- | Run a future in the current thread. Use the given time sink to sync -- time, i.e., to wait for an output time before performing the action. runF :: Ord t => Sink t -> FutureG t (IO a) -> IO a runF sync (Future (Max t,io)) = tsync t >> io where tsync MinBound = putStrLn "runE: skipping MinBound" tsync (NoBound t') = sync t' tsync MaxBound = error "runE: infinite wait"