Skip to content

Instantly share code, notes, and snippets.

@ChristopherKing42
Last active November 30, 2017 21:03
Show Gist options
  • Save ChristopherKing42/ea35bb0aad61ab0b98aa2ff3426e0446 to your computer and use it in GitHub Desktop.
Save ChristopherKing42/ea35bb0aad61ab0b98aa2ff3426e0446 to your computer and use it in GitHub Desktop.
{-# LANGUAGE Rank2Types, FunctionalDependencies, FlexibleInstances #-}
import Control.Monad (liftM, ap)
import qualified Data.Set as S
newtype SM a = SM {fromSM :: forall r. SetM a r => r}
class SetM a r | r -> a where
{-Instances of 'SetM' must satisfy the following laws:
* @'fromSet' s = 'fromList' $ 'Data.Set.toList' s@
* @'fromList' l = 'fromSet' $ 'Data.Set.fromList' l@-}
fromSet :: Ord a => S.Set a -> r
fromSet s = fromList $ S.toList s
fromList :: [a] -> r
instance SetM a (SM a) where
fromSet s = SM $ fromSet s
fromList l = SM $ fromList l
instance Ord a => SetM a (S.Set a) where
fromSet = id
fromList = S.fromList
newtype Shower a = Shower {unShower :: String}
instance (Show a, Ord a) => SetM a (Shower a) where
fromSet s = Shower $ "fromList " ++ show (S.toList s)
fromList l = fromSet (S.fromList l)
instance (Show a, Ord a) => Show (SM a) where
show (SM s) = unShower s
newtype Bind a b = Bind {unBind :: (a -> SM b) -> SM b}
instance SetM a (Bind a b) where
fromList l = Bind $ \f -> collect $ map f l
newtype Collect a = Collect {withOne :: [a] -> [SM a] -> SM a}
instance SetM a (Collect a) where
fromList l = Collect $ \l' sms -> collect' (l++l') sms
fromSet s = Collect $ \l' sms -> fromSet $ s `S.union` (fromSM $ collect' l' sms)
fromOrdList :: (SetM a r, Ord a) => [a] -> r
fromOrdList = fromSet . S.fromList
collect' l [] = fromList l
collect' l (s:ms) = withOne (fromSM s) l ms
collect sms = collect' [] sms --Will use fromSet if any of sms uses fromSet. Otherwise uses fromList.
instance Monad SM where
a >>= f = unBind (fromSM a) f
a >> b = a *> b --Will be more efficient when (<$) is implemented.
instance Functor SM where
fmap = liftM
--Todo: Implement more efficient (<$) operation (only 'a <$ fromSet s' can be made more efficient).
instance Applicative SM where
pure a = fromList [a]
(<*>) = ap
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment