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