{-# 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) 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 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. instance (EqProp a) => EqProp (Improving a) where (Imp a _) =-= (Imp b _) = a =-= b