```{-# OPTIONS_GHC -fth -cpp #-}

-- | Derive 'Ord', as specified in the Haskell 98 Language Report.
module Data.Derive.Ord(makeOrd) where

#ifdef GUESS

import Data.DeriveGuess

instance Eq (DataName a) where

example = (,) "Ord" [d|

instance Ord a => Ord (DataName a) where
compare a b = check a b
where
check CtorZero CtorZero = compare () ()
check (CtorOne x1) (CtorOne y1) = compare (tup1 x1) (tup1 y1)
check (CtorTwo x1 x2) (CtorTwo y1 y2) = compare (x1,x2) (y1,y2)
check (CtorTwo' x1 x2) (CtorTwo' y1 y2) = compare (x1,x2) (y1,y2)
check a b = compare (tag a) (tag b)

tag (CtorZero{}) = 0
tag (CtorOne{}) = 1
tag (CtorTwo{}) = 2
tag (CtorTwo'{}) = 3

|]

#endif

makeOrd :: Derivation
makeOrd = derivation ord' "Ord"
ord' dat = [instance_context ["Ord"] "Ord" dat [FunD (mkName "compare") [(Clause
[(VarP (mkName "a")),(VarP (mkName "b"))] (NormalB (applyWith (VarE (mkName
"check")) [(VarE (mkName "a")),(VarE (mkName "b"))])) [FunD (mkName "check"
) ((map (\(ctorInd,ctor) -> (Clause [(ConP (mkName (ctorName ctor)) ((map (
\field -> (VarP (mkName ("x" ++ show field)))) (id [1..ctorArity ctor]))++[
])),(ConP (mkName (ctorName ctor)) ((map (\field -> (VarP (mkName ("y" ++
show field)))) (id [1..ctorArity ctor]))++[]))] (NormalB (applyWith (VarE (
mkName "compare")) [(TupE ((map (\field -> (VarE (mkName ("x" ++ show field
)))) (id [1..ctorArity ctor]))++[])),(TupE ((map (\field -> (VarE (mkName (
"y" ++ show field)))) (id [1..ctorArity ctor]))++[]))])) [])) (id (zip [0..
] (dataCtors dat))))++[(Clause [(VarP (mkName "a")),(VarP (mkName "b"))] (
NormalB (applyWith (VarE (mkName "compare")) [(AppE (VarE (mkName "tag")) (
VarE (mkName "a"))),(AppE (VarE (mkName "tag")) (VarE (mkName "b")))])) [])
]++[]),FunD (mkName "tag") ((map (\(ctorInd,ctor) -> (Clause [((flip RecP [
]) (mkName (ctorName ctor)))] (NormalB (LitE (IntegerL ctorInd))) [])) (id
(zip [0..] (dataCtors dat))))++[])])]]]

{-
-- HAND WRITTEN VERSION
-- requires O(n^2) page space (the automatic one is O(n))

ord' dat = simple_instance "Ord" dat [funN "compare" body]
where
obs  = zip [0..] (dataCtors dat)
body = [ sclause [ctp (snd x) 'a', ctp (snd y) 'b'] (rule x y)
| x <- obs , y <- obs ]

rule (i1,c1) (i2,c2) | i1 < i2   = l0 "LT"
| i1 > i2   = l0 "GT"
| otherwise = l2 "compare" (tup2 c1 'a') (tup2 c2 'b')

tup2 c ch = foldr (l2 "(,)") (lit ()) (ctv c ch)
-}
```