Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- -- 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)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement