Want more features on Pastebin? Sign Up, it's FREE!
Guest

OrdDynamic

By: gatoatigrado3 on May 2nd, 2012  |  syntax: None  |  size: 1.70 KB  |  views: 58  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  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 OrdDynamic (OrdDynamic, get_ord_dyn, mk_ord_dyn) 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 OrdDynamic = OrdDynamic
  26.     { get_type :: TypeRep,
  27.       get_ord_dyn :: forall a. Typeable a => Maybe a,
  28.       compareme :: OrdDynamic -> Ordering }
  29.  
  30. mk_ord_dyn :: forall α. (Ord α, Typeable α) => α -> OrdDynamic
  31. mk_ord_dyn x = OrdDynamic { get_type = typeOf x, get_ord_dyn = cast x, compareme = go }
  32.     where go other@(OrdDynamic { get_type, get_ord_dyn })
  33.             | get_type == typeOf x = go' (get_ord_dyn :: Maybe α)
  34.             | otherwise = compare (typeOf x) get_type
  35.           go' Nothing = error "mk_ord internal error -- TypeRep's match but types are in fact not equal!!"
  36.           go' (Just y) = compare x y
  37.  
  38. instance Eq OrdDynamic where
  39.     (OrdDynamic { compareme }) == o = compareme o == EQ
  40. instance Ord OrdDynamic where
  41.     compare (OrdDynamic { compareme }) o = compareme o
  42.  
  43. -- a small test
  44. float1 = mk_ord_dyn (1 :: Float)
  45. float2 = mk_ord_dyn (2 :: Float)
  46. int1 = mk_ord_dyn (1 :: Int)
  47. int2 = mk_ord_dyn (2 :: Int)
clone this paste RAW Paste Data