Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit acdd50c

Browse files
committed
updated some of the transformers
1 parent fd51db4 commit acdd50c

File tree

7 files changed

+201
-127
lines changed

7 files changed

+201
-127
lines changed

‎Ancestors.hs‎

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
module Ancestors where
2+
3+
import Control.Monad.State
4+
import Data.List
5+
6+
data Tree a
7+
= Empty
8+
| Leaf a
9+
| Node a
10+
(Tree a)
11+
(Tree a)
12+
deriving (Show, Eq)
13+
14+
lowestCommon :: Ord a => a -> a -> Tree a -> a
15+
lowestCommon x y t = minimum $ intersect listA listB
16+
where
17+
listA = execState (findAncestors x t) []
18+
listB = execState (findAncestors y t) []
19+
20+
findAncestors :: Eq a => a -> Tree a -> State [a] Bool
21+
findAncestors _ Empty = return False
22+
findAncestors x (Leaf y)
23+
| x == y = return True
24+
| otherwise = return False
25+
findAncestors x (Node y left right)
26+
| x == y = return True
27+
| otherwise = do
28+
left' <- findAncestors x left
29+
right' <- findAncestors x right
30+
if left' || right'
31+
then modify ((:) x) >> return True
32+
else return False
33+
34+
testTree =
35+
Node
36+
6
37+
(Node 3 (Leaf 17) (Leaf 11))
38+
(Node 5 (Node 1 (Leaf 11) (Leaf 7)) (Leaf 9))

‎EitherT.hs‎

