Result.hs revision 2f98027959ced502c0332e557618b42e41a2504a
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
{-|
> $Id$
> Authors: Till Mossakowski, Klaus L�ttich
> Year: 2002
This module provides a Result type and some monadic functions to
use this type for accumulation of errors and warnings occuring
during the analyse phases.
-}
module Result where
import Id
import ParsecPos
import PrettyPrint
import Pretty
data DiagKind = FatalError | Error | Warning | Hint deriving (Eq, Ord, Show)
data Diagnosis = Diag { diagKind :: DiagKind
, diagString :: String
, diagPos :: Pos
}
data Result a = Result { diags :: [Diagnosis]
, maybeResult :: (Maybe a)
} deriving (Show)
instance Monad Result where
return x = Result [] $ Just x
Result errs Nothing >>= _ = Result errs Nothing
Result errs1 (Just x) >>= f = Result (errs1++errs2) y
where Result errs2 y = f x
fail s = fatal_error s nullPos
fatal_error :: String -> Pos -> Result a
fatal_error s p = Result [Diag FatalError s p] Nothing
plain_error :: a -> String -> Pos -> Result a
plain_error x s p = Result [Diag Error s p] $ Just x
warning :: a -> String -> Pos -> Result a
warning x s p = Result [Diag Warning s p] $ Just x
instance Show Diagnosis where
showsPrec _ (Diag k s sp) =
shows k . colonS .
showString "in line " . shows (sourceLine sp) .
showString " at char " . shows (sourceColumn sp) .
colonS . showString s
where colonS = showString ": "
showList [] = id
showList [d] = shows d
showList (d:ds) = shows d . showString "\n" . showList ds
instance PrettyPrint Diagnosis where
printText0 _ (Diag k s sp) =
ptext (show k)
<+> parens (int (sourceLine sp) <> comma <> int (sourceColumn sp))
<+> text s
instance PrettyPrint a => PrettyPrint (Result a) where
printText0 g (Result ds m) = vcat ((case m of
Nothing -> empty
Just x -> printText0 g x) :
(map (printText0 g) ds))