Ticket #3590: compact.hs

File compact.hs, 694 bytes (added by yairchu, 5 years ago)

much shorter version

Line 
1{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
2
3module T3590 where
4
5import Control.Monad.Reader ()
6import Control.Monad.Reader.Class (MonadReader(..))
7
8newtype ListT m a =
9  ListT { runListT :: m (Maybe (a, ListT m a)) }
10
11class Monad (ItemM l) => List l where
12  type ItemM l :: * -> *
13  joinL :: ItemM l (l a) -> l a
14
15instance Monad m => List (ListT m) where
16  type ItemM (ListT m) = m
17  joinL = ListT . (>>= runListT)
18
19crash :: ListT ((->) b) c -> ListT ((->) a) b -> ListT ((->) a) c
20crash xx yy =
21  joinL $ f . runListT yy
22  -- no panic: ListT . (>>= runListT) $ f . runListT yy
23  where
24    f (Just (y, ys)) = ListT . return $ Nothing
25    -- no panic: f = const . ListT . return $ Nothing
26