    --  Compiler Toolkit: basic error management
    --
    --  Author : Manuel M. T. Chakravarty
    --  Created: 20 February 95
    --
    --  Version $Revision: 1.2 $ from $Date: 2004/11/13 17:26:50 $
    --
    --  Copyright (c) [1995..2000] Manuel M. T. Chakravarty
    --
    --  This library is free software; you can redistribute it and/or
    --  modify it under the terms of the GNU Library General Public
    --  License as published by the Free Software Foundation; either
    --  version 2 of the License, or (at your option) any later version.
    --
    --  This library is distributed in the hope that it will be useful,
    --  but WITHOUT ANY WARRANTY; without even the implied warranty of
    --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    --  Library General Public License for more details.
    --
    --- DESCRIPTION ---------------------------------------------------------------
    --
    --  This modules exports some auxilliary routines for error handling.
    --
    --- DOCU ----------------------------------------------------------------------
    --
    --  language: Haskell 98
    --
    --  *  the single lines of error messages shouldn't be to long as file name
    --     and position are prepended at each line
    --
    --- TODO ----------------------------------------------------------------------
    --

    module Errors (
      -- handling of internal error
      --
      interr, todo,
      --
      -- errors in the compiled program
      --
      ErrorLvl(..), Error, makeError, errorLvl, showError, errorAtPos
    ) where

    import Position (Position(..), isInternalPos)

    -- internal errors
    -- ---------------

    -- raise a fatal internal error; message may have multiple lines (EXPORTED)
    --
    interr     :: String -> a
    interr msg  = error ("INTERNAL COMPILER ERROR:\n"
                         ++ indentMultilineString 2 msg
                         ++ "\n")

    -- raise a error due to a implementation restriction; message may have multiple
    -- lines (EXPORTED)
    --
    todo     :: String -> a
    todo msg  = error ("Feature not yet implemented:\n"
                       ++ indentMultilineString 2 msg
                       ++ "\n")

    -- errors in the compiled program
    -- ------------------------------

    -- the higher the level of an error, the more critical it is (EXPORTED)
    --
    data ErrorLvl = WarningErr              -- does not affect compilation
                  | ErrorErr                -- cannot generate code
                  | FatalErr                -- abort immediately
                  deriving (Eq, Ord)

    data Error = Error ErrorLvl Position [String]  -- (EXPORTED ABSTRACTLY)

    -- note that the equality to on errors takes into account only the error level
    -- and position (not the error text)
    --
    -- note that these comparisions are expensive (the positions contain the file
    -- names as strings)
    --
    instance Eq Error where
      (Error lvl1 pos1 _) == (Error lvl2 pos2 _) = lvl1 == lvl2 && pos1 == pos2

    instance Ord Error where
      (Error lvl1 pos1 _) <  (Error lvl2 pos2 _) = pos1 < pos2
                                                   || (pos1 == pos2 && lvl1 < lvl2)
      e1                  <= e2                  = e1 < e2 || e1 == e2

    -- produce an `Error', given its level, position, and a list of lines of
    -- the error message that must not be empty (EXPORTED)
    --
    makeError :: ErrorLvl -> Position -> [String] -> Error
    makeError  = Error

    -- inquire the error level (EXPORTED)
    --
    errorLvl                 :: Error -> ErrorLvl
    errorLvl (Error lvl _ _)  = lvl

    -- converts an error into a string using a fixed format (EXPORTED)
    --
    --  * the list of lines of the error message must not be empty
    --
    --  * the format is
    --
    --     <fname>:<row>: (column <col>) [<err lvl>]
    --       >>> <line_1>
    --       <line_2>
    --         ...
    --       <line_n>
    --
    --  * internal errors (identified by a special position value) are formatted as
    --
    --     INTERNAL ERROR!
    --       >>> <line_1>
    --       <line_2>
    --         ...
    --       <line_n>
    --
    showError :: Error -> String
    showError (Error _   pos               (l:ls))  | isInternalPos pos =
      "INTERNAL ERROR!\n"
      ++ "  >>> " ++ l ++ "\n"
      ++ (indentMultilineString 2 . unlines) ls
    showError (Error lvl (Position fname row col) (l:ls))  =
      let
        prefix = fname ++ ":" ++ show (row::Int) ++ ": "
                 ++ "(column "
                 ++ show (col::Int)
                 ++ ") ["
                 ++ showErrorLvl lvl
                 ++ "] "
        showErrorLvl WarningErr = "WARNING"
        showErrorLvl ErrorErr   = "ERROR"
        showErrorLvl FatalErr   = "FATAL"
      in
      prefix ++ "\n"
      ++ "  >>> " ++ l ++ "\n"
      ++ (indentMultilineString 2 . unlines) ls
    showError (Error _  _                  []   )   = interr "Errors: showError:\
                                                            \ Empty error message!"

    errorAtPos         :: Position -> [String] -> a
    errorAtPos pos msg  = (error . showError . makeError ErrorErr pos) msg

    -- indent the given multiline text by the given number of spaces
    --
    indentMultilineString   :: Int -> String -> String
    indentMultilineString n  = unlines . (map (spaces++)) . lines
                               where
                                 spaces = take n (repeat ' ')