Result.hs revision 2f98027959ced502c0332e557618b42e41a2504a
66267bcb678a9c341272c323b299337bcfdb7cc5Christian Maeder{-|
81d182b21020b815887e9057959228546cf61b6bChristian Maeder
81d182b21020b815887e9057959228546cf61b6bChristian Maeder > HetCATS/hetcats/Result.hs
a39175891082dc8a598e5630e5558cb08b84ac0aChristian Maeder > $Id$
66267bcb678a9c341272c323b299337bcfdb7cc5Christian Maeder > Authors: Till Mossakowski, Klaus L�ttich
3f69b6948966979163bdfe8331c38833d5d90ecdChristian Maeder > Year: 2002
66267bcb678a9c341272c323b299337bcfdb7cc5Christian Maeder
ffd01020a4f35f434b912844ad6e0d6918fadffdChristian Maeder This module provides a Result type and some monadic functions to
66267bcb678a9c341272c323b299337bcfdb7cc5Christian Maeder use this type for accumulation of errors and warnings occuring
66267bcb678a9c341272c323b299337bcfdb7cc5Christian Maeder during the analyse phases.
fb69cd512eab767747f109e40322df7cae2f7bdfChristian Maeder
fb69cd512eab767747f109e40322df7cae2f7bdfChristian Maeder-}
5553cf7e344c2b385a72e1244b419e9986042b8eChristian Maeder
5553cf7e344c2b385a72e1244b419e9986042b8eChristian Maedermodule Result where
5553cf7e344c2b385a72e1244b419e9986042b8eChristian Maeder
f42bcc750a9a02cb4f753b70679f9aacf1b338d7Christian Maederimport Id
f42bcc750a9a02cb4f753b70679f9aacf1b338d7Christian Maederimport ParsecPos
f42bcc750a9a02cb4f753b70679f9aacf1b338d7Christian Maederimport PrettyPrint
5553cf7e344c2b385a72e1244b419e9986042b8eChristian Maederimport Pretty
5553cf7e344c2b385a72e1244b419e9986042b8eChristian Maeder
5553cf7e344c2b385a72e1244b419e9986042b8eChristian Maederdata DiagKind = FatalError | Error | Warning | Hint deriving (Eq, Ord, Show)
fb69cd512eab767747f109e40322df7cae2f7bdfChristian Maeder
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederdata Diagnosis = Diag { diagKind :: DiagKind
678e45c045799ce271c4719123ecd9cf4f456d4bChristian Maeder , diagString :: String
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maeder , diagPos :: Pos
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maeder }
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maederdata Result a = Result { diags :: [Diagnosis]
05e2a3161e4589a717c6fe5c7306820273a473c5Christian Maeder , maybeResult :: (Maybe a)
31a189d4cff554f78407cdc422480e84e99a6ec6Christian Maeder } deriving (Show)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder
5d7e4bf173534e7eb3fc84dce7bb0151079d3f8aChristian Maederinstance Monad Result where
f42bcc750a9a02cb4f753b70679f9aacf1b338d7Christian Maeder return x = Result [] $ Just x
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder Result errs Nothing >>= _ = Result errs Nothing
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder Result errs1 (Just x) >>= f = Result (errs1++errs2) y
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maeder where Result errs2 y = f x
f42bcc750a9a02cb4f753b70679f9aacf1b338d7Christian Maeder fail s = fatal_error s nullPos
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder
f42bcc750a9a02cb4f753b70679f9aacf1b338d7Christian Maederfatal_error :: String -> Pos -> Result a
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederfatal_error s p = Result [Diag FatalError s p] Nothing
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederplain_error :: a -> String -> Pos -> Result a
946f62de1b188898dde0c472f2a8a6fb86f4d2f5Christian Maederplain_error x s p = Result [Diag Error s p] $ Just x
6f031207ab25d41ae4740a4151d5946faff4768bChristian Maeder
6f031207ab25d41ae4740a4151d5946faff4768bChristian Maederwarning :: a -> String -> Pos -> Result a
e7ce154edb906685b3fa7f6c0a764e18a4658068Christian Maederwarning x s p = Result [Diag Warning s p] $ Just x
e7ce154edb906685b3fa7f6c0a764e18a4658068Christian Maeder
e7ce154edb906685b3fa7f6c0a764e18a4658068Christian Maederinstance Show Diagnosis where
6cb518d88084543c13aa7e56db767c14ee97ab77Christian Maeder showsPrec _ (Diag k s sp) =
6cb518d88084543c13aa7e56db767c14ee97ab77Christian Maeder shows k . colonS .
6cb518d88084543c13aa7e56db767c14ee97ab77Christian Maeder showString "in line " . shows (sourceLine sp) .
024621f43239cfe9629e35d35a8669fad7acbba2Christian Maeder showString " at char " . shows (sourceColumn sp) .
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder colonS . showString s
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder where colonS = showString ": "
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder showList [] = id
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder showList [d] = shows d
27912d626bf179b82fcb337077e5cd9653bb71cfChristian Maeder showList (d:ds) = shows d . showString "\n" . showList ds
e13ee09381f136f5eadaabdb9699773c0052cf3dChristian Maeder
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance PrettyPrint Diagnosis where
5c933f3c61d2cfa7e76e4eb610a4b0bac988be47Christian Maeder printText0 _ (Diag k s sp) =
5c933f3c61d2cfa7e76e4eb610a4b0bac988be47Christian Maeder ptext (show k)
6cb518d88084543c13aa7e56db767c14ee97ab77Christian Maeder <+> parens (int (sourceLine sp) <> comma <> int (sourceColumn sp))
6cb518d88084543c13aa7e56db767c14ee97ab77Christian Maeder <+> text s
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederinstance PrettyPrint a => PrettyPrint (Result a) where
f6fc70956d64365527d77a521a96f54a1cc18f91Christian Maeder printText0 g (Result ds m) = vcat ((case m of
51c65d5fb2d720dc77bc5cca15640cfa09711986Christian Maeder Nothing -> empty
946f62de1b188898dde0c472f2a8a6fb86f4d2f5Christian Maeder Just x -> printText0 g x) :
51c65d5fb2d720dc77bc5cca15640cfa09711986Christian Maeder (map (printText0 g) ds))
51c65d5fb2d720dc77bc5cca15640cfa09711986Christian Maeder
51c65d5fb2d720dc77bc5cca15640cfa09711986Christian Maeder