{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS -Wall -fno-warn-orphans #-}
----------------------------------------------------------------------
-- |
-- Module      :  Data.SFuture
-- Copyright   :  (c) Conal Elliott 2007
-- License     :  LGPL
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- A sort of semantic prototype for functional /futures/, roughly as
-- described at <http://en.wikipedia.org/wiki/Futures_and_promises>.
-- 
-- A /future/ is a value that will become knowable only later.  This
-- module gives a way to manipulate them functionally.  For instance,
-- @a+b@ becomes knowable when the later of @a@ and @b@ becomes knowable.
-- 
-- Primitive futures can be things like /the value of the next key you
-- press/, or /the value of LambdaPix stock at noon next Monday/.
-- 
-- Composition is via standard type classes: 'Ord', 'Functor',
-- 'Applicative', 'Monad', and 'Monoid'.  Some comments on the 'Future'
-- instances of these classes:
-- 
-- * 'Ord': @a `min` b@ is whichever of @a@ and @b@ is knowable first.  @a
--   `max` b@ is whichever of @a@ and @b@ is knowable last.
-- 
-- * Monoid: 'mempty' is a future that never becomes knowable.  'mappend'
--   is the same as 'min'.
-- 
-- * 'Functor': apply a function to a future.  The result is knowable when
--   the given future is knowable.
-- 
-- * 'Applicative': 'pure' gives value knowable since the beginning of
--   time.  '(\<*\>)' applies a future function to a future argument.
--   Result available when /both/ are available, i.e., it becomes knowable
--   when the later of the two futures becomes knowable.
-- 
-- * 'Monad': 'return' is the same as 'pure' (as always).  @(>>=)@
--   cascades futures.  'join' resolves a future future value into a
--   future value.
-- 
-- Futures are parametric over /time/ as well as /value/ types.  The time
-- parameter can be any ordered type.
-- 
-- Please keep in mind that this module specifies the interface and
-- semantics, rather than a useful implementation.  See "Data.Future" for
-- an implementation that nearly implements the semantics described here.
----------------------------------------------------------------------

module Data.SFuture where

import Data.Monoid (Monoid(..))
import Control.Applicative (Applicative(..))
-- import Data.Function (on)

-- | Time of some event occurrence, which can be any @Ord@ type.  In an
-- actual implementation, we would not usually have access to the time
-- value until (slightly after) that time.  Extracting the actual time
-- would block until the time is known.  The added bounds represent
-- -Infinity and +Infinity.  Pure values have time minBound (-Infinity),
-- while eternally unknowable values (non-occurring events) have time
-- maxBound (+Infinity).
type Time t = Max (AddBounds t)

-- | A future value of type @a@ with time type @t@.  Semantically, just a
-- time\/value pair, but those values would not be available until
-- 'force'd, which could block.
newtype Future t a = Future (Time t, a)
  deriving (Functor, Applicative, Monad, Show)

--  The 'Applicative' instance relies on the 'Monoid' instance of 'Max'.

-- | Force a future.  The real version blocks until knowable.
force :: Future t a -> (Time t,a)
force (Future p) = p

-- The Monoid instance picks the earlier future
instance Ord t => Monoid (Future t a) where
  mempty  = Future (maxBound, error "it'll never happen, buddy")
  fut@(Future (t,_)) `mappend` fut'@(Future (t',_)) =
    if t <= t' then fut else fut'


-------- To go elsewhere

-- For Data.Monoid:

-- | Ordered monoid under 'max'.
newtype Max a = Max { getMax :: a }
	deriving (Eq, Ord, Read, Show, Bounded)

instance (Ord a, Bounded a) => Monoid (Max a) where
	mempty = Max minBound
	Max a `mappend` Max b = Max (a `max` b)

-- | Ordered monoid under 'min'.
newtype Min a = Min { getMin :: a }
	deriving (Eq, Ord, Read, Show, Bounded)

instance (Ord a, Bounded a) => Monoid (Min a) where
	mempty = Min maxBound
	Min a `mappend` Min b = Min (a `min` b)

-- I have a niggling uncertainty about the 'Ord' & 'Bounded' instances for
-- @Min a@?  Is there a reason flip the @a@ ordering instead of preserving
-- it?

-- For Control.Monad.Instances

-- Equivalent to the Monad Writer instance.
-- import Data.Monoid
instance Monoid o => Monad ((,) o) where
	return = pure
	(o,a) >>= f = (o `mappend` o', a') where (o',a') = f a

-- Alternatively,
--   m >>= f = join (fmap f m)
--    where
--      join ((o, (o',a))) = (o `mappend` o', a)
-- Or even,
--   (o,a) >>= f = (o,id) <*> f a
-- 
-- I prefer the join version, because it's the standard (>>=)-via-join,
-- plus a very simple definition for join.  Too bad join isn't a method of
-- Monad, with (>>=) and join defined in terms of each other.  Why isn't
-- it?  Probably because Monad isn't derived from Functor.  Was that an
-- oversight?

-- Where to put this definition?  Prelude?

-- | Wrap a type into one having new least and greatest elements,
-- preserving the existing ordering.
data AddBounds a = MinBound | NoBound a | MaxBound
	deriving (Eq, Ord, Read, Show)

instance Bounded (AddBounds a) where
	minBound = MinBound
	maxBound = MaxBound