Lines changed: 31 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,39 +1,47 @@
1-
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies ,FlexibleInstances #-}
1+
{-# LANGUAGE FlexibleInstances #-}
2+
{-# LANGUAGE FunctionalDependencies #-}
3+
{-# LANGUAGE MultiParamTypeClasses #-}
4+
25
module EitherT where
36

4-
import Control.Monad
7+
import Control.Monad
58

6-
newtype MyEitherT l m r = MyEitherT { runMyEitherT :: m (Either l r)}
9+
newtype MyEitherT l m r = MyEitherT
10+
{ runMyEitherT :: m (Either l r)
11+
}
712

813
class MonadTrans t where
9-
lift :: Monad m => m a -> t m a
14+
lift :: Monad m => m a -> t m a
1015

11-
class (Show e, Monad m) => (MonadError e m) where
12-
eFail :: e -> m a
13-
eHandle :: m a -> (e -> m a) -> m a
16+
class (Show e, Monad m) =>
17+
(MonadError e m) where
18+
eFail :: e -> m a
19+
eHandle :: m a -> (e -> m a) -> m a
1420

1521
instance (Monad m) => Functor (MyEitherT l m) where
16-
fmap = liftM
22+
fmap = liftM
1723

1824
instance (Monad m) => Applicative (MyEitherT l m) where
19-
pure = MyEitherT . pure . Right
20-
(<*>) = ap
25+
pure = MyEitherT . pure . Right
26+
(<*>) = ap
2127

2228
instance (Monad m) => Monad (MyEitherT l m) where
23-
return = pure
24-
a >>= b = MyEitherT $ do
25-
a' <- runMyEitherT a
26-
case a' of
27-
Left err -> return $ Left err
28-
Right res -> runMyEitherT $ b res
29+
return = pure
30+
(MyEitherT a) >>= b =
31+
MyEitherT $ do
32+
a' <- a
33+
case a' of
34+
Left err -> pure . Left $ err
35+
Right res -> runMyEitherT $ b res
2936

3037
instance MonadTrans (MyEitherT l) where
31-
lift = MyEitherT . liftM Right
38+
lift = MyEitherT . fmap Right
3239

3340
instance (Show l, Monad m) => MonadError l (MyEitherT l m) where
34-
eFail l = MyEitherT $ return $ Left l
35-
eHandle m1 m2 = MyEitherT $ do
36-
m1' <- runMyEitherT m1
37-
case m1' of
38-
Right res -> return m1'
39-
Left err -> runMyEitherT $ m2 err
41+
eFail = MyEitherT . return . Left
42+
eHandle m1 m2 =
43+
MyEitherT $ do
44+
m1' <- runMyEitherT m1
45+
case m1' of
46+
Right res -> return m1'
47+
Left err -> runMyEitherT $ m2 err

‎ErrorT.hs‎

Lines changed: 35 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -1,40 +1,47 @@
1-
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
1+
{-# LANGUAGE FlexibleInstances #-}
2+
{-# LANGUAGE MultiParamTypeClasses #-}
3+
24
module ErrorT where
35

4-
import Control.Monad
5-
import Data.Either
6+
import Control.Monad
7+
import Data.Either
68

7-
newtype MyErrorT l m r = MyErrorT { runMyErrorT :: m (Either l r) }
9+
newtype MyErrorT l m r = MyErrorT
10+
{ runMyErrorT :: m (Either l r)
11+
}
812

913
class MonadTrans t where
10-
lift :: Monad m => m a -> t m a
11-
12-
class Monad m => MonadException e m where
13-
throw :: e -> m a
14-
catch :: m a -> (e -> m a) -> m a
14+
lift :: Monad m => m a -> t m a
1515

16-
instance Monad m => Monad (MyErrorT l m) where
17-
return = pure
18-
x >>= y = MyErrorT $ do
19-
res <- runMyErrorT x
20-
case res of
21-
Right val -> runMyErrorT $ y val
22-
Left err -> return $ Left err
16+
class Monad m =>
17+
MonadException e m where
18+
throw :: e -> m a
19+
catch :: m a -> (e -> m a) -> m a
2320

2421
instance Monad m => Functor (MyErrorT l m) where
25-
fmap = liftM
22+
fmap = liftM
2623

2724
instance Monad m => Applicative (MyErrorT l m) where
28-
pure = MyErrorT . return . Right
29-
(<*>) = ap
25+
pure = MyErrorT . pure . Right
26+
(<*>) = ap
27+
28+
instance Monad m => Monad (MyErrorT l m) where
29+
return = pure
30+
(MyErrorT x) >>= y =
31+
MyErrorT $ do
32+
res <- x
33+
case res of
34+
Right val -> runMyErrorT $ y val
35+
Left err -> return $ Left err
3036

3137
instance MonadTrans (MyErrorT l) where
32-
lift = MyErrorT . liftM Right
33-
34-
instance Monad m => MonadException l (MyErrorT l m) where
35-
throw = MyErrorT . return . Left
36-
catch m1 m2 = MyErrorT $ do
37-
m1' <- runMyErrorT m1
38-
case m1' of
39-
Left err -> runMyErrorT $ m2 err
40-
Right _ -> return m1'
38+
lift = MyErrorT . fmap Right
39+
40+
instance Monad m => MonadException l (MyErrorT l m) where
41+
throw = MyErrorT . return . Left
42+
catch m1 m2 =
43+
MyErrorT $ do
44+
m1' <- runMyErrorT m1
45+
case m1' of
46+
Left err -> runMyErrorT $ m2 err
47+
Right _ -> return m1'

‎MaybeT.hs‎

Lines changed: 27 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,39 +1,43 @@
11
module MaybeT where
22

3-
import Control.Monad
3+
import Control.Monad
44

5-
newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
5+
newtype MaybeT m a = MaybeT
6+
{ runMaybeT :: m (Maybe a)
7+
}
68

79
class MonadTrans t where
8-
lift :: Monad m => m a -> t m a
10+
lift :: Monad m => m a -> t m a
911

10-
class Monad m => MonadError m where
11-
eFail :: m a
12-
eHandle :: m a -> m a -> m a
12+
class Monad m =>
13+
MonadError m where
14+
eFail :: m a
15+
eHandle :: m a -> m a -> m a
1316

1417
instance Monad m => Functor (MaybeT m) where
15-
fmap = liftM
18+
fmap = liftM
1619

1720
instance Monad m => Applicative (MaybeT m) where
18-
pure = MaybeT . return . Just
19-
(<*>) = ap
21+
pure = MaybeT . return . Just
22+
(<*>) = ap
2023

2124
instance Monad m => Monad (MaybeT m) where
22-
return = pure
23-
a >>= b = MaybeT $ do
24-
a' <- runMaybeT a
25-
case a' of
26-
Just val -> runMaybeT $ b val
27-
Nothing -> return Nothing
25+
return = pure
26+
a >>= b =
27+
MaybeT $ do
28+
a' <- runMaybeT a
29+
case a' of
30+
Just val -> runMaybeT $ b val
31+
Nothing -> return Nothing
2832

2933
instance MonadTrans MaybeT where
30-
lift = MaybeT . liftM Just
34+
lift = MaybeT . fmap Just
3135

3236
instance Monad m => MonadError (MaybeT m) where
33-
eFail = MaybeT $ return Nothing
34-
eHandle m1 m2 =MaybeT$do
35-
m1' <- runMaybeT m1
36-
case m1' of
37-
Just _ ->returnm1'
38-
Nothing-> runMaybeT m2
39-
37+
eFail = MaybeT $ return Nothing
38+
eHandle m1 m2 =
39+
MaybeT$do
40+
m1' <- runMaybeT m1
41+
casem1'of
42+
Just _ -> return m1'
43+
Nothing-> runMaybeT m2

‎ReaderT.hs‎

Lines changed: 23 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -1,33 +1,38 @@
1-
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
1+
{-# LANGUAGE FlexibleInstances #-}
2+
{-# LANGUAGE FunctionalDependencies #-}
3+
{-# LANGUAGE InstanceSigs #-}
4+
{-# LANGUAGE MultiParamTypeClasses #-}
5+
26
module ReaderT where
37

4-
import Control.Monad
8+
import Control.Monad
59

6-
newtype MyReaderT r m a = MyReaderT { runMyReaderT :: r -> m a }
10+
newtype MyReaderT r m a = MyReaderT
11+
{ runMyReaderT :: r -> m a
12+
}
713

814
class MonadTrans t where
9-
lift :: m a -> t m a
15+
lift :: m a -> t m a
1016

11-
class Monad m => (MonadReader r m) where
12-
ask :: m r
13-
asks :: (r -> a) -> m a
17+
class Monad m =>
18+
(MonadReader r m) where
19+
ask :: m r
20+
asks :: (r -> a) -> m a
1421

1522
instance Monad m => Functor (MyReaderT r m) where
16-
fmap = liftM
23+
fmap = liftM
1724

1825
instance Monad m => Applicative (MyReaderT r m) where
19-
pure a = MyReaderT $ \_ -> return a
20-
(<*>) = ap
26+
pure a = MyReaderT $ \_ -> return a
27+
(<*>) = ap
2128

2229
instance Monad m => Monad (MyReaderT r m) where
23-
return = pure
24-
a >>= b = MyReaderT $ \ r -> do
25-
a' <- runMyReaderT a r
26-
runMyReaderT (b a') r
30+
return = pure
31+
(MyReaderT a) >>= b = MyReaderT $ \r -> a r >>= flip runMyReaderT r . b
2732

2833
instance MonadTrans (MyReaderT r) where
29-
lift m = MyReaderT $ \_ -> m
30-
34+
lift m = MyReaderT $ \_ -> m
35+
3136
instance Monad m => MonadReader r (MyReaderT r m) where
32-
ask = MyReaderT $ \r -> return r
33-
asks a = MyReaderT $ \r -> return $ a r
37+
ask = MyReaderT $ \r -> return r
38+
asks a = MyReaderT $ \r -> return $ a r

‎StateT.hs‎

Lines changed: 23 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -1,35 +1,40 @@
1-
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
1+
{-# LANGUAGE FlexibleInstances #-}
2+
{-# LANGUAGE MultiParamTypeClasses #-}
3+
24
module StateT where
35

4-
import Control.Monad
6+
import Control.Monad
57

6-
newtype MyStateT s m a = MyStateT { runMyStateT :: s -> m (a,s) }
8+
newtype MyStateT s m a = MyStateT
9+
{ runMyStateT :: s -> m (a, s)
10+
}
711

812
class MonadTrans t where
9-
lift :: Monad m => m a -> t m a
13+
lift :: Monad m => m a -> t m a
1014

1115
class (MonadState s m) where
12-
get :: m s
13-
put :: s -> m ()
14-
modify :: (s -> s) -> m ()
16+
get :: m s
17+
put :: s -> m ()
18+
modify :: (s -> s) -> m ()
1519

1620
instance Monad m => Functor (MyStateT s m) where
17-
fmap = liftM
21+
fmap = liftM
1822

1923
instance Monad m => Applicative (MyStateT s m) where
20-
pure a = MyStateT $ \s -> return (a,s)
21-
(<*>) = ap
24+
pure a = MyStateT $ \s -> return (a,s)
25+
(<*>) = ap
2226

2327
instance Monad m => Monad (MyStateT s m) where
24-
return = pure
25-
x >>= y = MyStateT $ \ s -> do
26-
(x',s') <- runMyStateT x s
27-
runMyStateT (y x') s'
28+
return = pure
29+
(MyStateT a) >>= b =
30+
MyStateT $ \s -> do
31+
(a', s') <- a s
32+
runMyStateT (b a') s'
2833

2934
instance MonadTrans (MyStateT s) where
30-
lift m = MyStateT $ \s -> liftM (flip (,) s) m
35+
lift m = MyStateT $ \s -> flip (,) s<$> m
3136

3237
instance Monad m => MonadState s (MyStateT s m) where
33-
get = MyStateT $ \s -> return (s,s)
34-
put s = MyStateT $ \_ -> return ((),s)
35-
modify f = get >>= put . f
38+
get = MyStateT $ \s -> return (s,s)
39+
put s = MyStateT $ \_ -> return ((),s)
40+
modify f = get >>= put . f

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /