import List
import Data.Ord

{-
class Eq a  where
  (==), (/=)       :: a -> a -> Bool
  x /= y           =  not (x == y)
  x == y           =  not (x /= y)

instance Eq Integer where 
  x == y                =  integerEq x y

instance Eq Float where
  x == y                =  floatEq x y
-}

data Tree a = Leaf a | Branch (Tree a) (Tree a)

instance Eq a => Eq (Tree a) where 
  Leaf a       == Leaf b        =  a == b
  Branch l1 r1 == Branch l2 r2  =  l1==l2 && r1==r2
  _            == _             =  False


data AdjList v e = Adj [(v,e)]
data Digraph v e = Graph [(v, AdjList v e)]

instance (Ord v, Ord e) => Eq (AdjList v e) where
  (Adj adj1) == (Adj adj2)  =  sort adj1 == sort adj2

instance (Ord v, Ord e) => Eq (Digraph v e) where
  (Graph vs1) == (Graph vs2) = 
     sortBy (comparing fst) vs1 == sortBy (comparing fst) vs2

{-
class  Eq a => Ord a  where
  (<), (<=), (>=), (>)  :: a -> a -> Bool
  max, min              :: a -> a -> a
-}

-- NOTE: This is corrected from p. 161 of the book.  In that example
-- the (<) operator was defined, but (<=) is not.  However, that leads 
-- to infinite recursion when (>) is called, given the default values
-- for Ord!  These defaults require (<=) to be defined.
-- I added a line to define (<=) on two trees in terms of (<) as is 
-- done on p. 153.
instance Ord a => Ord (Tree a)  where
  Leaf _       <  Branch _ _                      =  True
  Leaf a       <  Leaf b                          =  a < b
  Branch  _  _ <  Leaf _                          =  False
  Branch l1 r1 <  Branch l2 r2 | l1<l2            = True
                               | l1==l2 && r1<r2  = True
                               | otherwise        = False
                                
  t1 <= t2  = t1 < t2 || t1 == t2

-- Sample trees that show need for lexicographical ordering.
t1 = Branch (Leaf 1) (Leaf 3)
t2 = Branch (Leaf 2) (Leaf 2)


-- Self-printing program

main = putStrLn (quine q)
quine s = s ++ show s
q = "main = putStrLn (quine q)\nquine s = s ++ show s\nq = "

{-
class  (Eq a, Show a) => Num a  where
    (+), (-), (*) :: a -> a -> a
    negate :: a -> a
    abs, signum :: a -> a
    fromInteger :: Integer -> a

class  (Num a, Ord a) => Real a  where
    toRational ::  a -> Rational

class  (Real a, Enum a) => Integral a  where
    quot, rem, div, mod :: a -> a -> a
    quotRem, divMod :: a -> a -> (a,a)
    toInteger :: a -> Integer

class  (Num a) => Fractional a  where
    (/) :: a -> a -> a
    recip :: a -> a
    fromRational :: Rational -> a

class  (Fractional a) => Floating a  where
    pi :: a
    exp, log, sqrt :: a -> a
    (**), logBase :: a -> a -> a
    sin, cos, tan :: a -> a
    asin, acos, atan :: a -> a
    sinh, cosh, tanh :: a -> a
    asinh, acosh, atanh :: a -> a

class  (Real a, Fractional a) => RealFrac a  where
    properFraction :: (Integral b) => a -> (b,a)
    truncate, round :: (Integral b) => a -> b
    ceiling, floor :: (Integral b) => a -> b

class  (RealFrac a, Floating a) => RealFloat a  where
    floatRadix :: a -> Integer
    floatDigits :: a -> Int
    floatRange :: a -> (Int,Int)
    decodeFloat :: a -> (Integer,Int)
    encodeFloat :: Integer -> Int -> a
    exponent :: a -> Int
    significand :: a -> a
    scaleFloat :: Int -> a -> a
    isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE 
                        :: a -> Bool

intToFloat   :: Int -> Float
intToFloat  n = fromInteger (toInteger n)


class  (Eq a) => Ord a  where
    compare              :: a -> a -> Ordering
    (<), (<=), (>=), (>) :: a -> a -> Bool
    max, min             :: a -> a -> a

    compare x y
         | x == y    =  EQ
         | x <= y    =  LT
         | otherwise =  GT

    x <= y           =  compare x y /= GT
    x <  y           =  compare x y == LT
    x >= y           =  compare x y /= LT
    x >  y           =  compare x y == GT

    max x y 
         | x >= y    =  x
         | otherwise =  y
    min x y
         | x <  y    =  x
         | otherwise =  y
data  Ordering  =  LT | EQ | GT
      deriving (Eq, Ord, Enum, Read, Show, Bounded)

data Color = Red | Orange | Yellow | Green | Blue | Indigo | Violet


class  Enum a  where
    succ, pred       :: a -> a
    toEnum           :: Int -> a
    fromEnum         :: a -> Int
    enumFrom         :: a -> [a]             -- [n..]
    enumFromThen     :: a -> a -> [a]        -- [n,n'..]
    enumFromTo       :: a -> a -> [a]        -- [n..m]
    enumFromThenTo   :: a -> a -> a -> [a]   -- [n,n'..m]

    -- Minimal complete definition: toEnum, fromEnum
    succ             =  toEnum . (+1) . fromEnum
    pred             =  toEnum . (subtract 1) . fromEnum
    enumFrom x       =  map toEnum [fromEnum x ..]
    enumFromThen x y =  map toEnum [fromEnum x, fromEnum y .. ]
    enumFromTo x y   =  map toEnum [fromEnum x .. fromEnum y]
    enumFromThenTo x y z = 
                        map toEnum [fromEnum x, fromEnum y .. fromEnum z]

class  Bounded a  where
    minBound         :: a
    maxBound         :: a

-}