reactive-0.5: src/Data/SImproving.hs

{-# OPTIONS -Wall #-}
----------------------------------------------------------------------
-- |
-- Module      :  Data.Improving
-- Copyright   :  (c) Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- \"Improving values\" from Warren Burton's \"Encapsulating Nondeterminacy
-- in an Abstract Data Type with Deterministic Semantics\".
-- 
-- TODO: an efficient, referentially transparent, side-effecting version.
----------------------------------------------------------------------

module Data.Improving
  (
    Improving(..), exact
  -- , Improves, merge
  -- , Future(..)
  ) where

import Data.Function (on)

-- | Progressive information about a value (e.g., a time)
data Improving t = AtLeast t (Improving t) | Exactly t deriving Show

-- | Extract an exact value from an improving value
exact :: Improving t -> t
exact (AtLeast _ u) = exact u
exact (Exactly t)   = t

instance Eq t => Eq (Improving t) where
  (==) = (==) `on` exact

instance Ord t => Ord (Improving t) where
  Exactly s `compare` Exactly t = s `compare` t
  AtLeast s u' `compare` v@(Exactly t) =
    if s > t then GT else u' `compare` v
  u@(Exactly s) `compare` AtLeast t v' =
    if s < t then LT else u  `compare` v'
  u@(AtLeast s u') `compare` v@(AtLeast t v') =
    -- move forward where we know less
    if s <= t then
      u' `compare` v
    else
      u  `compare` v'

  Exactly s `min` Exactly t = Exactly (s `min` t)
  AtLeast s u' `min` v@(Exactly t) =
    if s > t then v else u' `min` v
  u@(Exactly s) `min` AtLeast t v' =
    if s < t then u else u  `min` v'
  u@(AtLeast s u') `min` v@(AtLeast t v') =
    -- move forward where we know less
    if s <= t then
      u' `min` v
    else
      u  `min` v'