module Generics.BiGUL.Error where
import Generics.BiGUL
import Control.Monad
import Data.List
data BiGULTrace = BTSuccess
| BTError BiGULError
| forall s v. (Show s, Show v) => BTNextSV String s v BiGULTrace
| forall s. (Show s) => BTNextS String s BiGULTrace
| BTBranch Int BiGULTrace
| BTBranches [BiGULTrace]
instance Show BiGULTrace where
show BTSuccess = "success"
show (BTError e) = show e
show (BTNextSV str s v t) = str ++ "\n" ++
" source = " ++ show s ++ "\n" ++
" view = " ++ show v ++ "\n" ++ show t
show (BTNextS str s t) = str ++ "\n" ++
" source = " ++ show s ++ "\n" ++ show t
show (BTBranch i t) = "inside branch " ++ show i ++ "\n" ++ show t
show (BTBranches ts) = "all cases fail\n" ++
concat (intersperse "\n" (concat
(zipWith (\i t -> (" branch " ++ show i ++ ":") :
map (" " ++) (lines (show t))) [0..] ts)))
data BiGULError = BEFail String
| BESkipMismatch
| BESourcePatternMismatch PatError
| BEViewPatternMismatch PatError
| BEInvRearrFailed PatError
| BEViewRecoveringFailed PatError
| BEDependencyMismatch
| BECaseExhausted
| BEAdaptiveBranchRevisited
| BEPreviousBranchMatched
| BEExitConditionFailed
| BEPostVerificationFailed
| BEBranchUnmatched
| BEAdaptiveBranchMatched
indent :: String -> String
indent = unlines . map (" "++) . lines
instance Show BiGULError where
show (BEFail str) = "fail statement executed\n" ++ indent str
show BESkipMismatch = "view not determined by the source"
show (BESourcePatternMismatch e) = "source pattern mismatch\n" ++ indent (show e)
show (BEViewPatternMismatch e) = "view pattern mismatch\n" ++ indent (show e)
show (BEInvRearrFailed e) = "inverse rearrangement failed\n" ++ indent (show e)
show (BEViewRecoveringFailed e) = "view recovering failed\n" ++ indent (show e)
show BEDependencyMismatch = "second view component not determined by the first"
show BECaseExhausted = "case exhausted"
show BEAdaptiveBranchRevisited = "adaptive branch revisited"
show BEPreviousBranchMatched = "previous branch matched after branch execution"
show BEExitConditionFailed = "exit condition not satisfied after branch execution"
show BEPostVerificationFailed = "main condition not satisfied after branch execution"
show BEBranchUnmatched = "main condition not satisfied"
show BEAdaptiveBranchMatched = "adaptive branch ignored"
data PatError = PEConstantMismatch
| PELeftMismatch
| PERightMismatch
| PEIncompatibleUpdates
| PEMultipleUpdates
| PEValueUnrecoverable
| PEProdL PatError
| PEProdR PatError
| PELeft PatError
| PERight PatError
| PEIn PatError
instance Show PatError where
show PEConstantMismatch = "matching a constant pattern/expression with a different value"
show PELeftMismatch = "matching a Left pattern/expression with a Right value"
show PERightMismatch = "matching a Right pattern/expression with a Left value"
show PEIncompatibleUpdates = "matching occurrences of the same variable with different values"
show PEMultipleUpdates = "multiple occurrences of a variable that can only be used at most once"
show PEValueUnrecoverable = "no occurrences of a variable that should be used at least once"
show (PEProdL e) = "on the left of a product pattern/expression\n" ++ show e
show (PEProdR e) = "on the right of a product pattern/expression\n" ++ show e
show (PELeft e) = "inside a Left pattern/expression\n" ++ show e
show (PERight e) = "inside a Right pattern/expression\n" ++ show e
show (PEIn e) = "inside a constructor pattern/expression\n" ++ show e