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
|
------------------------------------------------------------------------------
--- A Monad for Parsers
---
--- @author Jasper Sikorra - jsi@informatik.uni-kiel.de
--- @version January 2014
------------------------------------------------------------------------------
module ParseMonad where
import ParseError
import ParseWarning
import ParsePos
--- Combining ParseResult and Warnings monads into a new monad
type PM a = WM (PR a)
--- Encapsulate an Error Monad with a Warning Monad creating a PM Monad
warnPM :: PR a -> [Warning] -> PM a
warnPM x w = returnWM x w
--- Bind
bindPM :: PM a -> (a -> PM b) -> PM b
bindPM m f = bindWM m $ \b -> case b of
Errors p -> cleanWM (Errors p)
OK x -> f x
--- Lift
liftPM :: (a -> b) -> PM a -> PM b
liftPM f m = bindPM m (cleanPM . f)
--- Return without Warnings or Errors
cleanPM :: a -> PM a
cleanPM x = warnOKPM x []
--- Return without Errors but with Warnings
warnOKPM :: a -> [Warning] -> PM a
warnOKPM x = warnPM (okPR x)
--- Return without Warnings but with Errors
throwPM :: Pos -> String -> PM _
throwPM p s = cleanWM (throwPMsg p s)
throwMultiPM :: Pos -> [String] -> PM _
throwMultiPM p strs = cleanWM (throwPR (map (\s -> (PError p s)) strs))
--- Return without Errors but with one Warning
singlePM :: a -> Warning -> PM a
singlePM x w = warnOKPM x [w]
--- Remove the Warning Monad from PM
discardWarningsPM :: PM a -> PR a
discardWarningsPM = discardWarnings
--- Extract the Warnings
getWarningsPM :: PM a -> [Warning]
getWarningsPM = getWarnings
--- Apply a function on each Warning
mapWarnsPM :: (Warning -> Warning) -> PM a -> PM a
mapWarnsPM = mapWarns
--- Crumple two Parser Monads
crumplePM :: PM (PM a) -> PM a
crumplePM m = bindPM m id
--- Swap the PM and the IO Monad
swapIOPM :: PM (IO a) -> IO (PM a)
swapIOPM m = swapIOPR (discardWarningsPM m)
>>= return . flip warnPM (getWarningsPM m)
--- Join multiple Parser Monads into one
sequencePM :: [PM a] -> PM [a]
sequencePM ms = warnPM (sequencePR (map discardWarnings ms))
(foldr (++) [] (map getWarnings ms))
--- fst defined on PM
fstPM :: PM (a,b) -> PM a
fstPM = liftPM fst
--- snd defined on PM
sndPM :: PM (a,b) -> PM b
sndPM = liftPM snd
--- combines two PMs by function f, throws error if at least one of
--- the two carries an error
combinePMs :: (a -> b -> c) -> PM a -> PM b -> PM c
combinePMs f p1 p2 = warnPM (combinePRs f (discardWarningsPM p1)
(discardWarningsPM p2))
(concatWarns p1 p2)
where
concatWarns (WM _ w1) (WM _ w2) = w1 ++ w2
|
