{-# 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)
-- (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 `unamb` (uCt `asAgree` vCt)
where
minComp = if uLeqV then uCt else vCt
uCt = uComp t
vCt = 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.
wComp t = maxComp `unamb` (uCt `asAgree` vCt)
where
maxComp = if uGeqV then uCt else vCt
uCt = uComp t
vCt = vComp t

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

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

instance EqProp a => EqProp (Improving a) where
(=-=) = (=-=) `on` exact

-- TODO: revisit (=-=).  Maybe it doesn't have to test for full equality.