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