5a34984 · rowtype-yoga/purescript-native

src/Language/PureScript/Docs/Convert.hs+4−3

compare with golang

unifiedsplit

@@ -107,8 +107,9 @@ typeCheckIfNecessary modules convertedModules =

107 else pure convertedModules

108

109 where

110− hasWildcards =

110+ hasWildcards = any (isWild . declInfo) . modDeclarations

111− any ((==) (ValueDeclaration P.TypeWildcard) . declInfo) . modDeclarations

111+ isWild (ValueDeclaration P.TypeWildcard{}) = True

112+ isWild _ = False

112

113

113 go = do

114 go = do

114 checkEnv <- snd <$> typeCheck modules

115 checkEnv <- snd <$> typeCheck modules

@@ -147,7 +148,7 @@ insertValueTypes ::

147insertValueTypes env m =

148insertValueTypes env m =

148 m { modDeclarations = map go (modDeclarations m) }

149 m { modDeclarations = map go (modDeclarations m) }

149 where

150 where

150− go (d@Declaration { declInfo = ValueDeclaration P.TypeWildcard }) =

151+ go (d@Declaration { declInfo = ValueDeclaration P.TypeWildcard{} }) =

151 let

152 let

152 ident = parseIdent (declTitle d)

153 ident = parseIdent (declTitle d)

153 ty = lookupName ident

154 ty = lookupName ident

src/Language/PureScript/Docs/Convert/Single.hs+1−1

@@ -140,7 +140,7 @@ convertDeclaration (P.ValueDeclaration _ _ _ (Right (P.TypedValue _ _ ty))) titl

140convertDeclaration (P.ValueDeclaration {}) title =

141 -- If no explicit type declaration was provided, insert a wildcard, so that

142 -- the actual type will be added during type checking.

143− basicDeclaration title (ValueDeclaration P.TypeWildcard)

143+ basicDeclaration title (ValueDeclaration P.TypeWildcard{})

144convertDeclaration (P.ExternDeclaration _ ty) title =

145 basicDeclaration title (ValueDeclaration ty)

146convertDeclaration (P.DataDeclaration dtype _ args ctors) title =

src/Language/PureScript/Docs/RenderedCode/Render.hs+1−1

@@ -32,7 +32,7 @@ import Language.PureScript.Docs.Utils.MonoidExtras

32typeLiterals :: Pattern () Type RenderedCode

33typeLiterals = mkPattern match

34 where

35− match TypeWildcard =

35+ match TypeWildcard{} =

36 Just (syntax "_")

37 match (TypeVar var) =

38 Just (ident var)

src/Language/PureScript/Errors.hs+14

@@ -1,6 +1,7 @@

1{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE MultiParamTypeClasses #-}

4+{-# LANGUAGE NamedFieldPuns #-}

4

5

5module Language.PureScript.Errors where

6module Language.PureScript.Errors where

6

7

@@ -462,6 +463,8 @@ errorSuggestion err = case err of

462 ImplicitImport mn refs -> suggest $ importSuggestion mn refs Nothing

463 ImplicitImport mn refs -> suggest $ importSuggestion mn refs Nothing

463 ImplicitQualifiedImport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)

464 ImplicitQualifiedImport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)

464 HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing

465 HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing

466+ MissingTypeDeclaration ident ty -> suggest $ showIdent ident ++ " :: " ++ prettyPrintType ty

467+ WildcardInferredType ty -> suggest $ prettyPrintType ty

465 _ -> Nothing

468 _ -> Nothing

466

469

467 where

470 where

@@ -476,6 +479,17 @@ errorSuggestion err = case err of

476 qstr (Just mn) = " as " ++ runModuleName mn

479 qstr (Just mn) = " as " ++ runModuleName mn

477 qstr Nothing = ""

480 qstr Nothing = ""

478

481

482+suggestionSpan :: ErrorMessage -> Maybe SourceSpan

483+suggestionSpan e =

484+ getSpan (unwrapErrorMessage e) <$> errorSpan e

485+ where

486+ startOnly SourceSpan{spanName, spanStart} = SourceSpan {spanName, spanStart, spanEnd = spanStart}

487+

488+ getSpan simple ss =

489+ case simple of

490+ MissingTypeDeclaration{} -> startOnly ss

491+ _ -> ss

492+

479showSuggestion :: SimpleErrorMessage -> String

493showSuggestion :: SimpleErrorMessage -> String

480showSuggestion suggestion = case errorSuggestion suggestion of

