SHARE
TWEET

OrdDynamic1

gatoatigrado3 May 2nd, 2012 24 Never
  1. -- Copyright 2012 gatoatigrado (nicholas tung) [ntung at ntung]
  2. -- Licensed under the Apache License, Version 2.0 (the "License"); you may
  3. -- not use this file except in compliance with the License. You may obtain a
  4. -- copy of the License at http://www.apache.org/licenses/LICENSE-2.0 .
  5.  
  6. {-# LANGUAGE FlexibleContexts,
  7.              FlexibleInstances,
  8.              NamedFieldPuns,
  9.              NoMonomorphismRestriction,
  10.              RankNTypes,
  11.              ScopedTypeVariables #-}
  12.  
  13. module Alt.Data.OrdDynamic1 (OrdDynamic1, get_ord_dyn1, mk_ord_dyn1) where
  14.  
  15. import Prelude hiding (id, (.))
  16. import Control.Arrow
  17. import Control.Applicative
  18. import Control.Category
  19. import Control.Monad
  20. import Control.Monad.Trans.Class
  21.  
  22. import Data.Dynamic
  23. import Data.Typeable
  24.  
  25. data OrdDynamic1 γ = OrdDynamic1
  26.     { get_type :: TypeRep,
  27.       get_ord_dyn1 :: forall a. Typeable a => Maybe (γ a),
  28.       compareme :: OrdDynamic1 γ -> Ordering }
  29.  
  30. mk_ord_dyn1 :: forall α γ. (Ord (γ α), Typeable α) => γ α -> OrdDynamic1 γ
  31. mk_ord_dyn1 x = OrdDynamic1 { get_type = atyp,
  32.         get_ord_dyn1 = gcast x, compareme = go }
  33.     where go other@(OrdDynamic1 { get_type, get_ord_dyn1 })
  34.             | get_type == atyp = go' (get_ord_dyn1 :: Maybe (γ α))
  35.             | otherwise = compare atyp get_type
  36.           go' Nothing = error "mk_ord internal error -- TypeRep's match but types are in fact not equal!!"
  37.           go' (Just y) = compare x y
  38.           atyp = typeOf (undefined :: α)
  39.  
  40. instance Eq (OrdDynamic1 γ) where
  41.     (OrdDynamic1 { compareme }) == o = compareme o == EQ
  42. instance Ord (OrdDynamic1 γ) where
  43.     compare (OrdDynamic1 { compareme }) o = compareme o
RAW Paste Data
Top