-- 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 Alt.Data.OrdDynamic1 (OrdDynamic1, get_ord_dyn1, mk_ord_dyn1) 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 OrdDynamic1 γ = OrdDynamic1
{ get_type :: TypeRep,
get_ord_dyn1 :: forall a. Typeable a => Maybe (γ a),
compareme :: OrdDynamic1 γ -> Ordering }
mk_ord_dyn1 :: forall α γ. (Ord (γ α), Typeable α) => γ α -> OrdDynamic1 γ
mk_ord_dyn1 x = OrdDynamic1 { get_type = atyp,
get_ord_dyn1 = gcast x, compareme = go }
where go other@(OrdDynamic1 { get_type, get_ord_dyn1 })
| get_type == atyp = go' (get_ord_dyn1 :: Maybe (γ α))
| otherwise = compare atyp 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
atyp = typeOf (undefined :: α)
instance Eq (OrdDynamic1 γ) where
(OrdDynamic1 { compareme }) == o = compareme o == EQ
instance Ord (OrdDynamic1 γ) where
compare (OrdDynamic1 { compareme }) o = compareme o