494showSuggestion suggestion = case errorSuggestion suggestion of

481 Just (ErrorSuggestion x) -> x

495 Just (ErrorSuggestion x) -> x

src/Language/PureScript/Errors/JSON.hs+14−6

@@ -30,7 +30,10 @@ data ErrorPosition = ErrorPosition

30 , endColumn :: Int

31 } deriving (Show, Eq, Ord)

32

33−data ErrorSuggestion = ErrorSuggestion { replacement :: String } deriving (Show, Eq)

33+data ErrorSuggestion = ErrorSuggestion

34+ { replacement :: String

35+ , replaceRange :: Maybe ErrorPosition

36+ } deriving (Show, Eq)

34

37

35data JSONError = JSONError

38data JSONError = JSONError

36 { position :: Maybe ErrorPosition

39 { position :: Maybe ErrorPosition

@@ -40,7 +43,7 @@ data JSONError = JSONError

40 , filename :: Maybe String

43 , filename :: Maybe String

41 , moduleName :: Maybe String

44 , moduleName :: Maybe String

42 , suggestion :: Maybe ErrorSuggestion

45 , suggestion :: Maybe ErrorSuggestion

43− } deriving (Show, Eq)

46+ } deriving (Show, Eq)

44

47

45data JSONResult = JSONResult

48data JSONResult = JSONResult

