{-# LANGUAGE TypeFamilies, QuasiQuotes, TypeOperators, UndecidableInstances #-}

{- |

Module      :  Type.Ord.SpineSerialize
Copyright   :  (c) The University of Kansas 2011
License     :  BSD3

Maintainer  :  nicolas.frisby@gmail.com
Stability   :  experimental
Portability :  see LANGUAGE pragmas (... GHC)

Generic type-level comparison of @type-spine@- and @type-cereal@-enabled types.

module Type.Ord.SpineSerialize
  (SpineCompare, Compare, spineSerializeType, spineSerializeTypeAsHash,
   module Type.Spine, module Type.Serialize, module Type.Ord) where

import Type.Spine
import Type.Serialize
import Type.Ord hiding (Compare)
import qualified Type.Ord as Ord

import Language.Haskell.TH (Name, Q, Dec)

type SpineCompare l r = Ord.Compare (Spine l) (Spine r)
type Compare l r = SpineCompare ([qK|*|] l) ([qK|*|] r)

type instance Ord.Compare (TypeName l) (TypeName r) =
  Ord.Compare (Serialize l) (Serialize r)
type instance Ord.Compare (lx :@ ly) (rx :@ ry) =
  OrdCase (Ord.Compare (Spine lx) (Spine rx))
     (Ord.Compare (Spine ly) (Spine ry))
type instance Ord.Compare (TypeName l) (rx :@ ry) = LT
type instance Ord.Compare (lx :@ ly) (TypeName r) = GT

spineSerializeType :: Name -> Q [Dec]
spineSerializeType n = do
  x <- serializeType n
  y <- spineType n
  return $ x ++ y

spineSerializeTypeAsHash :: Name -> Q [Dec]
spineSerializeTypeAsHash n = do
  x <- serializeTypeAsHash n
  y <- spineType n
  return $ x ++ y