```{-# OPTIONS_GHC -Wall #-}
----------------------------------------------------------------------
-- |
-- Copyright   :  (c) Conal Elliott 2008
--
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
--
-- Add bounds to an ordered type
----------------------------------------------------------------------

import Control.Applicative (pure,(<\$>))

-- import Data.Unamb (unamb)

-- Testing
import Test.QuickCheck
import Test.QuickCheck.Checkers

-- | Wrap a type into one having new least and greatest elements,
-- preserving the existing ordering.
data AddBounds a = MinBound | NoBound a | MaxBound
deriving (Eq {-, Ord-}, Read, Show)

minBound = MinBound
maxBound = MaxBound

-- Normally, I'd derive 'Ord' as well, but there's a sticky point.  The
-- derived instance uses the default definition of 'min', which is uses
-- '(<=)' and thus cannot exploit any partial information.  So, define our
-- own 'min' in terms of 'min' on @a@.
-- Examples:
--   (NoBound undefined) `min` (NoBound undefined) can return (NoBound _|_)
--   using this definition, but will not produce any output using the
--   default min.
--
--   (NoBound a) `min` (NoBound b) can return partial information from
--   a `min` b while the default implementation cannot.

instance Ord a => Ord (AddBounds a) where
MinBound  <= _         = True
NoBound _ <= MinBound  = False
NoBound a <= NoBound b = a <= b
NoBound _ <= MaxBound  = True
MaxBound  <= MaxBound  = True
MaxBound  <= _         = False        -- given previous

MinBound  `min` _         = MinBound
_         `min` MinBound  = MinBound
NoBound a `min` NoBound b = NoBound (a `min` b)
u         `min` MaxBound  = u
MaxBound  `min` v         = v

MinBound  `max` v         = v
u         `max` MinBound  = u
NoBound a `max` NoBound b = NoBound (a `max` b)
_         `max` MaxBound  = MaxBound
MaxBound  `max` _         = MaxBound

-- Richard Smith (lilac)  contributed this code for lazier methods.
--   MaxBound `max` undefined can return full information while the default
--   implementation cannot. And likewise undefined `max` MaxBound.

-- instance Ord a => Ord (AddBounds a) where
--   a <= b = c1 a b `unamb` c2 a b
--     where c1 MinBound     _            = True
--           c1 _            MinBound     = False
--           c1 (NoBound a') (NoBound b') = a' < b'
--           c1 MaxBound     (NoBound _)  = False
--           c1 _            _            = undefined
--           c2 _            MaxBound     = True
--           c2 _            _            = undefined
--   a `min` b = c1 a b `unamb` c2 a b
--     where c1 MinBound     _            = MinBound
--           c1 (NoBound a') (NoBound b') = NoBound \$ a' `max` b'
--           c1 (NoBound _ ) MaxBound     = a
--           c1 MaxBound     (NoBound _ ) = b
--           c1 MaxBound     MaxBound     = MaxBound
--           c1 _            _            = undefined
--           c2 _            MinBound     = MinBound
--           c2 _            _            = undefined
--   a `max` b = c1 a b `unamb` c2 a b
--     where c1 MaxBound     _            = MaxBound
--           c1 (NoBound a') (NoBound b') = NoBound \$ a' `max` b'
--           c1 (NoBound _ ) MinBound     = a
--           c1 MinBound     (NoBound _ ) = b
--           c1 MinBound     MinBound     = MinBound
--           c1 _            _            = undefined
--           c2 _            MaxBound     = MaxBound
--           c2 _            _            = undefined

-- This second instance has a strange delays in a reactive-fieldtrip
-- program.  My mouse click isn't responded to until I move the mouse.

instance Arbitrary a => Arbitrary (AddBounds a) where
arbitrary = frequency [ (1 ,pure MinBound)
, (10, NoBound <\$> arbitrary)
, (1 ,pure MaxBound) ]
coarbitrary MinBound    = variant 0
coarbitrary (NoBound a) = variant 1 . coarbitrary a
coarbitrary MaxBound    = variant 2

instance (EqProp a, Eq a) => EqProp (AddBounds a) where
NoBound a =-= NoBound b = a =-= b
u =-= v = u `eq` v
```