e8e150c · rowtype-yoga/purescript-native

purescript.cabal+1

compare with golang

unifiedsplit

@@ -30,6 +30,7 @@ library

30 Language.PureScript.Options

31 Language.PureScript.Declarations

32 Language.PureScript.Environment

33+ Language.PureScript.Errors

33 Language.PureScript.Kinds

34 Language.PureScript.Kinds

34 Language.PureScript.Names

35 Language.PureScript.Names

35 Language.PureScript.Types

36 Language.PureScript.Types

src/Language/PureScript/Errors.hsnew file+98

@@ -0,0 +1,98 @@

1+-----------------------------------------------------------------------------

2+--

3+-- Module : Language.PureScript.Error

5+-- License : MIT

6+--

7+-- Maintainer : Phil Freeman <paf31@cantab.net>

8+-- Stability : experimental

9+-- Portability :

10+--

11+-- |

12+--

13+-----------------------------------------------------------------------------

14+

15+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

16+

17+module Language.PureScript.Errors where

18+

19+import Data.List (intercalate)

20+import Data.Monoid

21+

22+import Control.Monad.Error

23+

24+import Language.PureScript.Declarations

25+import Language.PureScript.Options

26+import Language.PureScript.Pretty

27+import Language.PureScript.Types

28+

29+-- |

30+-- Type for sources of type checking errors

31+--

32+data UnifyErrorSource

33+ -- |

34+ -- An error which originated at a Value

35+ --

36+ = ValueError Value

37+ -- |

38+ -- An error which originated at a Type

39+ --

40+ | TypeError Type deriving (Show)

41+

42+-- |

43+-- Unification errors

44+--

45+data UnifyError = UnifyError {

46+ -- |

47+ -- Error message

48+ --

49+ unifyErrorMessage :: String

50+ -- |

51+ -- The value where the error occurred

52+ --

53+ , unifyErrorValue :: Maybe UnifyErrorSource

54+ -- |

55+ -- Optional source position information

56+ --

57+ , unifyErrorPosition :: Maybe SourcePos

58+ } deriving (Show)

59+

60+-- |

61+-- A stack trace for an error

62+--

63+newtype UnifyErrorStack = UnifyErrorStack { runUnifyErrorStack :: [UnifyError] } deriving (Show, Monoid)

64+

65+instance Error UnifyErrorStack where

66+ strMsg s = UnifyErrorStack [UnifyError s Nothing Nothing]

67+ noMsg = UnifyErrorStack []

68+

69+prettyPrintUnifyErrorStack :: Options -> UnifyErrorStack -> String

70+prettyPrintUnifyErrorStack opts (UnifyErrorStack es) =

71+ case mconcat $ map (Last . unifyErrorPosition) es of

72+ Last (Just sourcePos) -> "Error at " ++ show sourcePos ++ ": \n" ++ prettyPrintUnifyErrorStack'

73+ _ -> prettyPrintUnifyErrorStack'

74+ where

75+ prettyPrintUnifyErrorStack' :: String

76+ prettyPrintUnifyErrorStack'

77+ | optionsVerboseErrors opts =

78+ intercalate "\n" (map showError (filter isErrorNonEmpty es))

79+ | otherwise =

80+ let

81+ es' = filter isErrorNonEmpty es

82+ in case length es' of

