content: -- | Results of BASIC computations, including errors.
  
  module Language.VintageBasic.Result(Result(..),RuntimeException(..),RuntimeError(..)) where
  
  import Control.Monad.CPST.DurableTraps(ResultType(..))
  import Language.VintageBasic.Printer(printVarName)
  import Language.VintageBasic.Syntax(Label,VarName)
  import Text.ParserCombinators.Parsec(sourceLine,sourceColumn)
  import Text.ParserCombinators.Parsec.Error(ParseError,errorMessages,errorPos,showErrorMessages)
  
  -- | The ultimate result value of a BASIC program.
  data Result =
      Pass                                             -- ^ normal termination
      | ScanError ParseError                           -- ^ error in scanning line numbers
      | SyntaxError ParseError                         -- ^ tokenization or parsing error
      | LabeledRuntimeException Label RuntimeException -- ^ runtime exception (with line number)
  
  instance ResultType Result where
      okValue = Pass
  
  data RuntimeException =
      RuntimeError RuntimeError
      | Next (Maybe String)     -- ^ generated by @NEXT@
      | Return                  -- ^ generated by @RETURN@
  
  instance Show Result where
      show Pass = "NORMAL TERMINATION"
      show (ScanError pe) = showParseError "LINE NUMBERING" "RAW LINE" "END OF FILE" pe
      show (SyntaxError pe) = showParseError "SYNTAX" "LINE" "END OF LINE" pe
      show (LabeledRuntimeException label x) = show x ++ " IN LINE " ++ show label
  
  instance Show RuntimeException where
      show (RuntimeError err) = show err
      show (Next Nothing) = "!NEXT WITHOUT FOR ERROR"
      show (Next (Just s)) = "!NEXT WITHOUT FOR ERROR (VAR "++s++")"
      show Return = "!RETURN WITHOUT GOSUB ERROR"
  
  data RuntimeError =
      TypeMismatchError
      | WrongNumberOfArgumentsError
      | InvalidArgumentError
      | DivisionByZeroError
      | BadGotoTargetError Label
      | BadGosubTargetError Label
      | BadRestoreTargetError Label
      | NegativeArrayDimError
      | ReDimensionedArrayError
      | MismatchedArrayDimensionsError
      | OutOfArrayBoundsError
      | UndefinedFunctionError VarName
      | OutOfDataError
      | EndOfInputError
    deriving Eq
  
  instance Show RuntimeError where
      show TypeMismatchError = "!TYPE MISMATCH"
      show WrongNumberOfArgumentsError = "!WRONG NUMBER OF ARGUMENTS"
      show InvalidArgumentError = "!INVALID ARGUMENT"
      show DivisionByZeroError = "!DIVISION BY ZERO"
      show (BadGotoTargetError lab) = "!BAD GOTO TARGET " ++ show lab
      show (BadGosubTargetError lab) = "!BAD GOSUB TARGET " ++ show lab
      show (BadRestoreTargetError lab) = "!BAD RESTORE TARGET " ++ show lab
      show NegativeArrayDimError = "!NEGATIVE ARRAY DIM"
      show ReDimensionedArrayError = "!REDIM'D ARRAY"
      show MismatchedArrayDimensionsError = "!MISMATCHED ARRAY DIMENSIONS"
      show OutOfArrayBoundsError = "!OUT OF ARRAY BOUNDS"
      show (UndefinedFunctionError vn) = "!UNDEFINED FUNCTION " ++ printVarName vn
      show OutOfDataError = "!OUT OF DATA"
      show EndOfInputError = "!END OF INPUT"
  
  showParseError
      :: String     -- ^ message describing the type of error
      -> String     -- ^ description of source line: @LINE@ or @RAW LINE@
      -> String     -- ^ what to call end of input
      -> ParseError -- ^ the parse error to show as text
      -> String
  showParseError msgErrorType msgLine msgEndOfInput parseError =
      let pos = errorPos parseError
          messages = errorMessages parseError
          line = sourceLine pos
          col = sourceColumn pos
      in
          "!" ++ msgErrorType ++ " ERROR IN " ++ msgLine ++ " " ++ show line
          ++ ", COLUMN " ++ show col
          ++ showErrorMessages "OR" " UNKNOWN" " EXPECTING" " UNEXPECTED" msgEndOfInput messages
  