Improving.hs

{-# OPTIONS_GHC -Wall #-}
----------------------------------------------------------------------
-- |
-- Module      :  FRP.Reactive.Improving
-- Copyright   :  (c) Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Improving values -- efficient version
----------------------------------------------------------------------

module FRP.Reactive.Improving
  (
    Improving(..), exactly, minI, maxI
  ) where


-- import Data.Function (on)

import Data.Unamb (unamb,asAgree,parCommute)
import Test.QuickCheck.Checkers

{----------------------------------------------------------
    Improving values
----------------------------------------------------------}

-- | An improving value.
data Improving a = Imp { exact :: a, compareI :: a -> Ordering }

-- | A known improving value (which doesn't really improve)
exactly :: Ord a => a -> Improving a
exactly a = Imp a (compare a)

instance Eq a => Eq (Improving a) where
  -- (==) = (==) `on` exact
  (==) = parCommute (\ u v -> u `compareI` exact v == EQ)

instance Ord a => Ord (Improving a) where
  s `min` t = fst (s `minI` t)
  s  <=   t = snd (s `minI` t)

-- | Efficient combination of 'min' and '(<=)'
minI :: Ord a => Improving a -> Improving a -> (Improving a,Bool)
~(Imp u uComp) `minI` ~(Imp v vComp) = (Imp uMinV wComp, uLeqV)
 where
   uMinV = if uLeqV then u else v
   -- u <= v: Try @v `compare` u /= LT@ and @u `compare` v /= GT@.
   uLeqV = (vComp u /= LT) `unamb` (uComp v /= GT)
   minComp = if uLeqV then uComp else vComp
   -- (u `min` v) `compare` t: Try comparing according to whether u <= v,
   -- or go with either answer if they agree, e.g., if both say GT.
   wComp t = minComp t `unamb` (uComp t `asAgree` vComp t)

-- | Efficient combination of 'max' and '(>=)'
maxI :: Ord a => Improving a -> Improving a -> (Improving a,Bool)
~(Imp u uComp) `maxI` ~(Imp v vComp) = (Imp uMaxV wComp, uGeqV)
 where
   uMaxV = if uGeqV then u else v
   -- u >= v: Try @v `compare` u /= GT@ and @u `compare` v /= LT@.
   uGeqV = (vComp u /= GT) `unamb` (uComp v /= LT)
   -- (u `max` v) `compare` t: Try comparing according to whether u >= v,
   -- or go with either answer if they agree, e.g., if both say LT.
   maxComp = if uGeqV then uComp else vComp
   wComp t = maxComp t `unamb` (uComp t `asAgree` vComp t)

-- TODO: factor commonality out of 'minI' and 'maxI' or combine into
-- a single function.

-- -- | Interpret 'Nothing' values as lower bounds
-- improveMbs :: [(t, Maybe a)] -> [(Improving t, a)]
-- ...

-- No.  Don't implement & export improveMbs.  If it's being used, then
-- we're not benefitting from this fancy multi-threaded implementation of
-- Improving.

-- TODO: Are the lazy patterns at all helpful?

instance (EqProp a) => EqProp (Improving a) where
  (Imp a _) =-= (Imp b _) = a =-= b