<commit_before>-----------------------------------------------------------------------------
--
-- Module      :  Language.PureScript.Error
-- Copyright   :  (c) 2013-14 <NAME>, (c) 2014 <NAME>, and other contributors
-- License     :  MIT
--
-- Maintainer  :  <NAME> <<EMAIL>>
-- Stability   :  experimental
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Language.PureScript.Errors where

import Data.List (intercalate)
import Data.Monoid

import Control.Monad.Error

import Language.PureScript.Declarations
import Language.PureScript.Pretty
import Language.PureScript.Types

-- |
-- Type for sources of type checking errors
--
data ErrorSource
  -- |
  -- An error which originated at a Value
  --
  = ValueError Value
  -- |
  -- An error which originated at a Type
  --
  | TypeError Type deriving (Show)

-- |
-- Compilation errors
--
data CompileError = CompileError {
    -- |
    -- Error message
    --
    compileErrorMessage :: String
    -- |
    -- The value where the error occurred
    --
  , compileErrorValue :: Maybe ErrorSource
    -- |
    -- Optional source position information
    --
  , compileErrorPosition :: Maybe SourcePos
  } deriving (Show)

-- |
-- A stack trace for an error
--
newtype ErrorStack = ErrorStack { runUnifyErrorStack :: [CompileError] } deriving (Show, Monoid)

instance Error ErrorStack where
  strMsg s = ErrorStack [CompileError s Nothing Nothing]
  noMsg = ErrorStack []

prettyPrintErrorStack :: Bool -> ErrorStack -> String
prettyPrintErrorStack printAll (ErrorStack es) =
  case mconcat $ map (Last . compileErrorPosition) es of
    Last (Just sourcePos) -> "Error at " ++ show sourcePos ++ ": \n" ++ prettyPrintUnifyErrorStack'
    _ -> prettyPrintUnifyErrorStack'
  where
  prettyPrintUnifyErrorStack' :: String
  prettyPrintUnifyErrorStack'
    | printAll = intercalate "\n" (map showError (filter isErrorNonEmpty es))
    | otherwise =
      let
        es' = filter isErrorNonEmpty es
      in case length es' of
        1 -> showError (head es')
        _ -> showError (head es') ++ "\n" ++ showError (last es')

isErrorNonEmpty :: CompileError -> Bool
isErrorNonEmpty = not . null . compileErrorMessage

showError :: CompileError -> String
showError (CompileError msg Nothing _) = msg
showError (CompileError msg (Just (ValueError val)) _) = "Error in value " ++ prettyPrintValue val ++ "\n" ++ msg
showError (CompileError msg (Just (TypeError ty)) _) = "Error in type " ++ prettyPrintType ty ++ "\n" ++ msg

mkUnifyErrorStack :: String -> Maybe ErrorSource -> ErrorStack
mkUnifyErrorStack msg t = ErrorStack [CompileError msg t Nothing]

positionError :: SourcePos -> ErrorStack
positionError pos = ErrorStack [CompileError "" Nothing (Just pos)]
<commit_msg>Module & decl error sources<commit_after>-----------------------------------------------------------------------------
--
-- Module      :  Language.PureScript.Error
-- Copyright   :  (c) 2013-14 <NAME>, (c) 2014 <NAME>, and other contributors
-- License     :  MIT
--
-- Maintainer  :  <NAME> <<EMAIL>>
-- Stability   :  experimental
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Language.PureScript.Errors where

import Data.List (intercalate)
import Data.Monoid

import Control.Monad.Error

import Language.PureScript.Declarations
import Language.PureScript.Names
import Language.PureScript.Pretty
import Language.PureScript.Types

-- |
-- Type for sources of type checking errors
--
data ErrorSource
  -- |
  -- An error which originated in a module
  --
  = ModuleError ModuleName
  -- |
  -- An error which originated at a Declaration
  --
  | DeclarationError (Either ProperName Ident)
  -- |
  -- An error which originated at a Value
  --
  | ValueError Value
  -- |
  -- An error which originated at a Type
  --
  | TypeError Type deriving (Show)

-- |
-- Compilation errors
--
data CompileError = CompileError {
    -- |
    -- Error message
    --
    compileErrorMessage :: String
    -- |
    -- The value where the error occurred
    --
  , compileErrorValue :: Maybe ErrorSource
    -- |
    -- Optional source position information
    --
  , compileErrorPosition :: Maybe SourcePos
  } deriving (Show)

-- |
-- A stack trace for an error
--
newtype ErrorStack = ErrorStack { runUnifyErrorStack :: [CompileError] } deriving (Show, Monoid)

instance Error ErrorStack where
  strMsg s = ErrorStack [CompileError s Nothing Nothing]
  noMsg = ErrorStack []

prettyPrintErrorStack :: Bool -> ErrorStack -> String
prettyPrintErrorStack printAll (ErrorStack es) =
  case mconcat $ map (Last . compileErrorPosition) es of
    Last (Just sourcePos) -> "Error at " ++ show sourcePos ++ ": \n" ++ prettyPrintUnifyErrorStack'
    _ -> prettyPrintUnifyErrorStack'
  where
  prettyPrintUnifyErrorStack' :: String
  prettyPrintUnifyErrorStack'
    | printAll = intercalate "\n" (map showError (filter isErrorNonEmpty es))
    | otherwise =
      let
        es' = filter isErrorNonEmpty es
      in case length es' of
        1 -> showError (head es')
        _ -> showError (head es') ++ "\n" ++ showError (last es')

isErrorNonEmpty :: CompileError -> Bool
isErrorNonEmpty = not . null . compileErrorMessage

showError :: CompileError -> String
showError (CompileError msg Nothing _) = msg
showError (CompileError msg (Just (ModuleError mn)) _) = "Error in module " ++ runModuleName mn ++ ":\n" ++ msg
showError (CompileError msg (Just (DeclarationError (Left pn))) _) = "Error in declaration " ++ show pn ++ ":\n" ++ msg
showError (CompileError msg (Just (DeclarationError (Right i))) _) = "Error in declaration " ++ show i ++ ":\n" ++ msg
showError (CompileError msg (Just (ValueError val)) _) = "Error in value " ++ prettyPrintValue val ++ ":\n" ++ msg
showError (CompileError msg (Just (TypeError ty)) _) = "Error in type " ++ prettyPrintType ty ++ ":\n" ++ msg

mkUnifyErrorStack :: String -> Maybe ErrorSource -> ErrorStack
mkUnifyErrorStack msg t = ErrorStack [CompileError msg t Nothing]

positionError :: SourcePos -> ErrorStack
positionError pos = ErrorStack [CompileError "" Nothing (Just pos)]

{'fraction_non_alphanumeric': 0.1589636974252359, 'fraction_numerical': 0.003518311210618903, 'mean_word_length': 2.6680351906158357, 'pattern_counts': {'":': 7, '<': 13, '<?xml version=': 0, '>': 35, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '799549', 'n_tokens_mistral': 1789, 'n_tokens_neox': 1728, 'n_words': 556}