Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

OrdDynamic1

By: gatoatigrado3 on May 2nd, 2012  |  syntax: None  |  size: 1.66 KB  |  views: 20  |  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 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
clone this paste RAW Paste Data