Result.hs revision bb3bdd4a260606a6184b5f5a5774ca6632ca597a
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann > Authors: Till Mossakowski, Klaus L�ttich
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann This module provides a Result type and some monadic functions to
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann use this type for accumulation of errors and warnings occuring
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann during the analyse phases.
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmannmodule Result where
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmannimport PrettyPrint
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmanndata Diagnosis = Error String Pos
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann | FatalError String Pos
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann | Warning String Pos
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmanndata Result a = Result [Diagnosis] (Maybe a)
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann deriving (Show)
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmanninstance Monad Result where
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann return x = Result [] $ Just x
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann Result errs Nothing >>= _ = Result errs Nothing
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann Result errs1 (Just x) >>= f = Result (errs1++errs2) y
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann where Result errs2 y = f x
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann fail s = fatal_error s nullPos
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmannfatal_error :: String -> Pos -> Result a
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmannfatal_error s p = Result [FatalError s p] Nothing
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmannnon_fatal_error :: a -> String -> Pos -> Result a
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmannnon_fatal_error x s p = Result [Error s p] $ Just x
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmannwarning :: a -> String -> Pos -> Result a
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmannwarning x s p = Result [Warning s p] $ Just x
74dfa6bc521350525358340117512f8afe9fdd26Daniel HausmannfoldResult :: b -> (b -> a -> Result b) -> [a] -> Result b
74dfa6bc521350525358340117512f8afe9fdd26Daniel HausmannfoldResult prevResult f [] = return prevResult
74dfa6bc521350525358340117512f8afe9fdd26Daniel HausmannfoldResult prevResult f (h:t) = do newResult <- f prevResult h
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann foldResult newResult f t
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmanninstance Show Diagnosis where
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann showsPrec _ d = case d of
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann showString "Error: " . showPosString p s
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann FatalError s p ->
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann showString "FatalError: " . showPosString p s
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann Warning s p ->
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann showString "Warning: " . showPosString p s
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann showPosString :: Pos -> String -> String -> String
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann showPosString p s = showString p' . showString s
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann where p' = case p of
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann (l,c) -> (showString "in line " .
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann showsPrec 0 l .
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann showString " at char " .
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann showsPrec 0 c) ": "
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann showList [] = id
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann showList [d] = showsPrec 0 d
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann showList (d:ds) = showsPrec 0 d . showString "\n" . showList ds
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmanninstance PrettyPrint Diagnosis where
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann printText0 _ = ptext . show
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmanninstance PrettyPrint a => PrettyPrint (Result a) where
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann printText0 g (Result ds m) = vcat ((case m of
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann Nothing -> empty
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann Just x -> printText0 g x) :
74dfa6bc521350525358340117512f8afe9fdd26Daniel Hausmann (map (printText0 g) ds))