Created
December 9, 2013 18:24
-
-
Save ruicc/7877596 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE ConstraintKinds #-} | |
{-# LANGUAGE TypeFamilies #-} | |
import GHC.Prim (Constraint) | |
import qualified Data.Set as S | |
import qualified Data.Array.Unboxed as UA | |
-------------------------------------------------------------------------------- | |
-- RFunctor | |
class RFunctor f where | |
type RSubCats f a :: Constraint | |
type RSubCats f a = () | |
rfmap :: (RSubCats f a, RSubCats f b) => (a -> b) -> f a -> f b | |
instance RFunctor [] where | |
rfmap = map | |
instance RFunctor S.Set where | |
type RSubCats S.Set a = (Ord a) | |
rfmap = S.map | |
instance UA.Ix i => RFunctor (UA.UArray i) where | |
type RSubCats (UA.UArray i) a = UA.IArray UA.UArray a | |
rfmap = UA.amap | |
-------------------------------------------------------------------------------- | |
-- RMonad | |
class RFunctor m => RMonad m where | |
rreturn :: (RSubCats m a) => a -> m a | |
rbind :: (RSubCats m a, RSubCats m b) => m a -> (a -> m b) -> m b | |
instance RMonad S.Set where | |
rreturn = S.singleton | |
m `rbind` f = S.unions $ map f (S.toList m) | |
-------------------------------------------------------------------------------- | |
main = do | |
print $ rfmap abs (S.fromList [-2, -1, 0, 1, 2]) | |
print $ (S.fromList [-2 .. 2 :: Int]) `rbind` \x -> | |
(S.fromList [-3 .. 3 :: Int]) `rbind` \y -> | |
rreturn $ x * y |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment