-- Copyright 2012 gatoatigrado (nicholas tung) [ntung at ntung]
-- Licensed under the Apache License, Version 2.0 (the "License"); you may
-- not use this file except in compliance with the License. You may obtain a
-- copy of the License at http://www.apache.org/licenses/LICENSE-2.0 .

{-# LANGUAGE FlexibleContexts,
             FlexibleInstances,
             NamedFieldPuns,
             NoMonomorphismRestriction,
             RankNTypes,
             ScopedTypeVariables #-}

module OrdDynamic (OrdDynamic, get_ord_dyn, mk_ord_dyn) where

import Prelude hiding (id, (.))
import Control.Arrow
import Control.Applicative
import Control.Category
import Control.Monad
import Control.Monad.Trans.Class

import Data.Dynamic
import Data.Typeable

data OrdDynamic = OrdDynamic
    { get_type :: TypeRep,
      get_ord_dyn :: forall a. Typeable a => Maybe a,
      compareme :: OrdDynamic -> Ordering }

mk_ord_dyn :: forall α. (Ord α, Typeable α) => α -> OrdDynamic
mk_ord_dyn x = OrdDynamic { get_type = typeOf x, get_ord_dyn = cast x, compareme = go }
    where go other@(OrdDynamic { get_type, get_ord_dyn })
            | get_type == typeOf x = go' (get_ord_dyn :: Maybe α)
            | otherwise = compare (typeOf x) get_type
          go' Nothing = error "mk_ord internal error -- TypeRep's match but types are in fact not equal!!"
          go' (Just y) = compare x y

instance Eq OrdDynamic where
    (OrdDynamic { compareme }) == o = compareme o == EQ
instance Ord OrdDynamic where
    compare (OrdDynamic { compareme }) o = compareme o

-- a small test
float1 = mk_ord_dyn (1 :: Float)
float2 = mk_ord_dyn (2 :: Float)
int1 = mk_ord_dyn (1 :: Int)
int2 = mk_ord_dyn (2 :: Int)