blob: 905e730ccfdeef969f5bfe1aebfdaa974091d03a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
-- Our Parse monad is not a perfect replacement for its earlier
-- counterpart. Because we are using Maybe instead of Either to represent a
-- result, we can't report any useful information if a parse fails.
--
-- Create an EitherT sometype monad transformer, and use it to implement a more
-- capable Parse monad that can report an error message if parsing fails.
--
-- Tip: If you like to explore the Haskell libraries for fun, you may have run
-- across an existing Monad instance for the Either type in the
-- Control.Monad.Error module. We suggest that you do not use that as a
-- guide. Its design is too restrictive: it turns Either String into a monad,
-- when you could use a type parameter instead of String.
--
-- Hint: if you follow this suggestion, you'll probably need to use the
-- FlexibleInstances language extension in your definition.
{-# LANGUAGE UndecidableInstances #-}
import Control.Monad
import Control.Monad.Trans
import Control.Monad.State
import Data.Int (Int64)
import qualified Data.ByteString.Lazy as L
{-- From examples/examples/ch18/MaybeTParse.hs and modified --}
data ParseState = ParseState {
string :: L.ByteString
, offset :: Int64
} deriving (Show)
newtype Parse a = P {
runP :: EitherT (State ParseState) a
-- Added Functor and Applicative to deriving
} deriving (Functor, Applicative, Monad, MonadState ParseState)
evalParse :: Parse a -> L.ByteString -> Either String a
evalParse m s = evalState (runEitherT (runP m)) (ParseState s 0)
{-- End of code from examples --}
{-- From examples/examples/ch18/MaybeT.hs and modified --}
newtype EitherT m a = EitherT {
runEitherT :: m (Either String a)
}
bindET :: (Monad m) => EitherT m a -> (a -> EitherT m b) -> EitherT m b
x `bindET` f = EitherT $ do
unwrapped <- runEitherT x
case unwrapped of
Left err -> return $ Left err
Right y -> runEitherT (f y)
failET :: (Monad m) => String -> EitherT m a
failET err = EitherT $ return $ Left err
instance (Monad m) => Monad (EitherT m) where
-- Use 'pure' as suggested by the GHC instead of noncanonical 'return'
-- definition (like the 'returnMT')
return = pure
(>>=) = bindET
instance (Monad m) => MonadFail (EitherT m) where
fail s = failET s
instance MonadTrans EitherT where
lift m = EitherT (Right `liftM` m)
instance (Functor m) => Functor (EitherT m) where
fmap f x = EitherT $ fmap (fmap f) . runEitherT $ x
instance (Applicative m) => Applicative (EitherT m) where
pure :: a -> EitherT m a
pure x = EitherT $ pure $ Right x
(<*>) :: EitherT m (a -> b) -> EitherT m a -> EitherT m b
ff <*> fa = EitherT $ (fmap x (runEitherT ff)) <*> (runEitherT fa)
where
x :: Either String (a -> b) -> Either String a -> Either String b
x f a = f <*> a
instance (MonadState s m) => MonadState s (EitherT m) where
get = lift get
put k = lift (put k)
{-- End of code from examples --}
identityParse :: a -> Parse a
identityParse x = P $ pure x
failParse :: a -> Parse a
failParse _ = P $ fail "Test error in fail"
-- ghci> :l 18_b_1.hs
-- [1 of 2] Compiling Main ( 18_b_1.hs, interpreted )
-- Ok, one module loaded.
-- ghci> evalParse (identityParse 123) L.empty
-- Right 123
-- ghci> evalParse (identityParse "Test value") L.empty
-- Right "Test value"
-- ghci> evalParse (failParse "Test value") L.empty
-- Left "Test error in fail"
|
