{-  --------------------
    Generic sorting in Haskell
    Fritz Ruehr, Fal 2002
    -------------------- -}

--------------------
-- In a dozen lines, we define a generic version of 
-- quicksort, a means to "focus" predicates on extracted 
-- values, handy names for standard orderings and means 
-- for combining two or more orderings lexicographically

type Reln a = a -> a -> Bool

sort :: [a] -> Reln a -> [a]
sort []     (<) = []
sort (x:xs) (<) = rec (<x) ++ [x] ++ rec (not . (<x))
                  where rec p = sort (filter p xs) (<)

by p f x y = p (f x) (f y)

incr, decr :: Ord a => Reln a
incr = (<)
decr = (>)

andthen p q a b = p a b || not (p b a) && q a b

lexord :: [Reln a] -> Reln a
lexord = foldr1 andthen


--------------------
-- In another dozen lines, we define a "schema" for 
-- simple databases of academic courses, including 
-- print utilities and three sample ordering relations

data Level = Service | Core | Mid | Upper | Seminar  
             deriving (Eq, Ord, Show)

data Course = Course { title:: String, number:: Int, instr:: String, 
                       level:: Level,  cap:: Int } deriving Eq

instance Show Course where 
  show (Course t n i l c) = concat ["\tCS ", show n, ": ", t, "\t", i,
                              "\t(cap = ", show c, "; ", show l, ")"]

report :: Show a => [a] -> IO()
report = putStr . ('\n':) . unlines . map show

std = (incr `by` number)
itn = (incr `by` instr) `andthen` (incr `by` number)
lit = lexord [decr `by` level, incr `by` instr, incr `by` title]


--------------------
-- Finally, we define a sample database of courses
-- (note that the construction is type-safe by design)

courses = 
  [ Course  "Concepts"     130  "Temp"   Service  25,
    Course  "Ray Tracing"  140  "Jenny"  Core     20,
    Course  "Intro Prog"   231  "Staff"  Core     20,
    Course  "Data Struc"   241  "Staff"  Core     20,
    Course  "Prog Lang"    348  "Fritz"  Mid      20,
    Course  "Algorithms"   443  "Jenny"  Mid      20,
    Course  "GUI / Sim"    444  "Jim"    Upper    20,
    Course  "Automata"     446  "Fritz"  Mid      20,
    Course  "Graphics"     445  "Jenny"  Upper    20,
    Course  "Mach Learn"   448  "Jim"    Upper    20,
    Course  "Func Prog"    454  "Fritz"  Upper    10,
    Course  "Senior Sem"   496  "Staff"  Seminar  10  ]

test reln = report (sort courses reln)