46 { warnings :: [JSONError]

49 { warnings :: [JSONError]

@@ -64,7 +67,7 @@ toJSONError verbose level e =

64 (P.wikiUri e)

67 (P.wikiUri e)

65 (P.spanName <$> sspan)

68 (P.spanName <$> sspan)

66 (P.runModuleName <$> P.errorModule e)

69 (P.runModuleName <$> P.errorModule e)

67− (toSuggestion <$> P.errorSuggestion (P.unwrapErrorMessage e))

70+ (toSuggestion e)

68 where

71 where

69 sspan :: Maybe P.SourceSpan

72 sspan :: Maybe P.SourceSpan

70 sspan = P.errorSpan e

73 sspan = P.errorSpan e

@@ -75,6 +78,11 @@ toJSONError verbose level e =

75 (P.sourcePosColumn (P.spanStart ss))

78 (P.sourcePosColumn (P.spanStart ss))

76 (P.sourcePosLine (P.spanEnd ss))

79 (P.sourcePosLine (P.spanEnd ss))

77 (P.sourcePosColumn (P.spanEnd ss))

80 (P.sourcePosColumn (P.spanEnd ss))

78− toSuggestion :: P.ErrorSuggestion -> ErrorSuggestion

81+ toSuggestion :: P.ErrorMessage -> Maybe ErrorSuggestion

82+ toSuggestion em =

83+ case P.errorSuggestion $ P.unwrapErrorMessage em of

84+ Nothing -> Nothing

85+ Just s -> Just $ ErrorSuggestion (suggestionText s) (toErrorPosition <$> P.suggestionSpan em)

86+

79−-- TODO: Adding a newline because source spans chomp everything up to the next character

87+ -- TODO: Adding a newline because source spans chomp everything up to the next character

80− toSuggestion (P.ErrorSuggestion s) = ErrorSuggestion $ if null s then s else s ++ "\n"

88+ suggestionText (P.ErrorSuggestion s) = if null s then s else s ++ "\n"

src/Language/PureScript/Parser/Common.hs+8

@@ -13,6 +13,8 @@ import Language.PureScript.Parser.Lexer

13import Language.PureScript.Parser.State

14import Language.PureScript.Names

15

16+import Language.PureScript.AST.SourcePos

17+

16import qualified Text.Parsec as P

18import qualified Text.Parsec as P

17

19

18properName :: TokenParser (ProperName a)

20properName :: TokenParser (ProperName a)

@@ -120,3 +122,9 @@ readComments = P.lookAhead $ ptComments <$> P.anyToken

120--

122--

121runTokenParser :: FilePath -> TokenParser a -> [PositionedToken] -> Either P.ParseError a

123runTokenParser :: FilePath -> TokenParser a -> [PositionedToken] -> Either P.ParseError a

122runTokenParser filePath p = P.runParser p (ParseState 0) filePath

124runTokenParser filePath p = P.runParser p (ParseState 0) filePath

125+

126+-- |

127+-- Convert from Parsec sourcepos

128+--

129+toSourcePos :: P.SourcePos -> SourcePos

130+toSourcePos pos = SourcePos (P.sourceLine pos) (P.sourceColumn pos)

src/Language/PureScript/Parser/Declarations.hs+4−7

@@ -52,7 +52,7 @@ withSourceSpan f p = do

52 comments <- C.readComments

53 x <- p

54 end <- P.getPosition

55− let sp = SourceSpan (P.sourceName start) (toSourcePos start) (toSourcePos end)

55+ let sp = SourceSpan (P.sourceName start) (C.toSourcePos start) (C.toSourcePos end)

56 return $ f sp comments x

57

58kindedIdent :: TokenParser (String, Maybe Kind)

@@ -248,7 +248,7 @@ parseModule = do

248 reserved "where"

249 decls <- mark (P.many (same *> parseDeclaration))

250 end <- P.getPosition

251− let ss = SourceSpan (P.sourceName start) (toSourcePos start) (toSourcePos end)

251+ let ss = SourceSpan (P.sourceName start) (C.toSourcePos start) (C.toSourcePos end)

252 return $ Module ss comments name decls exports

253

254-- | Parse a collection of modules in parallel

@@ -275,13 +275,10 @@ parseModulesFromFiles toFilePath input = do

275toPositionedError :: P.ParseError -> ErrorMessage

276toPositionedError perr = ErrorMessage [ PositionedError (SourceSpan name start end) ] (ErrorParsingModule perr)

277 where

278− name = (P.sourceName . P.errorPos) perr

278+ name = (P.sourceName . P.errorPos) perr

279− start = (toSourcePos . P.errorPos) perr

279+ start = (C.toSourcePos . P.errorPos) perr

280 end = start

281

282−toSourcePos :: P.SourcePos -> SourcePos

283−toSourcePos pos = SourcePos (P.sourceLine pos) (P.sourceColumn pos)

284−

285-- |

282-- |

286-- Parse a collection of modules

283-- Parse a collection of modules

287--

284--

src/Language/PureScript/Parser/Types.hs+7−1

@@ -15,6 +15,8 @@ import Language.PureScript.Parser.Kinds

15import Language.PureScript.Parser.Lexer

16import Language.PureScript.Environment

17

18+import Language.PureScript.AST.SourcePos

19+

18import qualified Text.Parsec as P

20import qualified Text.Parsec as P

19import qualified Text.Parsec.Expr as P

21import qualified Text.Parsec.Expr as P

20

22

@@ -25,7 +27,11 @@ parseObject :: TokenParser Type

25parseObject = braces $ TypeApp tyObject <$> parseRow

27parseObject = braces $ TypeApp tyObject <$> parseRow

26

28

27parseTypeWildcard :: TokenParser Type

29parseTypeWildcard :: TokenParser Type

28−parseTypeWildcard = underscore >> return TypeWildcard

30+parseTypeWildcard = do

31+ start <- P.getPosition

32+ let end = P.incSourceColumn start 1

33+ underscore

34+ return $ TypeWildcard (SourceSpan (P.sourceName start) (toSourcePos start) (toSourcePos end))

29

35

30parseTypeVariable :: TokenParser Type

36parseTypeVariable :: TokenParser Type

31parseTypeVariable = do

37parseTypeVariable = do

src/Language/PureScript/Pretty/Types.hs+1−1

@@ -28,7 +28,7 @@ import Text.PrettyPrint.Boxes hiding ((<+>))

28typeLiterals :: Pattern () Type Box

29typeLiterals = mkPattern match

30 where

31− match TypeWildcard = Just $ text "_"

31+ match TypeWildcard{} = Just $ text "_"

32 match (TypeVar var) = Just $ text var

33 match (PrettyPrintObject row) = Just $ prettyPrintRowWith '{' '}' row

34 match (TypeConstructor ctor) = Just $ text $ runProperName $ disqualify ctor

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

@@ -235,7 +235,7 @@ infer' other = (, []) <$> go other

235 k' <- go ty

236 unifyKinds k k'

237 return k'

238− go TypeWildcard = freshKind

238+ go TypeWildcard{} = freshKind

239 go (TypeVar v) = do

240 Just moduleName <- checkCurrentModule <$> get

241 lookupTypeVariable moduleName (Qualified Nothing (ProperName v))

src/Language/PureScript/TypeChecker/Unify.hs+2−2

@@ -209,9 +209,9 @@ replaceVarWithUnknown ident ty = do

209replaceTypeWildcards :: (MonadWriter MultipleErrors m, MonadState CheckState m) => Type -> m Type

210replaceTypeWildcards = everywhereOnTypesM replace

211 where

212− replace TypeWildcard = do

212+ replace (TypeWildcard ss) = do

213 t <- freshType

214− tell . errorMessage $ WildcardInferredType t

214+ warnWithPosition ss $ tell . errorMessage $ WildcardInferredType t

215 return t

216 replace other = return other

217

src/Language/PureScript/Types.hs+2−2

@@ -43,7 +43,7 @@ data Type

43 -- |

44 -- A type wildcard, as would appear in a partial type synonym

45 --

46− | TypeWildcard

46+ | TypeWildcard (SourceSpan)

47 -- |

48 -- A type constructor

49 --

@@ -237,7 +237,7 @@ containsWildcards :: Type -> Bool

237containsWildcards = everythingOnTypes (||) go

238 where

239 go :: Type -> Bool

240− go TypeWildcard = True

240+ go TypeWildcard{} = True

241 go _ = False

242

243--

tests/Language/PureScript/Ide/FilterSpec.hs+1−1

@@ -8,7 +8,7 @@ import qualified Language.PureScript as P

8import Test.Hspec

9

10value :: Text -> ExternDecl

11−value s = ValueDeclaration s P.TypeWildcard

11+value s = ValueDeclaration s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

12

13modules :: [Module]

14modules =

tests/Language/PureScript/Ide/ImportsSpec.hs+5−2

@@ -36,6 +36,9 @@ listImport = testParseImport "import Data.List as List"

36consoleImport = testParseImport "import Control.Monad.Eff.Console (log) as Console"

37maybeImport = testParseImport "import Data.Maybe (Maybe(Just))"

38

39+wildcard :: P.Type

40+wildcard = P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

41+

39spec :: Spec

42spec :: Spec

40spec = do

43spec = do

41 describe "determining the importsection" $ do

44 describe "determining the importsection" $ do

@@ -65,9 +68,9 @@ spec = do

65 describe "import commands" $ do

68 describe "import commands" $ do

66 let simpleFileImports = let (_, _, i, _) = splitSimpleFile in i

69 let simpleFileImports = let (_, _, i, _) = splitSimpleFile in i

67 addValueImport i mn is =

70 addValueImport i mn is =

68− prettyPrintImportSection (addExplicitImport' (ValueDeclaration i P.TypeWildcard) mn is)

71+ prettyPrintImportSection (addExplicitImport' (ValueDeclaration i wildcard) mn is)

69 addDtorImport i t mn is =

72 addDtorImport i t mn is =

70− prettyPrintImportSection (addExplicitImport' (DataConstructor i t P.TypeWildcard) mn is)

73+ prettyPrintImportSection (addExplicitImport' (DataConstructor i t wildcard) mn is)

71 it "adds an implicit unqualified import" $

74 it "adds an implicit unqualified import" $

72 shouldBe

75 shouldBe

73 (addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))

76 (addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))

tests/Language/PureScript/Ide/MatcherSpec.hs+1−1

@@ -10,7 +10,7 @@ import qualified Language.PureScript as P

10import Test.Hspec

11

12value :: Text -> ExternDecl

13−value s = ValueDeclaration s P.TypeWildcard

13+value s = ValueDeclaration s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

14

15completions :: [Match]

16completions = [

tests/Language/PureScript/Ide/ReexportsSpec.hs+6−3

@@ -9,12 +9,15 @@ import Language.PureScript.Ide.Types

9import qualified Language.PureScript as P

10import Test.Hspec

11

12+wildcard :: P.Type

13+wildcard = P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

14+

12decl1 :: ExternDecl

15decl1 :: ExternDecl

13−decl1 = ValueDeclaration "filter" P.TypeWildcard

16+decl1 = ValueDeclaration "filter" wildcard

14decl2 :: ExternDecl

17decl2 :: ExternDecl

15−decl2 = ValueDeclaration "map" P.TypeWildcard

18+decl2 = ValueDeclaration "map" wildcard

16decl3 :: ExternDecl

19decl3 :: ExternDecl

17−decl3 = ValueDeclaration "catMaybe" P.TypeWildcard

20+decl3 = ValueDeclaration "catMaybe" wildcard

18dep1 :: ExternDecl

21dep1 :: ExternDecl

19dep1 = Dependency "Test.Foo" [] (Just "T")

22dep1 = Dependency "Test.Foo" [] (Just "T")

20dep2 :: ExternDecl

23dep2 :: ExternDecl