83+ 1 -> showError (head es')

84+ _ -> showError (head es') ++ "\n" ++ showError (last es')

85+

86+isErrorNonEmpty :: UnifyError -> Bool

87+isErrorNonEmpty = not . null . unifyErrorMessage

88+

89+showError :: UnifyError -> String

90+showError (UnifyError msg Nothing _) = msg

91+showError (UnifyError msg (Just (ValueError val)) _) = "Error in value " ++ prettyPrintValue val ++ "\n" ++ msg

92+showError (UnifyError msg (Just (TypeError ty)) _) = "Error in type " ++ prettyPrintType ty ++ "\n" ++ msg

93+

94+mkUnifyErrorStack :: String -> Maybe UnifyErrorSource -> UnifyErrorStack

95+mkUnifyErrorStack msg t = UnifyErrorStack [UnifyError msg t Nothing]

96+

97+positionError :: SourcePos -> UnifyErrorStack

98+positionError pos = UnifyErrorStack [UnifyError "" Nothing (Just pos)]

src/Language/PureScript/TypeChecker.hs+1

@@ -37,6 +37,7 @@ import Language.PureScript.Kinds

37import Language.PureScript.Declarations

38import Language.PureScript.TypeClassDictionaries

39import Language.PureScript.Environment

40+import Language.PureScript.Errors

40

41

41addDataType :: ModuleName -> ProperName -> [String] -> [(ProperName, [Type])] -> Kind -> Check ()

42addDataType :: ModuleName -> ProperName -> [String] -> [(ProperName, [Type])] -> Kind -> Check ()

42addDataType moduleName name args dctors ctorKind = do

43addDataType moduleName name args dctors ctorKind = do

src/Language/PureScript/TypeChecker/Kinds.hs+1

@@ -28,6 +28,7 @@ import Language.PureScript.Names

28import Language.PureScript.TypeChecker.Monad

29import Language.PureScript.Pretty

30import Language.PureScript.Environment

31+import Language.PureScript.Errors

31

32

32import Control.Monad.State

33import Control.Monad.State

33import Control.Monad.Error

34import Control.Monad.Error

src/Language/PureScript/TypeChecker/Monad.hs+1−73

@@ -24,8 +24,8 @@ import Language.PureScript.Names

24import Language.PureScript.Declarations

25import Language.PureScript.Environment

26import Language.PureScript.TypeClassDictionaries

27−import Language.PureScript.Pretty

28import Language.PureScript.Options

27import Language.PureScript.Options

28+import Language.PureScript.Errors

29

30import Data.Maybe

31import Data.Monoid

@@ -36,78 +36,6 @@ import Control.Monad.Error

36import Control.Monad.Unify

37

38import qualified Data.Map as M

39−import Data.List (intercalate)

40−

41−-- |

42−-- Type for sources of type checking errors

43−--

44−data UnifyErrorSource

45− -- |

46− -- An error which originated at a Value

47− --

48− = ValueError Value

49− -- |

50− -- An error which originated at a Type

51− --

52− | TypeError Type deriving (Show)

53−

54−-- |

55−-- Unification errors

56−--

57−data UnifyError = UnifyError {

58− -- |

59− -- Error message

60− --

61− unifyErrorMessage :: String

62− -- |

63− -- The value where the error occurred

64− --

65− , unifyErrorValue :: Maybe UnifyErrorSource

66− -- |

67− -- Optional source position information

68− --

69− , unifyErrorPosition :: Maybe SourcePos

70− } deriving (Show)

71−

72−-- |

73−-- A stack trace for an error

74−--

75−newtype UnifyErrorStack = UnifyErrorStack { runUnifyErrorStack :: [UnifyError] } deriving (Show, Monoid)

76−

77−instance Error UnifyErrorStack where

78− strMsg s = UnifyErrorStack [UnifyError s Nothing Nothing]

79− noMsg = UnifyErrorStack []

80−

81−prettyPrintUnifyErrorStack :: Options -> UnifyErrorStack -> String

82−prettyPrintUnifyErrorStack opts (UnifyErrorStack es) =

83− case mconcat $ map (Last . unifyErrorPosition) es of

84− Last (Just sourcePos) -> "Error at " ++ show sourcePos ++ ": \n" ++ prettyPrintUnifyErrorStack'

85− _ -> prettyPrintUnifyErrorStack'

86− where

87− prettyPrintUnifyErrorStack' :: String

88− prettyPrintUnifyErrorStack'

89− | optionsVerboseErrors opts =

90− intercalate "\n" (map showError (filter isErrorNonEmpty es))

91− | otherwise =

92− let

93− es' = filter isErrorNonEmpty es

94− in case length es' of

95− 1 -> showError (head es')

96− _ -> showError (head es') ++ "\n" ++ showError (last es')

97−

98−isErrorNonEmpty :: UnifyError -> Bool

99−isErrorNonEmpty = not . null . unifyErrorMessage

100−

101−showError :: UnifyError -> String

102−showError (UnifyError msg Nothing _) = msg

103−showError (UnifyError msg (Just (ValueError val)) _) = "Error in value " ++ prettyPrintValue val ++ "\n" ++ msg

104−showError (UnifyError msg (Just (TypeError ty)) _) = "Error in type " ++ prettyPrintType ty ++ "\n" ++ msg

105−

106−mkUnifyErrorStack :: String -> Maybe UnifyErrorSource -> UnifyErrorStack

107−mkUnifyErrorStack msg t = UnifyErrorStack [UnifyError msg t Nothing]

108−

109−positionError :: SourcePos -> UnifyErrorStack

110−positionError pos = UnifyErrorStack [UnifyError "" Nothing (Just pos)]

111

39

112-- |

40-- |

113-- Temporarily bind a collection of names to values

41-- Temporarily bind a collection of names to values

src/Language/PureScript/TypeChecker/Types.hs+1

@@ -59,6 +59,7 @@ import Language.PureScript.TypeChecker.Kinds

59import Language.PureScript.TypeChecker.Synonyms

60import Language.PureScript.Pretty

61import Language.PureScript.Environment

62+import Language.PureScript.Errors

62import qualified Language.PureScript.Constants as C

63import qualified Language.PureScript.Constants as C

63

64

64import Control.Monad.State

65import Control.Monad.State