-- {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS -Wall -fno-warn-orphans #-}
-- For ghc-6.6 compatibility
{-# OPTIONS_GHC -fglasgow-exts #-}

----------------------------------------------------------------------
-- |
-- 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.
-- 
-- On second thought, I'm experimenting with using this module in an
-- usable implementation of events.  See Data.MEvent.
----------------------------------------------------------------------

module Data.SFuture 
  (
    -- * Time & futures
    Time, Future(..), futTime, futVal, sequenceF
    -- * To go elsewhere
  , Max(..), Min(..), AddBounds(..)
  ) where

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


{----------------------------------------------------------
    Time and futures
----------------------------------------------------------}

-- | 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 { unFuture :: (Time t, a) }
  deriving (Functor, Applicative, Monad, Show)

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

-- | A future's time
futTime :: Future t a -> Time t
futTime = fst . unFuture

-- | A future's value
futVal :: Future t a -> a
futVal = snd . unFuture


-- -- 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'

-- or:


instance Eq (Future t a) where
  (==) = error "sorry, no (==) for futures"

instance Ord t => Ord (Future t a) where
  (<=) = (<=) `on` futTime
  -- We could leave 'min' to the default in terms of '(<=)', but the
  -- following can yield partial time info, as much as allowed by the time
  -- parameter type @t@ and its 'min'.
  Future (s,a) `min` Future (t,b) =
    Future (s `min` t, if s <= t then a else b)

-- For some choices of @t@, there may be an efficient combination of 'min'
-- and '(<=)'.  In particular, 'Improving' has 'minI'.

instance Ord t => Monoid (Future t a) where
  mempty  = Future (maxBound, error "it'll never happen, buddy")
  mappend = min

-- 'sequenceF' is like 'sequenceA' from "Data.Traversable".  However,
-- the @Traversable@ class assumes @Foldable@, which I'm not confident
-- how to implement usefully.  (I could of course just strip off the
-- 'Future' constructor and the time.  Why is Foldable required?

-- | Make a future container into a container of futures.
sequenceF :: Functor f => Future t (f a) -> f (Future t a)
sequenceF (Future (tt, f)) = fmap (Future . ((,) tt)) f



{----------------------------------------------------------
    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