git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

core-tests/tests/generic-deriving/Main.purs+5−5

@@ -2,18 +2,18 @@ module GenericDeriving where

22

33import Prelude

44

5−import Control.Monad.Eff (Eff())

6−import Control.Monad.Eff.Console (CONSOLE())

5+import Control.Monad.Eff (Eff)

6+import Control.Monad.Eff.Console (CONSOLE, log)

77import Data.Generic

88

99data Void

1010

1111derive instance genericVoid :: Generic Void

1212

13−data A a

13+data A a

1414 = A Number String

1515 | B Int

16− | C (Array (A a))

16+ | C (Array (A a))

1717 | D { "asgård" :: a }

1818 | E Void

1919

@@ -24,4 +24,4 @@ newtype X b = X b

2424derive instance genericX :: Generic (X String)

2525

2626main :: forall eff. Eff (console :: CONSOLE | eff) Unit

27−main = Control.Monad.Eff.Console.log (gShow (D { "asgård": C [ A 1.0 "test", B 42, D { "asgård": true } ] }))

27+main = log (gShow (D { "asgård": C [ A 1.0 "test", B 42, D { "asgård": true } ] }))

examples/failing/ExportExplicit1.purs+2−1

@@ -2,10 +2,11 @@

22module Main where

33

44import M1

5+import Control.Monad.Eff.Console (log)

56

67testX = X

78

89-- should fail as Y constructor is not exported from M1

910testY = Y

1011

11−main = Control.Monad.Eff.Console.log "Done"

12+main = log "Done"

examples/failing/ExportExplicit3.purs+4−3

@@ -1,9 +1,10 @@

11-- @shouldFailWith UnknownName

22module Main where

33

4−import M1

4+import M1 as M

5+import Control.Monad.Eff.Console (log)

56

67-- should fail as Z is not exported from M1

7−testZ = M1.Z

8+testZ = M.Z

89

9−main = Control.Monad.Eff.Console.log "Done"

10+main = log "Done"

examples/failing/RowConstructors1.purs+2−2

@@ -1,9 +1,9 @@

11-- @shouldFailWith KindsDoNotUnify

22module Main where

33

4−import Prelude

4+import Control.Monad.Eff.Console (log)

55

66data Foo = Bar

77type Baz = { | Foo }

88

9−main = Control.Monad.Eff.Console.log "Done"

9+main = log "Done"

examples/failing/RowConstructors2.purs+2−2

@@ -1,9 +1,9 @@

11-- @shouldFailWith KindsDoNotUnify

22module Main where

33

4−import Prelude

4+import Control.Monad.Eff.Console (log)

55

66type Foo r = (x :: Number | r)

77type Bar = { | Foo }

88

9−main = Control.Monad.Eff.Console.log "Done"

9+main = log "Done"

examples/failing/RowConstructors3.purs+2−2

@@ -1,9 +1,9 @@

11-- @shouldFailWith KindsDoNotUnify

22module Main where

33

4−import Prelude

4+import Control.Monad.Eff.Console (log)

55

66type Foo = { x :: Number }

77type Bar = { | Foo }

88

9−main = Control.Monad.Eff.Console.log "Done"

9+main = log "Done"

examples/failing/TypedBinders.purs+3−3

@@ -1,10 +1,10 @@

1−-- @shouldFailWith ErrorParsingModule

1+-- @shouldFailWith ErrorParsingModule

22module Main where

33

4−import Prelude

4+import Control.Monad.Eff.Console (log)

55

66test = (\f :: Int -> Int -> f 10) id

77

88main = do

99 let t1 = test

10− Control.Monad.Eff.Console.log "Done"

10+ log "Done"

examples/failing/TypedBinders2.purs+3−3

@@ -2,8 +2,8 @@

22module Main where

33

44import Prelude

5+import Control.Monad.Eff.Console (log)

56

67main = do

7− s :: String <- Control.Monad.Eff.Console.log "Foo"

8− Control.Monad.Eff.Console.log "Done"

9−

8+ s :: String <- log "Foo"

9+ log "Done"

examples/failing/TypedBinders3.purs+2−1

@@ -2,6 +2,7 @@

22module Main where

33

44import Prelude

5+import Control.Monad.Eff.Console (log)

56

67test = case 1 of

78 (0 :: String) -> true

@@ -9,4 +10,4 @@ test = case 1 of

910

1011main = do

1112 let t = test

12− Control.Monad.Eff.Console.log "Done"

13+ log "Done"

examples/failing/UnderscoreModuleName.purs+2−2

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

11-- @shouldFailWith ErrorParsingModule

22module Bad_Module where

33

4−import Prelude

4+import Control.Monad.Eff.Console (log)

55

6−main = Control.Monad.Eff.Console.log "Done"

6+main = log "Done"

examples/passing/1185.purs+3−1

@@ -1,5 +1,7 @@

11module Main where

22

3+import Control.Monad.Eff.Console (log)

4+

35data Person = Person String Boolean

46

57getName :: Person -> String

@@ -10,4 +12,4 @@ getName p = case p of

1012name :: String

1113name = getName (Person "John Smith" true)

1214

13−main = Control.Monad.Eff.Console.log "Done"

15+main = log "Done"

examples/passing/1570.purs+3−1

@@ -1,6 +1,8 @@

11module Main where

22

3+import Control.Monad.Eff.Console (log)

4+

35test :: forall a. a -> a

46test = \(x :: a) -> x

57

6−main = Control.Monad.Eff.Console.log "Done"

8+main = log "Done"

examples/passing/1697.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56_2 :: forall a. a -> a

67_2 a = a

@@ -21,4 +22,4 @@ wtf = do

2122 let tmp = _2 1

2223 pure unit

2324

24−main = Control.Monad.Eff.Console.log "Done"

25+main = log "Done"

examples/passing/1881.purs+5−3

@@ -1,9 +1,11 @@

11module Main where

22

3−foo =

3+import Control.Monad.Eff.Console (log)

4+

5+foo =

46 1

57

6−bar

8+bar

79 = 2

810

911baz

@@ -14,4 +16,4 @@ qux

1416 =

1517 3

1618

17−main = Control.Monad.Eff.Console.log "Done"

19+main = log "Done"

examples/passing/1991.purs+3−2

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56singleton :: forall a. a -> Array a

67singleton x = [x]

@@ -17,5 +18,5 @@ regression =

1718 let as = [1,2,3,4,5]

1819 as' = foldMap (\x -> if 1 < x && x < 4 then singleton x else empty) as

1920 in as'

20−

21−main = Control.Monad.Eff.Console.log "Done"

21+

22+main = log "Done"

examples/passing/2138.pursnew file+7

@@ -0,0 +1,7 @@

1+module Main where

2+

3+import Control.Monad.Eff.Console (log)

4+

5+import Lib (A(B,C))

6+

7+main = log "Done"

examples/passing/2138/Lib.pursnew file+3

@@ -0,0 +1,3 @@

1+module Lib (A(..), A) where

2+

3+data A = B | C

examples/passing/652.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56class Foo a b

67

@@ -14,4 +15,4 @@ instance bar :: Bar (a -> b) b

1415

1516instance baz :: (Eq a) => Baz (a -> b) a b

1617

17−main = Control.Monad.Eff.Console.log "Done"

18+main = log "Done"

examples/passing/810.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data Maybe a = Nothing | Just a

67

@@ -10,4 +11,4 @@ test m = o.x

1011 o = case m of Nothing -> { x : Nothing }

1112 Just a -> { x : Just a }

1213

13−main = Control.Monad.Eff.Console.log "Done"

14+main = log "Done"

examples/passing/Applicative.purs+2−2

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

11module Main where

22

3−import Prelude ()

3+import Control.Monad.Eff.Console (log)

44

55class Applicative f where

66 pure :: forall a. a -> f a

@@ -13,4 +13,4 @@ instance applicativeMaybe :: Applicative Maybe where

1313 apply (Just f) (Just a) = Just (f a)

1414 apply _ _ = Nothing

1515

16−main = Control.Monad.Eff.Console.log "Done"

16+main = log "Done"

examples/passing/ArrayType.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56class Pointed p where

67 point :: forall a. a -> p a

@@ -8,4 +9,4 @@ class Pointed p where

89instance pointedArray :: Pointed Array where

910 point a = [a]

1011

11−main = Control.Monad.Eff.Console.log "Done"

12+main = log "Done"

examples/passing/Auto.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data Auto s i o = Auto { state :: s, step :: s -> i -> o }

67

@@ -12,4 +13,4 @@ exists = \state step f -> f (Auto { state: state, step: step })

1213run :: forall i o. SomeAuto i o -> i -> o

1314run = \s i -> s (\a -> case a of Auto a -> a.step a.state i)

1415

15−main = Control.Monad.Eff.Console.log "Done"

16+main = log "Done"

examples/passing/BindersInFunctions.purs+2−1

@@ -4,6 +4,7 @@ import Prelude

44import Partial.Unsafe (unsafePartial)

55import Test.Assert (assert')

66import Control.Monad.Eff (Eff)

7+import Control.Monad.Eff.Console (log)

78

89snd :: forall a. Partial => Array a -> a

910snd = \[_, y] -> y

@@ -12,4 +13,4 @@ main :: Eff _ _

1213main = do

1314 let ts = unsafePartial (snd [1.0, 2.0])

1415 assert' "Incorrect result from 'snd'." (ts == 2.0)

15− Control.Monad.Eff.Console.log "Done"

16+ log "Done"

examples/passing/BindingGroups.purs+2−1

@@ -1,10 +1,11 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56foo = bar

67 where bar r = r + 1.0

78

89r = foo 2.0

910

10−main = Control.Monad.Eff.Console.log "Done"

11+main = log "Done"

examples/passing/BlockString.purs+2−1

@@ -1,8 +1,9 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56foo :: String

67foo = """foo"""

78

8−main = Control.Monad.Eff.Console.log "Done"

9+main = log "Done"

examples/passing/CaseStatement.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data A = A | B | C

67

@@ -18,4 +19,4 @@ h f N a = a

1819h f a N = a

1920h f (J a) (J b) = J (f a b)

2021

21−main = Control.Monad.Eff.Console.log $ f "Done" "Failed" A

22+main = log $ f "Done" "Failed" A

examples/passing/CheckFunction.purs+2−1

@@ -1,7 +1,8 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56test = ((\x -> x+1.0) >>> (\x -> x*2.0)) 4.0

67

7−main = Control.Monad.Eff.Console.log "Done"

8+main = log "Done"

examples/passing/CheckSynonymBug.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56length :: forall a. Array a -> Int

67length _ = 0

@@ -9,4 +10,4 @@ type Foo a = Array a

910

1011foo _ = length ([] :: Foo Number)

1112

12−main = Control.Monad.Eff.Console.log "Done"

13+main = log "Done"

examples/passing/CheckTypeClass.purs+2−2

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data Bar a = Bar

67data Baz

@@ -14,5 +15,4 @@ foo_ x = foo ((mkBar :: forall a. (Foo a) => a -> Bar a) x)

1415mkBar :: forall a. a -> Bar a

1516mkBar _ = Bar

1617

17−main = Control.Monad.Eff.Console.log "Done"

18−

18+main = log "Done"

examples/passing/Church.purs+2−2

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

11module Main where

22

3−import Prelude ()

3+import Control.Monad.Eff.Console (log)

44

55type List a = forall r. r -> (a -> r -> r) -> r

66

@@ -15,4 +15,4 @@ append = \l1 l2 r f -> l2 (l1 r f) f

1515

1616test = append (cons 1 empty) (cons 2 empty)

1717

18−main = Control.Monad.Eff.Console.log "Done"

18+main = log "Done"

examples/passing/ClassRefSyntax.purs+5−4

@@ -1,8 +1,9 @@

11module Main where

22

3− import Lib (class X, go)

3+import Lib (class X, go)

4+import Control.Monad.Eff.Console (log)

45

5− go' :: forall a. (X a) => a -> a

6− go' = go

6+go' :: forall a. (X a) => a -> a

7+go' = go

78

8− main = Control.Monad.Eff.Console.log "Done"

9+main = log "Done"

examples/passing/Conditional.purs+2−2

@@ -1,9 +1,9 @@

11module Main where

22

3−import Prelude ()

3+import Control.Monad.Eff.Console (log)

44

55fns = \f -> if f true then f else \x -> x

66

77not = \x -> if x then false else true

88

9−main = Control.Monad.Eff.Console.log "Done"

9+main = log "Done"

examples/passing/DataAndType.purs+2−1

@@ -1,9 +1,10 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data A = A B

67

78type B = A

89

9−main = Control.Monad.Eff.Console.log "Done"

10+main = log "Done"

examples/passing/DeepArrayBinder.purs+2−1

@@ -2,6 +2,7 @@ module Main where

22

33import Prelude

44import Control.Monad.Eff

5+import Control.Monad.Eff.Console (log)

56import Test.Assert

67

78data List a = Cons a (List a) | Nil

@@ -13,4 +14,4 @@ match2 _ = 0.0

1314main = do

1415 let result = match2 (Cons 1.0 (Cons 2.0 (Cons 3.0 (Cons 4.0 (Cons 5.0 (Cons 6.0 (Cons 7.0 (Cons 8.0 (Cons 9.0 Nil)))))))))

1516 assert' "Incorrect result!" (result == 100.0)

16− Control.Monad.Eff.Console.log "Done"

17+ log "Done"

examples/passing/Do.purs+3−2

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data Maybe a = Nothing | Just a

67

@@ -19,7 +20,7 @@ instance bindMaybe :: Bind Maybe where

1920 bind Nothing _ = Nothing

2021 bind (Just a) f = f a

2122

22−instance monadMaybe :: Prelude.Monad Maybe

23+instance monadMaybe :: Monad Maybe

2324

2425test1 = \_ -> do

2526 Just "abc"

@@ -64,4 +65,4 @@ test10 _ = do

6465 g x = f x / 2.0

6566 Just (f 10.0)

6667

67−main = Control.Monad.Eff.Console.log "Done"

68+main = log "Done"

examples/passing/Dollar.purs+2−2

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

11module Main where

22

3−import Prelude ()

3+import Control.Monad.Eff.Console (log)

44

55applyFn :: forall a b. (a -> b) -> a -> b

66applyFn f x = f x

@@ -13,4 +13,4 @@ test1 x = id $ id $ id $ id $ x

1313

1414test2 x = id id $ id x

1515

16−main = Control.Monad.Eff.Console.log "Done"

16+main = log "Done"

examples/passing/EmptyDataDecls.purs+2−1

@@ -2,6 +2,7 @@ module Main where

22

33import Prelude

44import Test.Assert

5+import Control.Monad.Eff.Console (log)

56

67data Z

78data S n

@@ -15,5 +16,5 @@ cons' :: forall a n. a -> ArrayBox n a -> ArrayBox (S n) a

1516cons' x (ArrayBox xs) = ArrayBox $ append [x] xs

1617

1718main = case cons' 1 $ cons' 2 $ cons' 3 nil of

18− ArrayBox [1, 2, 3] -> Control.Monad.Eff.Console.log "Done"

19+ ArrayBox [1, 2, 3] -> log "Done"

1920 _ -> assert' "Failed" false

examples/passing/EmptyRow.purs+2−1

@@ -1,10 +1,11 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data Foo r = Foo { | r }

67

78test :: Foo ()

89test = Foo {}

910

10−main = Control.Monad.Eff.Console.log "Done"

11+main = log "Done"

examples/passing/ExplicitOperatorSections.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56subtractOne :: Int -> Int

67subtractOne = (_ - 1)

@@ -11,4 +12,4 @@ addOne = (1 + _)

1112named :: Int -> Int

1213named = (_ `sub` 1)

1314

14−main = Control.Monad.Eff.Console.log "Done"

15+main = log "Done"

examples/passing/ExportExplicit.purs+2−1

@@ -1,9 +1,10 @@

11module Main where

22

33import M1

4+import Control.Monad.Eff.Console (log)

45

56testX = X

67testZ = Z

78testFoo = foo

89

9−main = Control.Monad.Eff.Console.log "Done"

10+main = log "Done"

examples/passing/ExportExplicit2.purs+2−1

@@ -1,7 +1,8 @@

11module Main where

22

33import M1

4+import Control.Monad.Eff.Console (log)

45

56testBar = bar

67

7−main = Control.Monad.Eff.Console.log "Done"

8+main = log "Done"

examples/passing/FunctionScope.purs+2−1

@@ -2,6 +2,7 @@ module Main where

22

33import Prelude

44import Test.Assert

5+import Control.Monad.Eff.Console (log)

56

67mkValue :: Number -> Number

78mkValue id = id

@@ -9,4 +10,4 @@ mkValue id = id

910main = do

1011 let value = mkValue 1.0

1112 assert $ value == 1.0

12− Control.Monad.Eff.Console.log "Done"

13+ log "Done"

examples/passing/Functions2.purs+2−1

@@ -2,6 +2,7 @@ module Main where

22

33import Prelude

44import Test.Assert

5+import Control.Monad.Eff.Console (log)

56

67test :: forall a b. a -> b -> a

78test = \const _ -> const

@@ -9,4 +10,4 @@ test = \const _ -> const

910main = do

1011 let value = test "Done" {}

1112 assert' "Not done" $ value == "Done"

12− Control.Monad.Eff.Console.log "Done"

13+ log "Done"

examples/passing/Guards.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56collatz = \x -> case x of

67 y | y `mod` 2.0 == 0.0 -> y / 2.0

@@ -26,4 +27,4 @@ testIndentation x y | x > 0.0

2627 | otherwise

2728 = y - x

2829

29−main = Control.Monad.Eff.Console.log $ min "Done" "ZZZZ"

30+main = log $ min "Done" "ZZZZ"

examples/passing/IfThenElseMaybe.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data Maybe a = Nothing | Just a

67

@@ -8,4 +9,4 @@ test1 = if true then Just 10 else Nothing

89

910test2 = if true then Nothing else Just 10

1011

11−main = Control.Monad.Eff.Console.log "Done"

12+main = log "Done"

examples/passing/ImplicitEmptyImport.purs+4−3

@@ -1,8 +1,9 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56main = do

6− Control.Monad.Eff.Console.log "Hello"

7− Control.Monad.Eff.Console.log "Goodbye"

8− Control.Monad.Eff.Console.log "Done"

7+ log "Hello"

8+ log "Goodbye"

9+ log "Done"

examples/passing/Import.purs+2−1

@@ -1,5 +1,6 @@

11module Main where

22

33import M2

4+import Control.Monad.Eff.Console (log)

45

5−main = Control.Monad.Eff.Console.log "Done"

6+main = log "Done"

examples/passing/ImportExplicit.purs+2−1

@@ -1,9 +1,10 @@

11module Main where

22

33import M1 (X(..))

4+import Control.Monad.Eff.Console (log)

45

56testX :: X

67testX = X

78testY = Y

89

9−main = Control.Monad.Eff.Console.log "Done"

10+main = log "Done"

examples/passing/InstanceBeforeClass.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56instance fooNumber :: Foo Number where

67 foo = 0.0

@@ -8,4 +9,4 @@ instance fooNumber :: Foo Number where

89class Foo a where

910 foo :: a

1011

11−main = Control.Monad.Eff.Console.log "Done"

12+main = log "Done"

examples/passing/IntAndChar.purs+2−1

@@ -2,6 +2,7 @@ module Main where

22

33import Prelude

44import Control.Monad.Eff

5+import Control.Monad.Eff.Console (log)

56import Test.Assert

67

78f 1 = 1

@@ -15,4 +16,4 @@ main = do

1516 assert $ f 0 == 0

1617 assert $ g 'a' == 'a'

1718 assert $ g 'b' == 'b'

18− Control.Monad.Eff.Console.log "Done"

19+ log "Done"

examples/passing/JSReserved.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56yield = 0

67member = 1

@@ -9,4 +10,4 @@ public = \return -> return

910

1011this catch = catch

1112

12−main = Control.Monad.Eff.Console.log "Done"

13+main = log "Done"

examples/passing/KindedType.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56type Star2Star f = f :: * -> *

67

@@ -30,4 +31,4 @@ class Clazz (a :: *) where

3031instance clazzString :: Clazz String where

3132 def = "test"

3233

33−main = Control.Monad.Eff.Console.log "Done"

34+main = log "Done"

examples/passing/LargeSumType.purs+4−2

@@ -1,5 +1,7 @@

11module Main where

2−

2+

3+import Control.Monad.Eff.Console (log)

4+

35data Large = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z

46

57explode A A = "A"

@@ -30,4 +32,4 @@ explode Y Y = "Y"

3032explode Z Z = "Z"

3133explode _ _ = ""

3234

33−main = Control.Monad.Eff.Console.log "Done"

35+main = log "Done"

examples/passing/LetInInstance.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56class Foo a where

67 foo :: a -> String

@@ -11,4 +12,4 @@ instance fooString :: Foo String where

1112 go :: String -> String

1213 go s = s

1314

14−main = Control.Monad.Eff.Console.log "Done"

15+main = log "Done"

examples/passing/LiberalTypeSynonyms.purs+3−2

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56type Reader = (->) String

67

@@ -16,6 +17,6 @@ type F r = { | r } -> { | r }

1617

1718f :: (forall r. F r) -> String

1819f g = case g { x: "Hello" } of

19− { x = x } -> x

20+ { x: x } -> x

2021

21−main = Control.Monad.Eff.Console.log "Done"

22+main = log "Done"

examples/passing/MPTCs.purs+3−2

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56class NullaryTypeClass where

67 greeting :: String

@@ -14,7 +15,7 @@ class Coerce a b where

1415instance coerceRefl :: Coerce a a where

1516 coerce a = a

1617

17−instance coerceShow :: (Prelude.Show a) => Coerce a String where

18+instance coerceShow :: Show a => Coerce a String where

1819 coerce = show

1920

20−main = Control.Monad.Eff.Console.log "Done"

21+main = log "Done"

examples/passing/Match.purs+2−1

@@ -1,9 +1,10 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data Foo a = Foo

67

78foo = \f -> case f of Foo -> "foo"

89

9−main = Control.Monad.Eff.Console.log "Done"

10+main = log "Done"

examples/passing/Module.purs+2−1

@@ -2,5 +2,6 @@ module Main where

22

33import M1

44import M2

5+import Control.Monad.Eff.Console (log)

56

6−main = Control.Monad.Eff.Console.log "Done"

7+main = log "Done"

examples/passing/Module/M1.purs+1−1

@@ -4,7 +4,7 @@ import Prelude

44

55data Foo = Foo String

66

7−foo :: M1.Foo -> String

7+foo :: Foo -> String

88foo = \f -> case f of Foo s -> s <> "foo"

99

1010bar :: Foo -> String

examples/passing/Module/M2.purs+1

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

11module M2 where

22

33import Prelude

4+import M1 as M1

45

56baz :: M1.Foo -> String

67baz = M1.foo

examples/passing/ModuleDeps.purs+2−1

@@ -1,5 +1,6 @@

11module Main where

22

33import M1

4+import Control.Monad.Eff.Console (log)

45

5−main = Control.Monad.Eff.Console.log "Done"

6+main = log "Done"

examples/passing/ModuleDeps/M1.purs+1−1

@@ -1,5 +1,5 @@

11module M1 where

22

3−import M2

3+import M2 as M2

44

55foo = M2.bar

examples/passing/ModuleDeps/M2.purs+1−1

@@ -1,5 +1,5 @@

11module M2 where

22

3−import M3

3+import M3 as M3

44

55bar = M3.baz

examples/passing/Monad.purs+2−2

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

11module Main where

22

3−import Prelude ()

3+import Control.Monad.Eff.Console (log)

44

55type Monad m = { return :: forall a. a -> m a

66 , bind :: forall a b. m a -> (a -> m b) -> m b }

@@ -29,4 +29,4 @@ test1 = test id

2929

3030test2 = test maybe

3131

32−main = Control.Monad.Eff.Console.log "Done"

32+main = log "Done"

examples/passing/MutRec.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56f 0.0 = 0.0

67f x = g x + 0.0

@@ -16,4 +17,4 @@ evenToNumber (Even n) = oddToNumber n + 0.0

1617

1718oddToNumber (Odd n) = evenToNumber n + 0.0

1819

19−main = Control.Monad.Eff.Console.log "Done"

20+main = log "Done"

examples/passing/MutRec2.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data A = A B

67

@@ -16,4 +17,4 @@ g b = case b of B a -> f a

1617showN :: A -> S

1718showN a = f a

1819

19−main = Control.Monad.Eff.Console.log "Done"

20+main = log "Done"

examples/passing/MutRec3.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data A = A B

67

@@ -16,4 +17,4 @@ g b = case b of B a -> f a

1617showN :: A -> S

1718showN a = f a

1819

19−main = Control.Monad.Eff.Console.log "Done"

20+main = log "Done"

examples/passing/NamedPatterns.purs+3−2

@@ -1,9 +1,10 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56foo = \x -> case x of

6− y@{ foo = "Foo" } -> y

7+ y@{ foo: "Foo" } -> y

78 y -> y

89

9−main = Control.Monad.Eff.Console.log "Done"

10+main = log "Done"

examples/passing/NegativeBinder.purs+2−1

@@ -1,9 +1,10 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56test :: Number -> Boolean

67test -1.0 = false

78test _ = true

89

9−main = Control.Monad.Eff.Console.log "Done"

10+main = log "Done"

examples/passing/NegativeIntInRange.purs+2−1

@@ -1,8 +1,9 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56n :: Int

67n = -2147483648

78

8−main = Control.Monad.Eff.Console.log "Done"

9+main = log "Done"

examples/passing/Nested.purs+2−1

@@ -1,9 +1,10 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data Extend r a = Extend { prev :: r a, next :: a }

67

78data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)

89

9−main = Control.Monad.Eff.Console.log "Done"

10+main = log "Done"

examples/passing/NestedWhere.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56f x = g x

67 where

@@ -9,4 +10,4 @@ f x = g x

910 go x = go1 (x - 1.0)

1011 go1 x = go x

1112

12−main = Control.Monad.Eff.Console.log "Done"

13+main = log "Done"

examples/passing/NonConflictingExports.purs+5−4

@@ -1,9 +1,10 @@

11-- No failure here as the export `thing` only refers to Main.thing

22module Main (thing, main) where

33

4− import A

4+import A

5+import Control.Monad.Eff.Console (log)

56

6− thing :: Int

7− thing = 2

7+thing :: Int

8+thing = 2

89

9− main = Control.Monad.Eff.Console.log "Done"

10+main = log "Done"

examples/passing/ObjectSynonym.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56type Inner = Number

67

@@ -12,4 +13,4 @@ type Outer = { inner :: Inner }

1213outer :: Outer

1314outer = { inner: inner }

1415

15−main = Control.Monad.Eff.Console.log "Done"

16+main = log "Done"

examples/passing/ObjectUpdate.purs+2−2

@@ -9,8 +9,8 @@ update2 :: forall r. { foo :: String | r } -> { foo :: String | r }

99update2 = \o -> o { foo = "Foo" }

1010

1111replace = \o -> case o of

12− { foo = "Foo" } -> o { foo = "Bar" }

13− { foo = "Bar" } -> o { bar = "Baz" }

12+ { foo: "Foo" } -> o { foo = "Bar" }

13+ { foo: "Bar" } -> o { bar = "Baz" }

1414 o -> o

1515

1616polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }

examples/passing/ObjectUpdate2.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56type X r = { | r }

67

@@ -14,4 +15,4 @@ test = blah x

1415 { baz = "blah"

1516 }

1617

17−main = Control.Monad.Eff.Console.log "Done"

18+main = log "Done"

examples/passing/Objects.purs+3−2

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

11module Main where

22

33import Prelude hiding (append)

4+import Control.Monad.Eff.Console (log)

45

56test = \x -> x.foo + x.bar + 1.0

67

@@ -25,11 +26,11 @@ test4 = test2 weirdObj

2526 weirdObj = { "!@#": 1.0 }

2627

2728test5 = case { "***": 1.0 } of

28− { "***" = n } -> n

29+ { "***": n } -> n

2930

3031test6 = case { "***": 1.0 } of

3132 { "***": n } -> n

3233

3334test7 {a: snoog , b : blah } = blah

3435

35−main = Control.Monad.Eff.Console.log "Done"

36+main = log "Done"

examples/passing/OneConstructor.purs+2−1

@@ -1,9 +1,10 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data One a = One a

67

78one' (One a) = a

89

9−main = Control.Monad.Eff.Console.log "Done"

10+main = log "Done"

examples/passing/Operators.purs+4−8

@@ -1,6 +1,8 @@

11module Main where

22

33import Prelude

4+import Other (foo)

5+import Other as Other

46import Control.Monad.Eff

57import Control.Monad.Eff.Console

68

@@ -9,9 +11,6 @@ op1 x _ = x

911

1012infix 4 op1 as ?!

1113

12−bar :: String -> String -> String

13−bar = \s1 s2 -> s1 <> s2

14−

1514test1 :: forall n. (Semiring n) => n -> n -> (n -> n -> n) -> n

1615test1 x y z = x * y + z x y

1716

@@ -44,14 +43,11 @@ op4 = \f x -> f x

4443

4544infix 4 op4 as @@

4645

47−foo :: String -> String

48−foo = \s -> s

49−

5046test8 = foo @@ "Hello World"

5147

52−test9 = Main.foo @@ "Hello World"

48+test9 = Other.foo @@ "Hello World"

5349

54−test10 = "Hello" `Main.bar` "World"

50+test10 = "Hello" `Other.baz` "World"

5551

5652op5 :: forall a. Array a -> Array a -> Array a

5753op5 = \as -> \bs -> as

examples/passing/Operators/Other.pursnew file+7

@@ -0,0 +1,7 @@

1+module Other where

2+

3+foo :: String -> String

4+foo s = s

5+

6+baz :: String -> String -> String

7+baz s _ = s

examples/passing/OptimizerBug.purs+2−1

@@ -1,9 +1,10 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56x a = 1.0 + y a

67

78y a = x a

89

9−main = Control.Monad.Eff.Console.log "Done"

10+main = log "Done"

examples/passing/Patterns.purs+5−4

@@ -1,14 +1,15 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56test = \x -> case x of

6− { str = "Foo", bool = true } -> true

7− { str = "Bar", bool = b } -> b

7+ { str: "Foo", bool: true } -> true

8+ { str: "Bar", bool: b } -> b

89 _ -> false

910

1011f = \o -> case o of

11− { foo = "Foo" } -> o.bar

12+ { foo: "Foo" } -> o.bar

1213 _ -> 0

1314

1415h = \o -> case o of

@@ -19,4 +20,4 @@ isDesc :: Array Number -> Boolean

1920isDesc [x, y] | x > y = true

2021isDesc _ = false

2122

22−main = Control.Monad.Eff.Console.log "Done"

23+main = log "Done"

examples/passing/PendingConflictingImports.purs+2−1

@@ -3,5 +3,6 @@ module Main where

33-- No error as we never force `thing` to be resolved in `Main`

44import A

55import B

6+import Control.Monad.Eff.Console (log)

67

7−main = Control.Monad.Eff.Console.log "Done"

8+main = log "Done"

examples/passing/PendingConflictingImports2.purs+6−5

@@ -1,9 +1,10 @@

11module Main where

22

3− import A

3+import A

4+import Control.Monad.Eff.Console (log)

45

5− -- No error as we never force `thing` to be resolved in `Main`

6− thing :: Int

7− thing = 2

6+-- No error as we never force `thing` to be resolved in `Main`

7+thing :: Int

8+thing = 2

89

9− main = Control.Monad.Eff.Console.log "Done"

10+main = log "Done"

examples/passing/QualifiedNames.purs+3−1

@@ -1,9 +1,11 @@

11module Main where

22

33import Prelude

4+import Either as Either

5+import Control.Monad.Eff.Console (log)

46

57either :: forall a b c. (a -> c) -> (b -> c) -> Either.Either a b -> c

68either f _ (Either.Left x) = f x

79either _ g (Either.Right y) = g y

810

9−main = Control.Monad.Eff.Console.log (either id id (Either.Left "Done"))

11+main = log (either id id (Either.Left "Done"))

examples/passing/Rank2Object.purs+1−1

@@ -6,6 +6,6 @@ import Control.Monad.Eff.Console

66data Foo = Foo { id :: forall a. a -> a }

77

88foo :: Foo -> Number

9−foo (Foo { id = f }) = f 0.0

9+foo (Foo { id: f }) = f 0.0

1010

1111main = log "Done"

examples/passing/Rank2Types.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56test1 :: (forall a. (a -> a)) -> Number

67test1 = \f -> f 0.0

@@ -8,4 +9,4 @@ test1 = \f -> f 0.0

89forever :: forall m a b. (forall a b. m a -> (a -> m b) -> m b) -> m a -> m b

910forever = \bind action -> bind action $ \_ -> forever bind action

1011

11−main = Control.Monad.Eff.Console.log "Done"

12+main = log "Done"

examples/passing/ReExportQualified.purs+2−1

@@ -2,5 +2,6 @@ module Main where

22

33import Prelude

44import C

5+import Control.Monad.Eff.Console (log)

56

6−main = Control.Monad.Eff.Console.log (x <> y)

7+main = log (x <> y)

examples/passing/Recursion.purs+2−1

@@ -1,10 +1,11 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56fib = \n -> case n of

67 0.0 -> 1.0

78 1.0 -> 1.0

89 n -> fib (n - 1.0) + fib (n - 2.0)

910

10−main = Control.Monad.Eff.Console.log "Done"

11+main = log "Done"

examples/passing/RedefinedFixity.purs+2−1

@@ -1,5 +1,6 @@

11module Main where

22

33import M3

4+import Control.Monad.Eff.Console (log)

45

5−main = Control.Monad.Eff.Console.log "Done"

6+main = log "Done"

examples/passing/ReservedWords.purs+3−2

@@ -3,6 +3,7 @@ module Main where

33

44import Prelude

55import Control.Monad.Eff

6+import Control.Monad.Eff.Console (log)

67

78o :: { type :: String }

89o = { type: "o" }

@@ -11,8 +12,8 @@ p :: { type :: String }

1112p = o { type = "p" }

1213

1314f :: forall r. { type :: String | r } -> String

14−f { type = "p" } = "Done"

15+f { type: "p" } = "Done"

1516f _ = "Fail"

1617

1718main :: Eff _ _

18−main = Control.Monad.Eff.Console.log $ f { type: p.type, foo: "bar" }

19+main = log $ f { type: p.type, foo: "bar" }

examples/passing/ResolvableScopeConflict.purs+2−1

@@ -2,6 +2,7 @@ module Main where

22

33import A (thing)

44import B

5+import Control.Monad.Eff.Console (log)

56

67-- Not an error as although we have `thing` in scope from both A and B, it is

78-- imported explicitly from A, giving it a resolvable solution.

@@ -9,4 +10,4 @@ what :: Boolean -> Int

910what true = thing

1011what false = zing

1112

12−main = Control.Monad.Eff.Console.log "Done"

13+main = log "Done"

examples/passing/ResolvableScopeConflict2.purs+2−1

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

11module Main where

22

33import A

4+import Control.Monad.Eff.Console (log)

45

56thing :: Int

67thing = 1

@@ -11,4 +12,4 @@ what :: Boolean -> Int

1112what true = thing

1213what false = zing

1314

14−main = Control.Monad.Eff.Console.log "Done"

15+main = log "Done"

examples/passing/ResolvableScopeConflict3.purs+2−1

@@ -1,8 +1,9 @@

11module Main (thing, main, module A) where

22

33import A

4+import Control.Monad.Eff.Console (log)

45

56thing :: Int

67thing = 2

78

8−main = Control.Monad.Eff.Console.log "Done"

9+main = log "Done"

examples/passing/RowConstructors.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56type Foo = (x :: Number | (y :: Number | (z :: Number)))

67type Bar = (x :: Number, y :: Number, z :: Number)

@@ -39,4 +40,4 @@ wildcard { w: w } = { x: w, y: w, z: w, w: w }

3940wildcard' :: { | Quux _ } -> Number

4041wildcard' { q: q } = q

4142

42−main = Control.Monad.Eff.Console.log "Done"

43+main = log "Done"

examples/passing/RowPolyInstanceContext.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56class T s m where

67 state :: (s -> s) -> m Unit

@@ -19,4 +20,4 @@ test2 = state $ \o -> o { foo = o.foo <> "!" }

1920main = do

2021 let t1 = test1

2122 let t2 = test2

22− Control.Monad.Eff.Console.log "Done"

23+ log "Done"

examples/passing/ScopedTypeVariables.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56test1 :: forall a. (a -> a) -> a -> a

67test1 f x = g (g x)

@@ -33,4 +34,4 @@ test4 = h

3334 j x = x

3435

3536

36−main = Control.Monad.Eff.Console.log "Done"

37+main = log "Done"

examples/passing/Sequence.purs+2−1

@@ -2,6 +2,7 @@ module Main where

22

33import Prelude

44import Control.Monad.Eff

5+import Control.Monad.Eff.Console (log)

56

67data List a = Cons a (List a) | Nil

78

@@ -12,4 +13,4 @@ instance sequenceList :: Sequence List where

1213 sequence Nil = pure Nil

1314 sequence (Cons x xs) = Cons <$> x <*> sequence xs

1415

15−main = sequence $ Cons (Control.Monad.Eff.Console.log "Done") Nil

16+main = sequence $ Cons (log "Done") Nil

examples/passing/SequenceDesugared.purs+5−4

@@ -2,6 +2,7 @@ module Main where

22

33import Prelude

44import Control.Monad.Eff

5+import Control.Monad.Eff.Console (log)

56

67data List a = Cons a (List a) | Nil

78

@@ -31,7 +32,7 @@ sequenceList''' = Sequence ((\val -> case val of

3132 Cons x xs -> Cons <$> x <*> sequence sequenceList''' xs) :: forall m a. (Monad m) => List (m a) -> m (List a))

3233

3334main = do

34− sequence sequenceList $ Cons (Control.Monad.Eff.Console.log "Done") Nil

35− sequence sequenceList' $ Cons (Control.Monad.Eff.Console.log "Done") Nil

36− sequence sequenceList'' $ Cons (Control.Monad.Eff.Console.log "Done") Nil

37− sequence sequenceList''' $ Cons (Control.Monad.Eff.Console.log "Done") Nil

35+ sequence sequenceList $ Cons (log "Done") Nil

36+ sequence sequenceList' $ Cons (log "Done") Nil

37+ sequence sequenceList'' $ Cons (log "Done") Nil

38+ sequence sequenceList''' $ Cons (log "Done") Nil

examples/passing/ShadowedName.purs+2−1

@@ -2,9 +2,10 @@ module Main where

22

33import Prelude

44import Control.Monad.Eff.Console

5+import Control.Monad.Eff.Console (log)

56

67done :: String

78done = let str = "Not yet done" in

89 let str = "Done" in str

910

10−main = Control.Monad.Eff.Console.log done

11+main = log done

examples/passing/SignedNumericLiterals.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56p = 0.5

67q = 1.0

@@ -14,4 +15,4 @@ f x = -x

1415

1516test1 = 2.0 - 1.0

1617

17−main = Control.Monad.Eff.Console.log "Done"

18+main = log "Done"

examples/passing/TCOCase.purs+2−1

@@ -1,10 +1,11 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data Data = One | More Data

67

7−main = Control.Monad.Eff.Console.log (from (to 10000.0 One))

8+main = log (from (to 10000.0 One))

89 where

910 to 0.0 a = a

1011 to n a = to (n - 1.0) (More a)

examples/passing/Tick.purs+2−1

@@ -1,7 +1,8 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56test' x = x

67

7−main = Control.Monad.Eff.Console.log "Done"

8+main = log "Done"

examples/passing/TopLevelCase.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56gcd :: Number -> Number -> Number

67gcd 0.0 x = x

@@ -15,4 +16,4 @@ data A = A

1516

1617parseTest A 0.0 = 0.0

1718

18−main = Control.Monad.Eff.Console.log "Done"

19+main = log "Done"

examples/passing/TransitiveImport/Middle.purs+3−1

@@ -1,3 +1,5 @@

11module Middle where

22

3−middle = Test.test

3+import Test (test)

4+

5+middle = test

examples/passing/TypeClasses.purs+3−3

@@ -5,19 +5,19 @@ import Control.Monad.Eff.Console (log)

55

66test1 = \_ -> show "testing"

77

8−f :: forall a. (Prelude.Show a) => a -> String

8+f :: forall a. (Show a) => a -> String

99f x = show x

1010

1111test2 = \_ -> f "testing"

1212

13−test7 :: forall a. (Prelude.Show a) => a -> String

13+test7 :: forall a. (Show a) => a -> String

1414test7 = show

1515

1616test8 = \_ -> show $ "testing"

1717

1818data Data a = Data a

1919

20−instance showData :: (Prelude.Show a) => Prelude.Show (Data a) where

20+instance showData :: (Show a) => Show (Data a) where

2121 show (Data a) = "Data (" <> show a <> ")"

2222

2323test3 = \_ -> show (Data "testing")

examples/passing/TypeClassesInOrder.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56class Foo a where

67 foo :: a -> String

@@ -8,4 +9,4 @@ class Foo a where

89instance fooString :: Foo String where

910 foo s = s

1011

11−main = Control.Monad.Eff.Console.log $ foo "Done"

12+main = log $ foo "Done"

examples/passing/TypeClassesWithOverlappingTypeVariables.purs+3−2

@@ -1,11 +1,12 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data Either a b = Left a | Right b

67

7−instance functorEither :: Prelude.Functor (Either a) where

8+instance functorEither :: Functor (Either a) where

89 map _ (Left x) = Left x

910 map f (Right y) = Right (f y)

1011

11−main = Control.Monad.Eff.Console.log "Done"

12+main = log "Done"

examples/passing/TypeDecl.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56k :: String -> Number -> String

67k x y = x

@@ -9,4 +10,4 @@ iterate :: forall a. Number -> (a -> a) -> a -> a

910iterate 0.0 f a = a

1011iterate n f a = iterate (n - 1.0) f (f a)

1112

12−main = Control.Monad.Eff.Console.log "Done"

13+main = log "Done"

examples/passing/TypeOperators.purs+2−1

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

11module Main where

22

33import A (type (~>), type (/\), (/\))

4+import Control.Monad.Eff.Console (log)

45

56natty ∷ ∀ f. f ~> f

67natty x = x

@@ -16,4 +17,4 @@ testPrecedence2 nat fx = nat fx

1617swap ∷ ∀ a b. a /\ b → b /\ a

1718swap (a /\ b) = b /\ a

1819

19−main = Control.Monad.Eff.Console.log "Done"

20+main = log "Done"

examples/passing/TypeSynonymInData.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56type A a = Array a

67

@@ -8,4 +9,4 @@ data Foo a = Foo (A a) | Bar

89

910foo (Foo []) = Bar

1011

11−main = Control.Monad.Eff.Console.log "Done"

12+main = log "Done"

examples/passing/TypeSynonyms.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56type Lens a b =

67 { get :: a -> b

@@ -24,4 +25,4 @@ fst =

2425test1 :: forall a b c. Lens (Pair (Pair a b) c) a

2526test1 = composeLenses fst fst

2627

27−main = Control.Monad.Eff.Console.log "Done"

28+main = log "Done"

examples/passing/TypeWildcards.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56testTopLevel :: _ -> _

67testTopLevel n = n + 1.0

@@ -12,4 +13,4 @@ test f a = go (f a) a

1213 go a1 a2 | a1 == a2 = a1

1314 go a1 _ = go (f a1) a1

1415

15−main = Control.Monad.Eff.Console.log "Done"

16+main = log "Done"

examples/passing/TypeWildcardsRecordExtension.purs+2−1

@@ -1,8 +1,9 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56foo :: forall a. {b :: Number | a} -> {b :: Number | _}

67foo f = f

78

8−main = Control.Monad.Eff.Console.log "Done"

9+main = log "Done"

examples/passing/TypeWithoutParens.purs+2−1

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

11module Main where

22

33import Lib (X, Y)

4+import Control.Monad.Eff.Console (log)

45

56idX :: X -> X

67idX x = x

@@ -8,4 +9,4 @@ idX x = x

89idY :: Y -> Y

910idY y = y

1011

11−main = Control.Monad.Eff.Console.log "Done"

12+main = log "Done"

examples/passing/TypedBinders.purs+3−2

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data Tuple a b = Tuple a b

67

@@ -31,7 +32,7 @@ instance monadStateState :: MonadState s (State s) where

3132 get = State (\s -> Tuple s s)

3233 put s = State (\_ -> Tuple s {})

3334

34−modify :: forall m s. (Prelude.Monad m, MonadState s m) => (s -> s) -> m {}

35+modify :: forall m s. (Monad m, MonadState s m) => (s -> s) -> m {}

3536modify f = do

3637 s <- get

3738 put (f s)

@@ -64,4 +65,4 @@ main = do

6465 t2 = test2 id

6566 t3 = test3 1

6667 t4 = test4 (Tuple 1 0)

67− Control.Monad.Eff.Console.log "Done"

68+ log "Done"

examples/passing/TypedWhere.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data E a b = L a | R b

67

@@ -14,4 +15,4 @@ lefts = go N

1415 go ls (C (L a) rest) = go (C a ls) rest

1516 go ls (C _ rest) = go ls rest

1617

17−main = Control.Monad.Eff.Console.log "Done"

18+main = log "Done"

examples/passing/UnderscoreIdent.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56data Data_type = Con_Structor | Con_2 String

67

@@ -9,4 +10,4 @@ type Type_name = Data_type

910done (Con_2 s) = s

1011done _ = "Failed"

1112

12−main = Control.Monad.Eff.Console.log (done (Con_2 "Done"))

13+main = log (done (Con_2 "Done"))

examples/passing/UnicodeIdentifier.purs+3−1

@@ -1,5 +1,7 @@

11module Main where

22

3+import Control.Monad.Eff.Console (log)

4+

35f asgård = asgård

46

5−main = Control.Monad.Eff.Console.log (f "Done")

7+main = log (f "Done")

examples/passing/UnicodeOperators.purs+3−1

@@ -1,5 +1,7 @@

11module Main where

22

3+import Control.Monad.Eff.Console (log)

4+

35compose :: forall a b c. (b -> c) -> (a -> b) -> a -> c

46compose f g a = f (g a)

57

@@ -17,4 +19,4 @@ emptySet _ = true

1719

1820test2 = 1 ∈ emptySet

1921

20−main = Control.Monad.Eff.Console.log "Done"

22+main = log "Done"

examples/passing/UnknownInTypeClassLookup.purs+2−1

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

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56class EQ a b

67

@@ -11,4 +12,4 @@ test _ _ = "Done"

1112

1213runTest a = test a a

1314

14−main = Control.Monad.Eff.Console.log $ runTest 0.0

15+main = log $ runTest 0.0

examples/passing/UntupledConstraints.purs+1−1

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

11module Main where

22

33import Prelude

4−import Control.Monad.Eff.Console

4+import Control.Monad.Eff.Console (log)

55

66class Show a <= Nonsense a where

77 method :: a -> a

examples/passing/WildcardType.purs+2−3

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

11module Main where

22

33import Prelude

4−import Control.Monad.Eff.Console

4+import Control.Monad.Eff.Console (log)

55

66f1 :: (_ -> _) -> _

77f1 g = g 1

@@ -9,5 +9,4 @@ f1 g = g 1

99f2 :: _ -> _

1010f2 _ = "Done"

1111

12−main = Control.Monad.Eff.Console.log $ f1 f2

13−

12+main = log $ f1 f2

examples/passing/iota.purs+3−1

@@ -1,9 +1,11 @@

11module Main where

22

3+import Control.Monad.Eff.Console (log)

4+

35s = \x -> \y -> \z -> x z (y z)

46

57k = \x -> \y -> x

68

79iota = \x -> x s k

810

9−main = Control.Monad.Eff.Console.log "Done"

11+main = log "Done"

examples/passing/s.purs+2−1

@@ -1,7 +1,8 @@

11module Main where

22

33import Prelude

4+import Control.Monad.Eff.Console (log)

45

56s = \x y z -> x z (y z)

67

7−main = Control.Monad.Eff.Console.log "Done"

8+main = log "Done"

examples/warning/DuplicateExportRef.pursnew file+30

@@ -0,0 +1,30 @@

1+-- @shouldWarnWith DuplicateExportRef

2+-- @shouldWarnWith DuplicateExportRef

3+-- @shouldWarnWith DuplicateExportRef

4+-- @shouldWarnWith DuplicateExportRef

5+-- @shouldWarnWith DuplicateExportRef

6+-- @shouldWarnWith DuplicateExportRef

7+-- @shouldWarnWith DuplicateExportRef

8+module Main

9+ ( X(X, X), X

10+ , fn, fn

11+ , (!), (!)

12+ , class Y, class Y

13+ , Natural, type (~>), type (~>)

14+ , module Prelude, module Prelude

15+ ) where

16+

17+import Prelude (Unit)

18+

19+data X = X

20+

21+fn :: X -> X -> X

22+fn _ _ = X

23+

24+infix 2 fn as !

25+

26+class Y a

27+

28+type Natural f g = forall a. f a -> g a

29+

30+infixl 1 type Natural as ~>

examples/warning/DuplicateImport.pursnew file+10

@@ -0,0 +1,10 @@

1+-- @shouldWarnWith DuplicateImport

2+module Main where

3+

4+import Prelude (Unit, unit, pure)

5+import Prelude (Unit, unit, pure)

6+

7+import Control.Monad.Eff (Eff)

8+

9+main :: Eff () Unit

10+main = pure unit

examples/warning/DuplicateImportRef.pursnew file+18

@@ -0,0 +1,18 @@

1+-- @shouldWarnWith DuplicateImportRef

2+-- @shouldWarnWith DuplicateImportRef

3+-- @shouldWarnWith DuplicateImportRef

4+-- @shouldWarnWith DuplicateImportRef

5+module Main where

6+

7+import Prelude

8+ ( Unit, Unit

9+ , unit, unit

10+ , class Functor, class Functor

11+ , (<>), (<>)

12+ )

13+

14+u :: Unit

15+u = unit <> unit

16+

17+fid :: forall f a. Functor f => f a -> f a

18+fid fa = fa

examples/warning/DuplicateSelectiveImport.pursnew file+10

@@ -0,0 +1,10 @@

1+-- @shouldWarnWith DuplicateSelectiveImport

2+module Main where

3+

4+import Prelude (Unit, unit)

5+import Prelude (pure)

6+

7+import Control.Monad.Eff (Eff)

8+

9+main :: Eff () Unit

10+main = pure unit

examples/warning/HidingImport.pursnew file+9

@@ -0,0 +1,9 @@

1+-- @shouldWarnWith HidingImport

2+-- @shouldWarnWith HidingImport

3+module Main where

4+

5+import Prelude hiding (one)

6+import Control.Monad.Eff hiding (runPure)

7+

8+main :: Eff () Unit

9+main = pure unit

examples/warning/ImplicitImport.pursnew file+9

@@ -0,0 +1,9 @@

1+-- @shouldWarnWith ImplicitImport

2+-- @shouldWarnWith ImplicitImport

3+module Main where

4+

5+import Prelude

6+import Control.Monad.Eff

7+

8+main :: Eff () Unit

9+main = pure unit

examples/warning/ImplicitQualifiedImport.pursnew file+11

@@ -0,0 +1,11 @@

1+-- @shouldWarnWith ImplicitQualifiedImport

2+-- @shouldWarnWith ImplicitQualifiedImport

3+module Main where

4+

5+import Data.Unit

6+

7+import Control.Monad.Eff as E

8+import Control.Monad.Eff.Console as E

9+

10+main :: E.Eff (console :: E.CONSOLE) Unit

11+main = E.log "test"

examples/warning/MissingTypeDeclaration.pursnew file+4

@@ -0,0 +1,4 @@

1+-- @shouldWarnWith MissingTypeDeclaration

2+module Main where

3+

4+x = 0

examples/warning/OverlappingInstances.pursnew file+17

@@ -0,0 +1,17 @@

1+-- @shouldWarnWith OverlappingInstances

2+module Main where

3+

4+class Test a where

5+ test :: a -> a

6+

7+instance testRefl :: Test a where

8+ test x = x

9+

10+instance testInt :: Test Int where

11+ test _ = 0

12+

13+-- The OverlappingInstances instances warning only arises when there are two

14+-- choices for a dictionary, not when the instances are defined. So without

15+-- `value` this module would not raise a warning.

16+value :: Int

17+value = test 1

examples/warning/OverlappingPattern.pursnew file+15

@@ -0,0 +1,15 @@

1+-- @shouldWarnWith OverlappingPattern

2+-- @shouldWarnWith OverlappingPattern

3+module Main where

4+

5+data X = A | B

6+

7+pat1 :: X -> Boolean

8+pat1 A = true

9+pat1 A = true

10+pat1 B = false

11+

12+pat2 :: X -> Boolean

13+pat2 A = true

14+pat2 _ = false

15+pat2 B = false

examples/warning/ScopeShadowing.pursnew file+13

@@ -0,0 +1,13 @@

1+-- @shouldWarnWith ScopeShadowing

2+module Main where

3+

4+import Prelude

5+

6+-- No warning at the definition, only when the name is later resolved

7+data Unit = Unit

8+

9+-- This is only a warning as the `Prelude` import is implicit. If `Unit` was

10+-- named explicitly in an import list, then this refernce to `Unit`

11+-- would be a `ScopeConflict` error instead.

12+test :: Unit

13+test = const Unit unit

examples/warning/ShadowedTypeVar.pursnew file+5

@@ -0,0 +1,5 @@

1+-- @shouldWarnWith ShadowedTypeVar

2+module Main where

3+

4+f :: forall a. (forall a. a -> a) -> a -> a

5+f g x = g x

examples/warning/UnnecessaryFFIModule.jsnew file+1

@@ -0,0 +1 @@

1+exports.out = null;

examples/warning/UnnecessaryFFIModule.pursnew file+5

@@ -0,0 +1,5 @@

1+-- @shouldWarnWith UnnecessaryFFIModule

2+module Main where

3+

4+t :: Boolean

5+t = true

examples/warning/UnusedDctorExplicitImport.pursnew file+8

@@ -0,0 +1,8 @@

1+-- @shouldWarnWith UnusedDctorExplicitImport

2+module Main where

3+

4+import Data.Ordering (Ordering(EQ, LT))

5+

6+f :: Ordering -> Ordering

7+f EQ = EQ

8+f x = x

examples/warning/UnusedDctorImportAll.pursnew file+7

@@ -0,0 +1,7 @@

1+-- @shouldWarnWith UnusedDctorImport

2+module Main where

3+

4+import Data.Ordering (Ordering(..))

5+

6+f :: Ordering -> Ordering

7+f x = x

examples/warning/UnusedDctorImportExplicit.pursnew file+7

@@ -0,0 +1,7 @@

1+-- @shouldWarnWith UnusedDctorImport

2+module Main where

3+

4+import Data.Ordering (Ordering(EQ))

5+

6+f :: Ordering -> Ordering

7+f x = x

examples/warning/UnusedExplicitImport.pursnew file+8

@@ -0,0 +1,8 @@

1+-- @shouldWarnWith UnusedExplicitImport

2+module Main where

3+

4+import Prelude (Unit, unit, pure, bind)

5+import Control.Monad.Eff (Eff)

6+

7+main :: Eff () Unit

8+main = pure unit

examples/warning/UnusedFFIImplementations.jsnew file+2

@@ -0,0 +1,2 @@

1+exports.yes = true;

2+exports.no = false;

examples/warning/UnusedFFIImplementations.pursnew file+4

@@ -0,0 +1,4 @@

1+-- @shouldWarnWith UnusedFFIImplementations

2+module Main where

3+

4+foreign import yes :: Boolean

examples/warning/UnusedImport.pursnew file+14

@@ -0,0 +1,14 @@

1+-- @shouldWarnWith UnusedImport

2+-- @shouldWarnWith UnusedImport

3+-- @shouldWarnWith UnusedImport

4+module Main where

5+

6+import Data.Unit (Unit, unit)

7+

8+-- All of the below are unused

9+import Control.Monad.Eff

10+import Control.Monad.Eff.Console as Console

11+import Test.Assert ()

12+

13+main :: Unit

14+main = unit

examples/warning/UnusedTypeVar.pursnew file+5

@@ -0,0 +1,5 @@

1+-- @shouldWarnWith UnusedTypeVar

2+module Main where

3+

4+f :: forall a b. a -> a

5+f x = x

examples/warning/WildcardInferredType.pursnew file+23

@@ -0,0 +1,23 @@

1+-- @shouldWarnWith WildcardInferredType

2+-- @shouldWarnWith WildcardInferredType

3+-- @shouldWarnWith WildcardInferredType

4+-- @shouldWarnWith WildcardInferredType

5+module Main where

6+

7+x :: Int

8+x = 0 :: _

9+

10+y :: _

11+y = 0

12+

13+z :: Int

14+z =

15+ let n :: _

16+ n = 0

17+ in n

18+

19+w :: Int

20+w = n

21+ where

22+ n :: _

23+ n = 0

psc-ide-server/PROTOCOL.md+22−14

@@ -38,15 +38,17 @@ The `type` command looks up the type for a given identifier.

3838

3939**Params:**

4040 - `search :: String`: The identifier to look for. Only matches on equality.

41− - `filters :: [Filter]`: These filters will be applied before looking for the

41+ - `filters :: (optional) [Filter]`: These filters will be applied before looking for the

4242 identifier. These filters get combined with *AND*, so a candidate must match *ALL*

4343 of them to be eligible.

44+ - `currentModule :: (optional) String`: see *Complete* command

4445```json

4546{

4647 "command": "type",

4748 "params": {

4849 "search": "filterM",

49− "filters": [Filter]

50+ "filters": [{..}],

51+ "currentModule": "Main"

5052 }

5153}

5254```

@@ -58,20 +60,25 @@ The possible types are returned in the same format as completions

5860The `complete` command looks up possible completions/corrections.

5961

6062**Params**:

61− - `filters :: [Filter]`: The same as for the `type` command. A candidate must match

62− all filters.

63− - `matcher :: (optional) Matcher`: The strategy used for matching candidates after filtering.

64− Results are scored internally and will be returned in the descending order where

65− the nth element is better then the n+1-th.

66−

67− If no matcher is given every candidate, that passes the filters, is returned in no

68− particular order.

63+ - `filters :: [Filter]`: The same as for the `type` command. A candidate must

64+ match all filters.

65+ - `matcher :: (optional) Matcher`: The strategy used for matching candidates

66+ after filtering. Results are scored internally and will be returned in the

67+ descending order where the nth element is better then the n+1-th.

68+ - `currentModule :: (optional) String`: The current modules name. If it matches

69+ with the rebuild cache non-exported modules will also be completed. You can

70+ fill the rebuild cache by using the "Rebuild" command.

71+

72+ If no matcher is given every candidate, that passes the filters, is returned

73+ in no particular order.

74+

6975```json

7076{

7177 "command": "complete",

7278 "params": {

73− "filters": [Filter],

74− "matcher": (optional) Matcher

79+ "filters": [{..}, {..}],

80+ "matcher": {..}

81+ "currentModule": "Main"

7582 }

7683}

7784```

@@ -244,10 +251,11 @@ Example:

244251

245252The `rebuild` command provides a fast rebuild for a single module. It doesn't

246253recompile the entire project though. All the modules dependencies need to be

247−loaded.

254+loaded. A successful rebuild will be stored to allow for completions of private

255+identifiers.

248256

249257Arguments:

250−- `file :: String` the path to the module to rebuild

258+ - `file :: String` the path to the module to rebuild

251259

252260```json

253261{

purescript.cabal+4

@@ -21,6 +21,7 @@ tested-with: GHC==7.10.3

2121

2222extra-source-files: examples/passing/*.purs

2323 , examples/passing/2018/*.purs

24+ , examples/passing/2138/*.purs

2425 , examples/passing/ClassRefSyntax/*.purs

2526 , examples/passing/DctorOperatorAlias/*.purs

2627 , examples/passing/ExplicitImportReExport/*.purs

@@ -38,6 +39,7 @@ extra-source-files: examples/passing/*.purs

3839 , examples/passing/ModuleExportSelf/*.purs

3940 , examples/passing/NonConflictingExports/*.purs

4041 , examples/passing/OperatorAliasElsewhere/*.purs

42+ , examples/passing/Operators/*.purs

4143 , examples/passing/PendingConflictingImports/*.purs

4244 , examples/passing/PendingConflictingImports2/*.purs

4345 , examples/passing/QualifiedNames/*.purs

@@ -66,6 +68,8 @@ extra-source-files: examples/passing/*.purs

6668 , examples/failing/InstanceExport/*.purs

6769 , examples/failing/OrphanInstance/*.purs

6870 , examples/failing/OverlappingReExport/*.purs

71+ , examples/warning/*.purs

72+ , examples/warning/*.js

6973 , examples/docs/bower_components/purescript-prelude/src/*.purs

7074 , examples/docs/bower.json

7175 , examples/docs/src/*.purs

src/Language/PureScript/Errors.hs+31−23

@@ -24,6 +24,7 @@ import Language.PureScript.Crash

2424import Language.PureScript.Kinds

2525import Language.PureScript.Names

2626import Language.PureScript.Pretty

27+import Language.PureScript.Traversals

2728import Language.PureScript.Types

2829import qualified Language.PureScript.Bundle as Bundle

2930import qualified Language.PureScript.Constants as C

@@ -112,7 +113,7 @@ data SimpleErrorMessage

112113 | ShadowedTypeVar String

113114 | UnusedTypeVar String

114115 | WildcardInferredType Type

115− | HoleInferredType String Type

116+ | HoleInferredType String Type [(Ident, Type)]

116117 | MissingTypeDeclaration Ident Type

117118 | OverlappingPattern [[Binder]] Bool

118119 | IncompleteExhaustivityCheck

@@ -127,7 +128,6 @@ data SimpleErrorMessage

127128 | DuplicateImportRef Name

128129 | DuplicateExportRef Name

129130 | IntOutOfRange Integer String Integer Integer

130− | RedundantEmptyHidingImport ModuleName

131131 | ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]

132132 | ImplicitImport ModuleName [DeclarationRef]

133133 | HidingImport ModuleName [DeclarationRef]

@@ -297,7 +297,6 @@ errorCode em = case unwrapErrorMessage em of

297297 DuplicateImportRef{} -> "DuplicateImportRef"

298298 DuplicateExportRef{} -> "DuplicateExportRef"

299299 IntOutOfRange{} -> "IntOutOfRange"

300− RedundantEmptyHidingImport{} -> "RedundantEmptyHidingImport"

301300 ImplicitQualifiedImport{} -> "ImplicitQualifiedImport"

302301 ImplicitImport{} -> "ImplicitImport"

303302 HidingImport{} -> "HidingImport"

@@ -339,14 +338,17 @@ addHint hint = onErrorMessages $ \(ErrorMessage hints se) -> ErrorMessage (hint

339338

340339-- | A map from rigid type variable name/unknown variable pairs to new variables.

341340data TypeMap = TypeMap

342− { umSkolemMap :: M.Map Int (String, Int, Maybe SourceSpan)

343− , umNextSkolem :: Int

344− , umUnknownMap :: M.Map Int Int

345− , umNextUnknown :: Int

341+ { umSkolemMap :: M.Map Int (String, Int, Maybe SourceSpan)

342+ -- ^ a map from skolems to their new names, including source and naming info

343+ , umUnknownMap :: M.Map Int Int

344+ -- ^ a map from unification variables to their new names

345+ , umNextIndex :: Int

346+ -- ^ unknowns and skolems share a source of names during renaming, to

347+ -- avoid overlaps in error messages. This is the next label for either case.

346348 } deriving Show

347349

348350defaultUnknownMap :: TypeMap

349−defaultUnknownMap = TypeMap M.empty 0 M.empty 0

351+defaultUnknownMap = TypeMap M.empty M.empty 0

350352

351353-- | How critical the issue is

352354data Level = Error | Warning deriving Show

@@ -365,16 +367,16 @@ replaceUnknowns = everywhereOnTypesM replaceTypes

365367 m <- get

366368 case M.lookup u (umUnknownMap m) of

367369 Nothing -> do

368− let u' = umNextUnknown m

369− put $ m { umUnknownMap = M.insert u u' (umUnknownMap m), umNextUnknown = u' + 1 }

370+ let u' = umNextIndex m

371+ put $ m { umUnknownMap = M.insert u u' (umUnknownMap m), umNextIndex = u' + 1 }

370372 return (TUnknown u')

371373 Just u' -> return (TUnknown u')

372374 replaceTypes (Skolem name s sko ss) = do

373375 m <- get

374376 case M.lookup s (umSkolemMap m) of

375377 Nothing -> do

376− let s' = umNextSkolem m

377− put $ m { umSkolemMap = M.insert s (name, s', ss) (umSkolemMap m), umNextSkolem = s' + 1 }

378+ let s' = umNextIndex m

379+ put $ m { umSkolemMap = M.insert s (name, s', ss) (umSkolemMap m), umNextIndex = s' + 1 }

378380 return (Skolem name s' sko ss)

379381 Just (_, s', _) -> return (Skolem name s' sko ss)

380382 replaceTypes other = return other

@@ -395,7 +397,7 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse

395397 gSimple (ExpectedType ty k) = ExpectedType <$> f ty <*> pure k

396398 gSimple (OrphanInstance nm cl ts) = OrphanInstance nm cl <$> traverse f ts

397399 gSimple (WildcardInferredType ty) = WildcardInferredType <$> f ty

398− gSimple (HoleInferredType name ty) = HoleInferredType name <$> f ty

400+ gSimple (HoleInferredType name ty env) = HoleInferredType name <$> f ty <*> traverse (sndM f) env

399401 gSimple (MissingTypeDeclaration nm ty) = MissingTypeDeclaration nm <$> f ty

400402 gSimple (CannotGeneralizeRecursiveFunction nm ty) = CannotGeneralizeRecursiveFunction nm <$> f ty

401403

@@ -418,7 +420,6 @@ wikiUri e = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ error

418420errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion

419421errorSuggestion err = case err of

420422 UnusedImport{} -> emptySuggestion

421− RedundantEmptyHidingImport{} -> emptySuggestion

422423 DuplicateImport{} -> emptySuggestion

423424 UnusedExplicitImport mn _ qual refs -> suggest $ importSuggestion mn refs qual

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

@@ -494,7 +495,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

494495 : foldMap (return . line . (" bound at " ++) . displayStartEndPos) ss

495496

496497 unknownInfo :: Int -> Box.Box

497− unknownInfo u = line $ "_" ++ show u ++ " is an unknown type"

498+ unknownInfo u = line $ "t" ++ show u ++ " is an unknown type"

498499

499500 renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box

500501 renderSimpleErrorMessage (CannotGetFileInfo path) =

@@ -576,7 +577,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

576577 paras [ line $ "Cannot import " ++ printName (Qualified Nothing name) ++ " from module " ++ runModuleName mn

577578 , line "It either does not exist or the module does not export it."

578579 ]

579− renderSimpleErrorMessage (UnknownImportDataConstructor mn dcon tcon) =

580+ renderSimpleErrorMessage (UnknownImportDataConstructor mn tcon dcon) =

580581 line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon

581582 renderSimpleErrorMessage (UnknownExport name) =

582583 line $ "Cannot export unknown " ++ printName (Qualified Nothing name)

@@ -817,10 +818,20 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

817818 paras [ line "Wildcard type definition has the inferred type "

818819 , indent $ typeAsBox ty

819820 ]

820− renderSimpleErrorMessage (HoleInferredType name ty) =

821− paras [ line $ "Hole '" ++ name ++ "' has the inferred type "

822− , indent $ typeAsBox ty

823− ]

821+ renderSimpleErrorMessage (HoleInferredType name ty env) =

822+ paras $ [ line $ "Hole '" ++ name ++ "' has the inferred type "

823+ , indent $ typeAsBox ty

824+ ] ++ if null env then [] else envInfo

825+ where

826+ envInfo :: [Box.Box]

827+ envInfo = [ line "in the following context:"

828+ , indent $ paras

829+ [ Box.hcat Box.left [ Box.text (showIdent ident <> " :: ")

830+ , typeAsBox ty'

831+ ]

832+ | (ident, ty') <- take 5 env

833+ ]

834+ ]

824835 renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =

825836 paras [ line $ "No type declaration was provided for the top-level declaration of " ++ showIdent ident ++ "."

826837 , line "It is good practice to provide type declarations as a form of documentation."

@@ -868,9 +879,6 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

868879 paras [ line $ "Integer value " ++ show value ++ " is out of range for the " ++ backend ++ " backend."

869880 , line $ "Acceptable values fall within the range " ++ show lo ++ " to " ++ show hi ++ " (inclusive)." ]

870881

871− renderSimpleErrorMessage (RedundantEmptyHidingImport mn) =

872− line $ "The import for module " ++ runModuleName mn ++ " is redundant as all members have been explicitly hidden."

873−

874882 renderSimpleErrorMessage msg@(ImplicitQualifiedImport importedModule asModule _) =

875883 paras [ line $ "Module " ++ runModuleName importedModule ++ " was imported as " ++ runModuleName asModule ++ " with unspecified imports."

876884 , line $ "As there are multiple modules being imported as " ++ runModuleName asModule ++ ", consider using the explicit form:"

src/Language/PureScript/Ide.hs+15−12

@@ -36,6 +36,7 @@ import Data.Maybe (catMaybes, mapMaybe)

3636import Data.Monoid

3737import Data.Text (Text)

3838import qualified Data.Text as T

39+import qualified Language.PureScript as P

3940import qualified Language.PureScript.Ide.CaseSplit as CS

4041import Language.PureScript.Ide.Command

4142import Language.PureScript.Ide.Completion

@@ -60,10 +61,10 @@ handleCommand :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

6061handleCommand (Load [] []) = loadAllModules

6162handleCommand (Load modules deps) =

6263 loadModulesAndDeps modules deps

63−handleCommand (Type search filters) =

64− findType search filters

65−handleCommand (Complete filters matcher) =

66− findCompletions filters matcher

64+handleCommand (Type search filters currentModule) =

65+ findType search filters currentModule

66+handleCommand (Complete filters matcher currentModule) =

67+ findCompletions filters matcher currentModule

6768handleCommand (Pursuit query Package) =

6869 findPursuitPackages query

6970handleCommand (Pursuit query Identifier) =

@@ -94,14 +95,16 @@ handleCommand Reset = resetPscIdeState *> pure (TextResult "State has been reset

9495handleCommand Quit = liftIO exitSuccess

9596

9697findCompletions :: (PscIde m, MonadLogger m) =>

97− [Filter] -> Matcher -> m Success

98−findCompletions filters matcher =

99− CompletionResult . mapMaybe completionFromMatch . getCompletions filters matcher <$> getAllModulesWithReexports

98+ [Filter] -> Matcher -> Maybe P.ModuleName -> m Success

99+findCompletions filters matcher currentModule = do

100+ modules <- getAllModulesWithReexportsAndCache currentModule

101+ pure . CompletionResult . mapMaybe completionFromMatch . getCompletions filters matcher $ modules

100102

101103findType :: (PscIde m, MonadLogger m) =>

102− DeclIdent -> [Filter] -> m Success

103−findType search filters =

104− CompletionResult . mapMaybe completionFromMatch . getExactMatches search filters <$> getAllModulesWithReexports

104+ DeclIdent -> [Filter] -> Maybe P.ModuleName -> m Success

105+findType search filters currentModule = do

106+ modules <- getAllModulesWithReexportsAndCache currentModule

107+ pure . CompletionResult . mapMaybe completionFromMatch . getExactMatches search filters $ modules

105108

106109findPursuitCompletions :: (MonadIO m, MonadLogger m) =>

107110 PursuitQuery -> m Success

@@ -113,14 +116,14 @@ findPursuitPackages :: (MonadIO m, MonadLogger m) =>

113116findPursuitPackages (PursuitQuery q) =

114117 PursuitResult <$> liftIO (findPackagesForModuleIdent q)

115118

116−loadExtern ::(PscIde m, MonadLogger m, MonadError PscIdeError m) =>

119+loadExtern :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

117120 FilePath -> m ()

118121loadExtern fp = do

119122 m <- readExternFile fp

120123 insertModule m

121124

122125printModules :: (PscIde m) => m Success

123−printModules = printModules' <$> getPscIdeState

126+printModules = printModules' . pscIdeStateModules <$> getPscIdeState

124127

125128printModules' :: M.Map ModuleIdent [ExternDecl] -> Success

126129printModules' = ModuleList . M.keys

src/Language/PureScript/Ide/Command.hs+56−58

@@ -21,10 +21,8 @@ import Prelude.Compat

2121

2222import Control.Monad

2323import Data.Aeson

24−import Data.Maybe

2524import Data.Text (Text)

26−import Language.PureScript (ModuleName,

27− moduleNameFromString)

25+import qualified Language.PureScript as P

2826import Language.PureScript.Ide.CaseSplit

2927import Language.PureScript.Ide.Filter

3028import Language.PureScript.Ide.Matcher

@@ -36,12 +34,14 @@ data Command

3634 , loadDependencies :: [ModuleIdent]

3735 }

3836 | Type

39− { typeSearch :: DeclIdent

40− , typeFilters :: [Filter]

37+ { typeSearch :: DeclIdent

38+ , typeFilters :: [Filter]

39+ , typeCurrentModule :: Maybe P.ModuleName

4140 }

4241 | Complete

43− { completeFilters :: [Filter]

44− , completeMatcher :: Matcher

42+ { completeFilters :: [Filter]

43+ , completeMatcher :: Matcher

44+ , completeCurrentModule :: Maybe P.ModuleName

4545 }

4646 | Pursuit

4747 { pursuitQuery :: PursuitQuery

@@ -67,7 +67,7 @@ data Command

6767 | Quit

6868

6969data ImportCommand

70− = AddImplicitImport ModuleName

70+ = AddImplicitImport P.ModuleName

7171 | AddImportForIdentifier DeclIdent

7272 deriving (Show, Eq)

7373

@@ -75,12 +75,10 @@ instance FromJSON ImportCommand where

7575 parseJSON = withObject "ImportCommand" $ \o -> do

7676 (command :: String) <- o .: "importCommand"

7777 case command of

78− "addImplicitImport" -> do

79− mn <- o .: "module"

80− pure (AddImplicitImport (moduleNameFromString mn))

81− "addImport" -> do

82− ident <- o .: "identifier"

83− pure (AddImportForIdentifier ident)

78+ "addImplicitImport" ->

79+ AddImplicitImport <$> (P.moduleNameFromString <$> o .: "module")

80+ "addImport" ->

81+ AddImportForIdentifier <$> o .: "identifier"

8482 _ -> mzero

8583

8684data ListType = LoadedModules | Imports FilePath | AvailableModules

@@ -89,69 +87,69 @@ instance FromJSON ListType where

8987 parseJSON = withObject "ListType" $ \o -> do

9088 (listType' :: String) <- o .: "type"

9189 case listType' of

92− "import" -> do

93− fp <- o .: "file"

94− return (Imports fp)

95− "loadedModules" -> return LoadedModules

96− "availableModules" -> return AvailableModules

90+ "import" -> Imports <$> o .: "file"

91+ "loadedModules" -> pure LoadedModules

92+ "availableModules" -> pure AvailableModules

9793 _ -> mzero

9894

9995instance FromJSON Command where

10096 parseJSON = withObject "command" $ \o -> do

10197 (command :: String) <- o .: "command"

10298 case command of

103− "list" -> do

104− listType' <- o .:? "params"

105− return $ List (fromMaybe LoadedModules listType')

106− "cwd" -> return Cwd

107− "quit" -> return Quit

99+ "list" -> List <$> o .:? "params" .!= LoadedModules

100+ "cwd" -> pure Cwd

101+ "quit" -> pure Quit

108102 "reset" -> pure Reset

109− "load" ->

110− maybe (pure (Load [] [])) (\params -> do

111− mods <- params .:? "modules"

112− deps <- params .:? "dependencies"

113− pure $ Load (fromMaybe [] mods) (fromMaybe [] deps)) =<< o .:? "params"

103+ "load" -> do

104+ params' <- o .:? "params"

105+ case params' of

106+ Nothing -> pure (Load [] [])

107+ Just params ->

108+ Load

109+ <$> params .:? "modules" .!= []

110+ <*> params .:? "dependencies" .!= []

114111 "type" -> do

115112 params <- o .: "params"

116− search <- params .: "search"

117− filters <- params .: "filters"

118− return $ Type search filters

113+ Type

114+ <$> params .: "search"

115+ <*> params .: "filters"

116+ <*> (fmap P.moduleNameFromString <$> params .:? "currentModule")

119117 "complete" -> do

120118 params <- o .: "params"

121− filters <- params .:? "filters"

122− matcher <- params .:? "matcher"

123− return $ Complete (fromMaybe [] filters) (fromMaybe mempty matcher)

119+ Complete

120+ <$> params .:? "filters" .!= []

121+ <*> params .:? "matcher" .!= mempty

122+ <*> (fmap P.moduleNameFromString <$> params .:? "currentModule")

124123 "pursuit" -> do

125124 params <- o .: "params"

126− query <- params .: "query"

127− queryType <- params .: "type"

128− return $ Pursuit query queryType

125+ Pursuit

126+ <$> params .: "query"

127+ <*> params .: "type"

129128 "caseSplit" -> do

130129 params <- o .: "params"

131− line <- params .: "line"

132− begin <- params .: "begin"

133− end <- params .: "end"

134− annotations <- params .: "annotations"

135− type' <- params .: "type"

136− return $ CaseSplit line begin end (if annotations

137− then explicitAnnotations

138− else noAnnotations) type'

130+ CaseSplit

131+ <$> params .: "line"

132+ <*> params .: "begin"

133+ <*> params .: "end"

134+ <*> (mkAnnotations <$> params .: "annotations")

135+ <*> params .: "type"

139136 "addClause" -> do

140137 params <- o .: "params"

141− line <- params .: "line"

142− annotations <- params .: "annotations"

143− return $ AddClause line (if annotations

144− then explicitAnnotations

145− else noAnnotations)

138+ AddClause

139+ <$> params .: "line"

140+ <*> (mkAnnotations <$> params .: "annotations")

146141 "import" -> do

147142 params <- o .: "params"

148− fp <- params .: "file"

149− out <- params .:? "outfile"

150− filters <- params .:? "filters"

151− importCommand <- params .: "importCommand"

152− pure $ Import fp out (fromMaybe [] filters) importCommand

143+ Import

144+ <$> params .: "file"

145+ <*> params .:? "outfile"

146+ <*> params .:? "filters" .!= []

147+ <*> params .: "importCommand"

153148 "rebuild" -> do

154149 params <- o .: "params"

155− filePath <- params .: "file"

156− return $ Rebuild filePath

150+ Rebuild

151+ <$> params .: "file"

157152 _ -> mzero

153+ where

154+ mkAnnotations True = explicitAnnotations

155+ mkAnnotations False = noAnnotations

src/Language/PureScript/Ide/Rebuild.hs+110−26

@@ -1,43 +1,64 @@

11{-# LANGUAGE OverloadedStrings #-}

22{-# LANGUAGE PackageImports #-}

3+{-# LANGUAGE RecordWildCards #-}

4+{-# LANGUAGE TemplateHaskell #-}

5+{-# LANGUAGE TupleSections #-}

36

4−module Language.PureScript.Ide.Rebuild where

5−

6−import Prelude.Compat

7−

8−import Language.PureScript.Ide.Error

9−import Language.PureScript.Ide.State

10−import Language.PureScript.Ide.Types

7+module Language.PureScript.Ide.Rebuild

8+ ( rebuildFile

9+ ) where

1110

1211import Control.Monad.Error.Class

1312import Control.Monad.IO.Class

1413import "monad-logger" Control.Monad.Logger

15−import Control.Monad.Reader.Class

14+import Control.Monad.Reader

1615import Control.Monad.Trans.Except

1716import qualified Data.Map.Lazy as M

1817import Data.Maybe (fromJust, mapMaybe)

18+import Data.Monoid ((<>))

1919import qualified Data.Set as S

2020import qualified Language.PureScript as P

2121import Language.PureScript.Errors.JSON

22−import System.IO.UTF8 (readUTF8File)

22+import Language.PureScript.Ide.Error

23+import Language.PureScript.Ide.State

24+import Language.PureScript.Ide.Types

25+import Language.PureScript.Ide.Util

26+import Prelude.Compat

27+import System.IO.UTF8 (readUTF8File)

2328

29+-- | Given a filepath performs the following steps:

30+--

31+-- * Reads and parses a PureScript module from the filepath.

32+--

33+-- * Builds a dependency graph for the parsed module from the already loaded

34+-- ExternsFiles.

35+--

36+-- * Attempts to find an FFI definition file for the module by looking

37+-- for a file with the same filepath except for a .js extension.

38+--

39+-- * Passes all the created artifacts to @rebuildModule@.

40+--

41+-- * If the rebuilding succeeds, returns a @RebuildSuccess@ with the generated

42+-- warnings, and if rebuilding fails, returns a @RebuildError@ with the

43+-- generated errors.

2444rebuildFile

2545 :: (PscIde m, MonadLogger m, MonadError PscIdeError m)

2646 => FilePath

2747 -> m Success

2848rebuildFile path = do

2949

30− input <- liftIO $ readUTF8File path

50+ input <- liftIO (readUTF8File path)

3151

32− m <- case map snd <$> P.parseModulesFromFiles id [(path, input)] of

33− Left parseError ->

34− throwError . RebuildError . toJSONErrors False P.Error $ parseError

35− Right [m] -> pure m

36− Right _ -> throwError . GeneralError $ "Please define exactly one module."

52+ m <- case snd <$> P.parseModuleFromFile id (path, input) of

53+ Left parseError -> throwError

54+ . RebuildError

55+ . toJSONErrors False P.Error

56+ $ P.MultipleErrors [P.toPositionedError parseError]

57+ Right m -> pure m

3758

3859 -- Externs files must be sorted ahead of time, so that they get applied

3960 -- correctly to the 'Environment'.

40− externs <- sortExterns m . M.delete (P.getModuleName m) =<< getExternFiles

61+ externs <- sortExterns m =<< getExternFiles

4162

4263 outputDirectory <- confOutputPath . envConfiguration <$> ask

4364

@@ -46,26 +67,85 @@ rebuildFile path = do

4667 let filePathMap = M.singleton (P.getModuleName m) (Left P.RebuildAlways)

4768 foreigns <- P.inferForeignModules (M.singleton (P.getModuleName m) (Right path))

4869

49− -- Silence progress update messages during the build

50− let actions = (P.buildMakeActions outputDirectory filePathMap foreigns False)

51− { P.progress = const (pure ()) }

52−

70+ let makeEnv = MakeActionsEnv outputDirectory filePathMap foreigns False

5371 -- Rebuild the single module using the cached externs

5472 (result, warnings) <- liftIO

55− . P.runMake P.defaultOptions

56− . P.rebuildModule actions externs

57− $ m

73+ . P.runMake P.defaultOptions

74+ . P.rebuildModule (buildMakeActions

75+ >>= shushProgress $ makeEnv) externs $ m

5876 case result of

59− Left errors -> throwError . RebuildError $ toJSONErrors False P.Error errors

60− Right _ -> pure . RebuildSuccess $ toJSONErrors False P.Warning warnings

77+ Left errors -> throwError (RebuildError (toJSONErrors False P.Error errors))

78+ Right _ -> do

79+ rebuildModuleOpen makeEnv externs m

80+ pure (RebuildSuccess (toJSONErrors False P.Warning warnings))

81+

82+-- | Rebuilds a module but opens up its export list first and stores the result

83+-- inside the rebuild cache

84+rebuildModuleOpen

85+ :: (PscIde m, MonadLogger m, MonadError PscIdeError m)

86+ => MakeActionsEnv

87+ -> [P.ExternsFile]

88+ -> P.Module

89+ -> m ()

90+rebuildModuleOpen makeEnv externs m = do

91+ (openResult, _) <- liftIO

92+ . P.runMake P.defaultOptions

93+ . P.rebuildModule (buildMakeActions

94+ >>= shushProgress

95+ >>= shushCodegen

96+ $ makeEnv) externs $ openModuleExports m

97+ case openResult of

98+ Left _ ->

99+ throwError (GeneralError "Failed when rebuilding with open exports")

100+ Right result -> do

101+ $(logDebug)

102+ ("Setting Rebuild cache: " <> runModuleNameT (P.efModuleName result))

103+ setCachedRebuild result

104+

105+-- | Parameters we can access while building our @MakeActions@

106+data MakeActionsEnv =

107+ MakeActionsEnv

108+ { maeOutputDirectory :: FilePath

109+ , maeFilePathMap :: M.Map P.ModuleName (Either P.RebuildPolicy FilePath)

110+ , maeForeignPathMap :: M.Map P.ModuleName FilePath

111+ , maePrefixComment :: Bool

112+ }

61113

114+-- | Builds the default @MakeActions@ from a @MakeActionsEnv@

115+buildMakeActions :: MakeActionsEnv -> P.MakeActions P.Make

116+buildMakeActions MakeActionsEnv{..} =

117+ P.buildMakeActions

118+ maeOutputDirectory

119+ maeFilePathMap

120+ maeForeignPathMap

121+ maePrefixComment

122+

123+-- | Shuts the compiler up about progress messages

124+shushProgress :: P.MakeActions P.Make -> MakeActionsEnv -> P.MakeActions P.Make

125+shushProgress ma _ =

126+ ma { P.progress = \_ -> pure () }

127+

128+-- | Stops any kind of codegen (also silences errors about missing or unused FFI

129+-- files though)

130+shushCodegen :: P.MakeActions P.Make -> MakeActionsEnv -> P.MakeActions P.Make

131+shushCodegen ma MakeActionsEnv{..} =

132+ ma { P.codegen = \_ _ _ -> pure () }

133+

134+-- | Returns a topologically sorted list of dependent ExternsFiles for the given

135+-- module. Throws an error if there is a cyclic dependency within the

136+-- ExternsFiles

62137sortExterns

63138 :: (PscIde m, MonadError PscIdeError m)

64139 => P.Module

65140 -> M.Map P.ModuleName P.ExternsFile

66141 -> m [P.ExternsFile]

67142sortExterns m ex = do

68− sorted' <- runExceptT . P.sortModules . (:) m . map mkShallowModule . M.elems $ ex

143+ sorted' <- runExceptT

144+ . P.sortModules

145+ . (:) m

146+ . map mkShallowModule

147+ . M.elems

148+ . M.delete (P.getModuleName m) $ ex

69149 case sorted' of

70150 Left _ -> throwError (GeneralError "There was a cycle in the dependencies")

71151 Right (sorted, graph) -> do

@@ -80,3 +160,7 @@ sortExterns m ex = do

80160 -- Sort a list so its elements appear in the same order as in another list.

81161 inOrderOf :: (Ord a) => [a] -> [a] -> [a]

82162 inOrderOf xs ys = let s = S.fromList xs in filter (`S.member` s) ys

163+

164+-- | Removes a modules export list.

165+openModuleExports :: P.Module -> P.Module

166+openModuleExports (P.Module ss cs mn decls _) = P.Module ss cs mn decls Nothing

src/Language/PureScript/Ide/State.hs+97−53

@@ -16,7 +16,19 @@

1616{-# LANGUAGE PackageImports #-}

1717{-# LANGUAGE TemplateHaskell #-}

1818

19−module Language.PureScript.Ide.State where

19+module Language.PureScript.Ide.State

20+ ( getPscIdeState

21+ , getExternFiles

22+ , getModule

23+ , getModuleWithReexports

24+ , getAllModulesWithReexports

25+ , getAllModulesWithReexportsAndCache

26+ , insertModule

27+ , insertModuleSTM

28+ , getCachedRebuild

29+ , resetPscIdeState

30+ , setCachedRebuild

31+ ) where

2032

2133import Prelude ()

2234import Prelude.Compat

@@ -26,74 +38,106 @@ import Control.Monad.IO.Class

2638import "monad-logger" Control.Monad.Logger

2739import Control.Monad.Reader.Class

2840import qualified Data.Map.Lazy as M

29−import Data.Maybe (catMaybes)

41+import Data.Maybe (mapMaybe)

3042import Data.Monoid

31−import qualified Data.Text as T

3243import Language.PureScript.Externs

3344import Language.PureScript.Ide.Externs

3445import Language.PureScript.Ide.Reexports

3546import Language.PureScript.Ide.Types

36−import Language.PureScript.Names

47+import Language.PureScript.Ide.Util

48+import qualified Language.PureScript as P

3749

50+-- | Resets the PscIdeState to emptyPscIdeState

3851resetPscIdeState :: PscIde m => m ()

3952resetPscIdeState = do

4053 stateVar <- envStateVar <$> ask

4154 liftIO $ atomically (writeTVar stateVar emptyPscIdeState)

4255

43−getPscIdeState :: (PscIde m) =>

44− m (M.Map ModuleIdent [ExternDecl])

56+-- | Gets the entire PscIdeState

57+getPscIdeState :: PscIde m => m PscIdeState

4558getPscIdeState = do

4659 stateVar <- envStateVar <$> ask

47− liftIO $ pscStateModules <$> readTVarIO stateVar

60+ liftIO (readTVarIO stateVar)

4861

49−getExternFiles :: (PscIde m) =>

50− m (M.Map ModuleName ExternsFile)

62+-- | Gets all loaded ExternFiles

63+getExternFiles :: (PscIde m) => m (M.Map P.ModuleName ExternsFile)

5164getExternFiles = do

5265 stateVar <- envStateVar <$> ask

53− liftIO (externsFiles <$> readTVarIO stateVar)

54−

55−getExternFile :: (PscIde m) =>

56− ModuleName -> m (Maybe ExternsFile)

57−getExternFile mn = M.lookup mn <$> getExternFiles

58−

59−getAllDecls :: (PscIde m) => m [ExternDecl]

60−getAllDecls = concat <$> getPscIdeState

61−

62−getAllModules :: (PscIde m) => m [Module]

63−getAllModules = M.toList <$> getPscIdeState

64−

65−getAllModulesWithReexports :: (PscIde m, MonadLogger m) =>

66− m [Module]

67−getAllModulesWithReexports = do

68− mis <- M.keys <$> getPscIdeState

69− ms <- traverse getModuleWithReexports mis

70− pure (catMaybes ms)

71−

72−getModule :: (PscIde m, MonadLogger m) =>

73− ModuleIdent -> m (Maybe Module)

74−getModule m = do

75− modules <- getPscIdeState

76− pure ((m,) <$> M.lookup m modules)

77−

78−getModuleWithReexports :: (PscIde m, MonadLogger m) =>

79− ModuleIdent -> m (Maybe Module)

80−getModuleWithReexports mi = do

81− m <- getModule mi

82− modules <- getPscIdeState

83− pure $ resolveReexports modules <$> m

84−

85−insertModule ::(PscIde m, MonadLogger m) =>

66+ liftIO (pscIdeStateExternsFiles <$> readTVarIO stateVar)

67+

68+-- | Gets all loaded Modules and resolves Reexports

69+getAllModulesWithReexports :: (PscIde m) => m [Module]

70+getAllModulesWithReexports = getAllModulesWithReexports' <$> getPscIdeState

71+

72+-- | Pure version of @getAllModulesWithReexports@

73+getAllModulesWithReexports' :: PscIdeState -> [Module]

74+getAllModulesWithReexports' state =

75+ mapMaybe (getModuleWithReexports' state) (M.keys (pscIdeStateModules state))

76+

77+-- | Checks if the given ModuleName matches the last rebuild cache and if it

78+-- does, runs @getAllModulesWithReexports@ with the cached module replacing the

79+-- loaded module

80+getAllModulesWithReexportsAndCache

81+ :: (PscIde m)

82+ => Maybe P.ModuleName

83+ -> m [Module]

84+getAllModulesWithReexportsAndCache Nothing = getAllModulesWithReexports

85+getAllModulesWithReexportsAndCache (Just mn) = do

86+ state <- getPscIdeState

87+ cachedRebuild <- getCachedRebuild

88+ case cachedRebuild of

89+ Just (cachedIdent, ef) | cachedIdent == mn ->

90+ pure (getAllModulesWithReexports' (insertModule' ef state))

91+ _ -> getAllModulesWithReexports

92+

93+-- | Looks up a single Module inside the loaded Modules

94+getModule :: (PscIde m, MonadLogger m) => ModuleIdent -> m (Maybe Module)

95+getModule m = getModule' <$> getPscIdeState <*> pure m

96+

97+-- | Pure version of @getModule@

98+getModule' :: PscIdeState -> ModuleIdent -> Maybe Module

99+getModule' ps mi = (mi,) <$> M.lookup mi (pscIdeStateModules ps)

100+

101+-- | Looks up a single Module and resolves its Reexports

102+getModuleWithReexports :: PscIde m => ModuleIdent -> m (Maybe Module)

103+getModuleWithReexports i = getModuleWithReexports' <$> getPscIdeState <*> pure i

104+

105+-- | Pure version of @getModuleWithReexports@

106+getModuleWithReexports' :: PscIdeState -> ModuleIdent -> Maybe Module

107+getModuleWithReexports' ps mi =

108+ resolveReexports (pscIdeStateModules ps) <$> getModule' ps mi

109+

110+-- | Inserts an @ExternsFile@ into the PscIdeState. Also converts the

111+-- ExternsFile into psc-ide's internal Declaration format

112+insertModule :: (PscIde m, MonadLogger m) =>

86113 ExternsFile -> m ()

87114insertModule externsFile = do

88− env <- ask

115+ stateVar <- envStateVar <$> ask

89116 let moduleName = efModuleName externsFile

90− $(logDebug) $ "Inserting Module: " <> T.pack (runModuleName moduleName)

91− liftIO . atomically $ insertModule' (envStateVar env) externsFile

92−

93−insertModule' :: TVar PscIdeState -> ExternsFile -> STM ()

94−insertModule' st ef =

95− modifyTVar st $ \x ->

96− x { externsFiles = M.insert (efModuleName ef) ef (externsFiles x)

97− , pscStateModules = let (mn, decls) = convertExterns ef

98− in M.insert mn decls (pscStateModules x)

99− }

117+ $(logDebug) $ "Inserting Module: " <> runModuleNameT moduleName

118+ liftIO . atomically $ insertModuleSTM stateVar externsFile

119+

120+-- | STM version of insertModule

121+insertModuleSTM :: TVar PscIdeState -> ExternsFile -> STM ()

122+insertModuleSTM st ef = modifyTVar st (insertModule' ef)

123+

124+-- | Pure version of insertModule

125+insertModule' :: ExternsFile -> PscIdeState -> PscIdeState

126+insertModule' ef state =

127+ state

128+ { pscIdeStateExternsFiles =

129+ M.insert (efModuleName ef) ef (pscIdeStateExternsFiles state)

130+ , pscIdeStateModules = let (mn, decls) = convertExterns ef

131+ in M.insert mn decls (pscIdeStateModules state)

132+ }

133+

134+-- | Sets rebuild cache to the given ExternsFile

135+setCachedRebuild :: PscIde m => ExternsFile -> m ()

136+setCachedRebuild ef = do

137+ st <- envStateVar <$> ask

138+ liftIO . atomically . modifyTVar st $ \x ->

139+ x { pscIdeStateCachedRebuild = Just (efModuleName ef, ef) }

140+

141+-- | Retrieves the rebuild cache

142+getCachedRebuild :: PscIde m => m (Maybe (P.ModuleName, ExternsFile))

143+getCachedRebuild = pscIdeStateCachedRebuild <$> getPscIdeState

src/Language/PureScript/Ide/Types.hs+4−3

@@ -83,12 +83,13 @@ type PscIde m = (MonadIO m, MonadReader PscIdeEnvironment m)

8383

8484data PscIdeState =

8585 PscIdeState

86− { pscStateModules :: M.Map Text [ExternDecl]

87− , externsFiles :: M.Map P.ModuleName ExternsFile

86+ { pscIdeStateModules :: M.Map Text [ExternDecl]

87+ , pscIdeStateExternsFiles :: M.Map P.ModuleName ExternsFile

88+ , pscIdeStateCachedRebuild :: Maybe (P.ModuleName, ExternsFile)

8889 } deriving Show

8990

9091emptyPscIdeState :: PscIdeState

91−emptyPscIdeState = PscIdeState M.empty M.empty

92+emptyPscIdeState = PscIdeState M.empty M.empty Nothing

9293

9394data Match = Match ModuleIdent ExternDecl

9495 deriving (Show, Eq)

src/Language/PureScript/Ide/Util.hs+3

@@ -34,6 +34,9 @@ runIdentT = T.pack . P.runIdent

3434runOpNameT :: P.OpName a -> Text

3535runOpNameT = T.pack . P.runOpName

3636

37+runModuleNameT :: P.ModuleName -> Text

38+runModuleNameT = T.pack . P.runModuleName

39+

3740prettyTypeT :: P.Type -> Text

3841prettyTypeT = T.unwords . fmap T.strip . T.lines . T.pack . P.prettyPrintType

3942

src/Language/PureScript/Ide/Watcher.hs+7−6

@@ -35,14 +35,15 @@ reloadFile stateVar ev = do

3535 case ef' of

3636 Left _ -> pure ()

3737 Right ef -> do

38− atomically (insertModule' stateVar ef)

38+ atomically (insertModuleSTM stateVar ef)

3939 putStrLn ("Reloaded File at: " ++ fp)

4040

4141-- | Installs filewatchers for the given directory and reloads ExternsFiles when

4242-- they change on disc

4343watcher :: TVar PscIdeState -> FilePath -> IO ()

44−watcher stateVar fp = withManagerConf (defaultConfig { confDebounce = NoDebounce }) $ \mgr -> do

45− _ <- watchTree mgr fp

46− (\ev -> takeFileName (eventPath ev) == "externs.json")

47− (reloadFile stateVar)

48− forever (threadDelay 100000)

44+watcher stateVar fp =

45+ withManagerConf (defaultConfig { confDebounce = NoDebounce }) $ \mgr -> do

46+ _ <- watchTree mgr fp

47+ (\ev -> takeFileName (eventPath ev) == "externs.json")

48+ (reloadFile stateVar)

49+ forever (threadDelay 100000)

src/Language/PureScript/Interactive/Module.hs+8−7

@@ -44,14 +44,15 @@ loadAllModules files = do

4444createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module

4545createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindings = lets} val =

4646 let

47− moduleName = P.ModuleName [P.ProperName "$PSCI"]

48− trace = P.Var (P.Qualified (Just supportModuleName) (P.Ident "eval"))

49− mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))

50− itDecl = P.ValueDeclaration (P.Ident "it") P.Public [] $ Right val

51− mainDecl = P.ValueDeclaration (P.Ident "$main") P.Public [] $ Right mainValue

52− decls = if exec then [itDecl, mainDecl] else [itDecl]

47+ moduleName = P.ModuleName [P.ProperName "$PSCI"]

48+ supportImport = (supportModuleName, P.Implicit, Just (P.ModuleName [P.ProperName "$Support"]))

49+ eval = P.Var (P.Qualified (Just (P.ModuleName [P.ProperName "$Support"])) (P.Ident "eval"))

50+ mainValue = P.App eval (P.Var (P.Qualified Nothing (P.Ident "it")))

51+ itDecl = P.ValueDeclaration (P.Ident "it") P.Public [] $ Right val

52+ mainDecl = P.ValueDeclaration (P.Ident "$main") P.Public [] $ Right mainValue

53+ decls = if exec then [itDecl, mainDecl] else [itDecl]

5354 in

54− P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing

55+ P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName ((importDecl `map` (supportImport : imports)) ++ lets ++ decls) Nothing

5556

5657

5758-- |

src/Language/PureScript/Linter/Exhaustive.hs+33−24

@@ -14,6 +14,7 @@ import Control.Applicative

1414import Control.Arrow (first, second)

1515import Control.Monad (unless)

1616import Control.Monad.Writer.Class

17+import Control.Monad.Supply.Class (MonadSupply, fresh, freshName)

1718

1819import Data.Function (on)

1920import Data.List (foldl', sortBy, nub)

@@ -45,7 +46,7 @@ data RedundancyError = Incomplete | Unknown

4546-- Qualifies a propername from a given qualified propername and a default module name

4647--

4748qualifyName

48− :: (ProperName a)

49+ :: ProperName a

4950 -> ModuleName

5051 -> Qualified (ProperName b)

5152 -> Qualified (ProperName a)

@@ -231,7 +232,7 @@ missingAlternative env mn ca uncovered

231232--

232233checkExhaustive

233234 :: forall m

234− . (MonadWriter MultipleErrors m)

235+ . (MonadWriter MultipleErrors m, MonadSupply m)

235236 => Environment

236237 -> ModuleName

237238 -> Int

@@ -262,7 +263,7 @@ checkExhaustive env mn numArgs cas expr = makeResult . first nub $ foldl' step (

262263 _ -> return ()

263264 if null bss

264265 then return expr

265− else return (addPartialConstraint (second null (splitAt 5 bss)) expr)

266+ else addPartialConstraint (second null (splitAt 5 bss)) expr

266267 where

267268 tellRedundant = tell . errorMessage . uncurry OverlappingPattern . second null . splitAt 5 $ bss'

268269 tellIncomplete = tell . errorMessage $ IncompleteExhaustivityCheck

@@ -273,34 +274,42 @@ checkExhaustive env mn numArgs cas expr = makeResult . first nub $ foldl' step (

273274 --

274275 -- The binder information is provided so that it can be embedded in the constraint,

275276 -- and then included in the error message.

276− addPartialConstraint :: ([[Binder]], Bool) -> Expr -> Expr

277− addPartialConstraint (bss, complete) e =

278− Let [ partial ] (App (Var (Qualified Nothing (Ident C.__unused))) e)

277+ addPartialConstraint :: MonadSupply m => ([[Binder]], Bool) -> Expr -> m Expr

278+ addPartialConstraint (bss, complete) e = do

279+ tyVar <- ("p" ++) . show <$> fresh

280+ var <- freshName

281+ return $

282+ Let

283+ [ partial var tyVar ]

284+ $ App (Var (Qualified Nothing (Ident C.__unused))) e

279285 where

280− partial :: Declaration

281− partial = ValueDeclaration (Ident C.__unused)

282− Private

283− []

284− (Right (TypedValue True (Abs (Left (Ident "x"))

285− (Var (Qualified Nothing (Ident "x"))))

286− ty))

287−

288− ty :: Type

289− ty = ForAll "a" (ConstrainedType [ Constraint (Qualified (Just (ModuleName [ProperName C.prim]))

290− (ProperName "Partial"))

291− []

292− (Just (PartialConstraintData (map (map prettyPrintBinderAtom) bss) complete))

293− ]

294− (TypeApp (TypeApp tyFunction (TypeVar "a"))

295− (TypeVar "a")))

296− Nothing

286+ partial :: String -> String -> Declaration

287+ partial var tyVar =

288+ ValueDeclaration (Ident C.__unused) Private [] $ Right $

289+ TypedValue

290+ True

291+ (Abs (Left (Ident var)) (Var (Qualified Nothing (Ident var))))

292+ (ty tyVar)

293+

294+ ty :: String -> Type

295+ ty tyVar =

296+ ForAll tyVar

297+ ( ConstrainedType

298+ [ Constraint C.Partial [] (Just constraintData) ]

299+ $ TypeApp (TypeApp tyFunction (TypeVar tyVar)) (TypeVar tyVar)

300+ )

301+ Nothing

302+

303+ constraintData :: ConstraintData

304+ constraintData =

305+ PartialConstraintData (map (map prettyPrintBinderAtom) bss) complete

297306

298307-- |

299308-- Exhaustivity checking

300309--

301310checkExhaustiveExpr

302311 :: forall m

303− . MonadWriter MultipleErrors m

312+ . (MonadWriter MultipleErrors m, MonadSupply m)

304313 => Environment

305314 -> ModuleName

306315 -> Expr

src/Language/PureScript/Linter/Imports.hs+32−35

@@ -6,7 +6,7 @@ module Language.PureScript.Linter.Imports

66

77import Prelude.Compat

88

9−import Control.Monad (join, unless, when, foldM, (<=<))

9+import Control.Monad (join, unless, foldM, (<=<))

1010import Control.Monad.Writer.Class

1111

1212import Data.Function (on)

@@ -54,12 +54,13 @@ lintImports

5454 -> Env

5555 -> UsedImports

5656 -> m ()

57−lintImports (Module _ _ _ _ Nothing) _ _ = return ()

57+lintImports (Module _ _ _ _ Nothing) _ _ =

58+ internalError "lintImports needs desugared exports"

5859lintImports (Module ss _ mn mdecls (Just mexports)) env usedImps = do

5960

6061 -- TODO: this needs some work to be easier to understand

6162

62− let scope = maybe nullImports (\(_, imps', _) -> imps') (M.lookup mn env)

63+ let scope = maybe primImports (\(_, imps', _) -> imps') (M.lookup mn env)

6364 usedImps' = foldr (elaborateUsed scope) usedImps exportedModules

6465 numOpenImports = getSum $ foldMap (Sum . countOpenImports) mdecls

6566 allowImplicit = numOpenImports == 1

@@ -100,13 +101,11 @@ lintImports (Module ss _ mn mdecls (Just mexports)) env usedImps = do

100101 maybe id warnWithPosition pos $

101102 tell $ errorMessage $ DuplicateSelectiveImport mnq

102103

103− for_ (imps \\ (warned ++ duplicates)) $ \(pos, typ, _) -> do

104+ for_ (imps \\ (warned ++ duplicates)) $ \(pos, typ, _) ->

104105 warnDuplicateRefs (fromMaybe ss pos) DuplicateImportRef $ case typ of

105106 Explicit refs -> refs

106107 Hiding refs -> refs

107108 _ -> []

108− for_ (M.lookup mn env) $ \(_, imported, _) ->

109− checkEmptyImport mnq imported typ

110109

111110 where

112111

@@ -120,9 +119,9 @@ lintImports (Module ss _ mn mdecls (Just mexports)) env usedImps = do

120119 countOpenImports :: Declaration -> Int

121120 countOpenImports (PositionedDeclaration _ _ d) = countOpenImports d

122121 countOpenImports (ImportDeclaration mn' Implicit Nothing)

123− | not (isPrim mn') = 1

122+ | not (isPrim mn' || mn == mn') = 1

124123 countOpenImports (ImportDeclaration mn' (Hiding _) Nothing)

125− | not (isPrim mn') = 1

124+ | not (isPrim mn' || mn == mn') = 1

126125 countOpenImports _ = 0

127126

128127 -- Checks whether a module is the Prim module - used to suppress any checks

@@ -160,9 +159,11 @@ lintImports (Module ss _ mn mdecls (Just mexports)) env usedImps = do

160159 elaborateUsed scope mne used =

161160 foldr go used

162161 $ extractByQual mne (importedTypeClasses scope) TyClassName

162+ ++ extractByQual mne (importedTypeOps scope) TyOpName

163163 ++ extractByQual mne (importedTypes scope) TyName

164164 ++ extractByQual mne (importedDataConstructors scope) DctorName

165165 ++ extractByQual mne (importedValues scope) IdentName

166+ ++ extractByQual mne (importedValueOps scope) ValOpName

166167 where

167168 go :: (ModuleName, Qualified Name) -> UsedImports -> UsedImports

168169 go (q, name) = M.alter (Just . maybe [name] (name :)) q

@@ -199,7 +200,10 @@ lintImportDecl

199200lintImportDecl env mni qualifierName names declType allowImplicit =

200201 case declType of

201202 Implicit -> case qualifierName of

202− Nothing -> unless' allowImplicit (checkImplicit ImplicitImport)

203+ Nothing ->

204+ if null allRefs

205+ then unused

206+ else unless' allowImplicit (checkImplicit ImplicitImport)

203207 Just q -> unless' (q `elem` mapMaybe getQual names) unused

204208 Hiding _ -> unless' allowImplicit (checkImplicit HidingImport)

205209 Explicit [] -> unused

@@ -213,7 +217,15 @@ lintImportDecl env mni qualifierName names declType allowImplicit =

213217 checkImplicit warning =

214218 if null allRefs

215219 then unused

216− else warn (warning mni allRefs)

220+ else warn (warning mni (map simplifyTypeRef allRefs))

221+ where

222+ -- Replace explicit type refs with data constructor lists from listing the

223+ -- used constructors explicity `T(X, Y, [...])` to `T(..)` for suggestion

224+ -- message.

225+ simplifyTypeRef :: DeclarationRef -> DeclarationRef

226+ simplifyTypeRef (TypeRef name (Just dctors))

227+ | not (null dctors) = TypeRef name Nothing

228+ simplifyTypeRef other = other

217229

218230 checkExplicit

219231 :: [DeclarationRef]

@@ -248,9 +260,15 @@ lintImportDecl env mni qualifierName names declType allowImplicit =

248260 warn :: SimpleErrorMessage -> m Bool

249261 warn err = tell (errorMessage err) >> return True

250262

263+ -- Unless the boolean is true, run the action. Return false when the action is

264+ -- not run, otherwise return whatever the action does.

265+ --

266+ -- The return value is intended for cases where we want to track whether some

267+ -- work was done, as there may be further conditions in the action that mean

268+ -- it ends up doing nothing.

251269 unless' :: Bool -> m Bool -> m Bool

252− unless' True m = m

253− unless' False _ = return False

270+ unless' False m = m

271+ unless' True _ = return False

254272

255273 allRefs :: [DeclarationRef]

256274 allRefs = findUsedRefs env mni qualifierName names

@@ -282,6 +300,7 @@ findUsedRefs env mni qn names =

282300 let

283301 classRefs = TypeClassRef <$> mapMaybe (getClassName <=< disqualifyFor qn) names

284302 valueRefs = ValueRef <$> mapMaybe (getIdentName <=< disqualifyFor qn) names

303+ valueOpRefs = ValueOpRef <$> mapMaybe (getValOpName <=< disqualifyFor qn) names

285304 typeOpRefs = TypeOpRef <$> mapMaybe (getTypeOpName <=< disqualifyFor qn) names

286305 types = mapMaybe (getTypeName <=< disqualifyFor qn) names

287306 dctors = mapMaybe (getDctorName <=< disqualifyFor qn) names

@@ -290,7 +309,7 @@ findUsedRefs env mni qn names =

290309 typesRefs

291310 = map (flip TypeRef (Just [])) typesWithoutDctors

292311 ++ map (\(ty, ds) -> TypeRef ty (Just ds)) (M.toList typesWithDctors)

293− in classRefs ++ typeOpRefs ++ typesRefs ++ valueRefs

312+ in classRefs ++ typeOpRefs ++ typesRefs ++ valueRefs ++ valueOpRefs

294313

295314 where

296315

@@ -344,25 +363,3 @@ checkDuplicateImports mn xs ((_, t1, q1), (pos, t2, q2)) =

344363 tell $ errorMessage $ DuplicateImport mn t2 q2

345364 return $ (pos, t2, q2) : xs

346365 else return xs

347−

348−-- |

349−-- Checks that an import with a hiding reference is not hiding all possible

350−-- imports.

351−--

352−checkEmptyImport

353− :: MonadWriter MultipleErrors m

354− => ModuleName

355− -> Imports

356− -> ImportDeclarationType

357− -> m ()

358−checkEmptyImport importModule imps (Hiding _) = do

359− let isEmptyImport

360− = M.null (importedTypes imps)

361− && M.null (importedTypeOps imps)

362− && M.null (importedDataConstructors imps)

363− && M.null (importedTypeClasses imps)

364− && M.null (importedValues imps)

365− && M.null (importedValueOps imps)

366− when isEmptyImport . tell . errorMessage $

367− RedundantEmptyHidingImport importModule

368−checkEmptyImport _ _ _ = return ()

src/Language/PureScript/Parser/Declarations.hs+27−12

@@ -5,12 +5,14 @@ module Language.PureScript.Parser.Declarations

55 ( parseDeclaration

66 , parseModule

77 , parseModulesFromFiles

8+ , parseModuleFromFile

89 , parseValue

910 , parseGuard

1011 , parseBinder

1112 , parseBinderNoParens

1213 , parseImportDeclaration'

1314 , parseLocalDeclaration

15+ , toPositionedError

1416 ) where

1517

1618import Prelude hiding (lex)

@@ -232,7 +234,6 @@ parseDeclaration = positioned (P.choice

232234 , parseValueDeclaration

233235 , parseExternDeclaration

234236 , parseFixityDeclaration

235− , parseImportDeclaration

236237 , parseTypeClassDeclaration

237238 , parseTypeInstanceDeclaration

238239 , parseDerivingInstanceDeclaration

@@ -256,7 +257,13 @@ parseModule = do

256257 name <- moduleName

257258 exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef

258259 reserved "where"

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

260+ decls <- mark $ do

261+ -- TODO: extract a module header structure here, and provide a

262+ -- parseModuleHeader function. This should allow us to speed up rebuilds

263+ -- by only parsing as far as the module header. See PR #2054.

264+ imports <- P.many (same *> parseImportDeclaration)

265+ decls <- P.many (same *> parseDeclaration)

266+ return (imports ++ decls)

260267 _ <- P.eof

261268 end <- P.getPosition

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

@@ -270,11 +277,7 @@ parseModulesFromFiles

270277 -> [(k, String)]

271278 -> m [(k, Module)]

272279parseModulesFromFiles toFilePath input =

273− flip parU wrapError . inParallel . flip map input $ \(k, content) -> do

274− let filename = toFilePath k

275− ts <- lex filename content

276− m <- runTokenParser filename parseModule ts

277− return (k, m)

280+ flip parU wrapError . inParallel . flip map input $ parseModuleFromFile toFilePath

278281 where

279282 wrapError :: Either P.ParseError a -> m a

280283 wrapError = either (throwError . MultipleErrors . pure . toPositionedError) return

@@ -285,6 +288,18 @@ parseModulesFromFiles toFilePath input =

285288 inParallel = withStrategy (parList rseq)

286289

287290

291+-- | Parses a single module with FilePath for eventual parsing errors

292+parseModuleFromFile

293+ :: (k -> FilePath)

294+ -> (k, String)

295+ -> Either P.ParseError (k, Module)

296+parseModuleFromFile toFilePath (k, content) = do

297+ let filename = toFilePath k

298+ ts <- lex filename content

299+ m <- runTokenParser filename parseModule ts

300+ pure (k, m)

301+

302+-- | Converts a @ParseError@ into a @PositionedError@

288303toPositionedError :: P.ParseError -> ErrorMessage

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

290305 where

@@ -494,12 +509,12 @@ parseNullBinder = underscore *> return NullBinder

494509

495510parseIdentifierAndBinder :: TokenParser (String, Binder)

496511parseIdentifierAndBinder =

497− do name <- lname

498− b <- P.option (VarBinder (Ident name)) rest

499− return (name, b)

500− <|> (,) <$> stringLiteral <*> rest

512+ do name <- lname

513+ b <- P.option (VarBinder (Ident name)) rest

514+ return (name, b)

515+ <|> (,) <$> stringLiteral <*> rest

501516 where

502− rest = C.indented *> (equals <|> colon) *> C.indented *> parseBinder

517+ rest = C.indented *> colon *> C.indented *> parseBinder

503518

504519-- |

505520-- Parse a binder

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

@@ -34,7 +34,7 @@ typeLiterals = mkPattern match

3434 match (TypeVar var) = Just $ text var

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

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

37− match (TUnknown u) = Just $ text $ '_' : show u

37+ match (TUnknown u) = Just $ text $ 't' : show u

3838 match (Skolem name s _ _) = Just $ text $ name ++ show s

3939 match REmpty = Just $ text "()"

4040 match row@RCons{} = Just $ prettyPrintRowWith '(' ')' row

src/Language/PureScript/Sugar/Names.hs+30−68

@@ -16,7 +16,7 @@ import Control.Monad.Error.Class (MonadError(..))

1616import Control.Monad.State.Lazy

1717import Control.Monad.Writer (MonadWriter(..), censor)

1818

19−import Data.List (find, nub)

19+import Data.List (nub)

2020import Data.Maybe (fromMaybe, mapMaybe)

2121import qualified Data.Map as M

2222import qualified Data.Set as S

@@ -65,9 +65,9 @@ desugarImportsWithEnv externs modules = do

6565 externsEnv env ExternsFile{..} = do

6666 let members = Exports{..}

6767 ss = internalModuleSourceSpan "<Externs>"

68− env' = M.insert efModuleName (ss, nullImports, members) env

68+ env' = M.insert efModuleName (ss, primImports, members) env

6969 fromEFImport (ExternsImport mn mt qmn) = (mn, [(Nothing, Just mt, qmn)])

70− imps <- foldM (resolveModuleImport env') nullImports (map fromEFImport efImports)

70+ imps <- foldM (resolveModuleImport env') primImports (map fromEFImport efImports)

7171 exps <- resolveExports env' ss efModuleName imps members efExports

7272 return $ M.insert efModuleName (ss, imps, exps) env

7373 where

@@ -101,7 +101,7 @@ desugarImportsWithEnv externs modules = do

101101 Just m' -> throwError . errorMessage $ RedefinedModule mn [envModuleSourceSpan m', ss]

102102 Nothing -> do

103103 members <- findExportable m

104− let env' = M.insert mn (ss, nullImports, members) env

104+ let env' = M.insert mn (ss, primImports, members) env

105105 (m', imps) <- resolveImports env' m

106106 exps <- maybe (return members) (resolveExports env' ss mn imps members) refs

107107 return (m' : ms, M.insert mn (ss, imps, exps) env)

@@ -110,8 +110,8 @@ desugarImportsWithEnv externs modules = do

110110 renameInModule' env m@(Module _ _ mn _ _) =

111111 warnAndRethrow (addHint (ErrorInModule mn)) $ do

112112 let (_, imps, exps) = fromMaybe (internalError "Module is missing in renameInModule'") $ M.lookup mn env

113− (m', used) <- flip runStateT M.empty $ renameInModule env imps (elaborateExports exps m)

114− lintImports m env used

113+ (m', used) <- flip runStateT M.empty $ renameInModule imps (elaborateExports exps m)

114+ lintImports m' env used

115115 return m'

116116

117117-- |

@@ -147,11 +147,10 @@ elaborateExports exps (Module ss coms mn decls refs) =

147147renameInModule

148148 :: forall m

149149 . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadState UsedImports m)

150− => Env

151− -> Imports

150+ => Imports

152151 -> Module

153152 -> m Module

154−renameInModule env imports (Module ss coms mn decls exps) =

153+renameInModule imports (Module ss coms mn decls exps) =

155154 Module ss coms mn <$> parU decls go <*> pure exps

156155 where

157156

@@ -219,10 +218,9 @@ renameInModule env imports (Module ss coms mn decls exps) =

219218 (,) s <$> (ConstructorBinder <$> updateDataConstructorName name pos <*> pure b)

220219 updateBinder s@(pos, _) (OpBinder op) =

221220 (,) s <$> (OpBinder <$> updateValueOpName op pos)

222− updateBinder s (TypedBinder t b) = do

223− (s'@ (span', _), b') <- updateBinder s b

224− t' <- updateTypesEverywhere span' t

225− return (s', TypedBinder t' b')

221+ updateBinder s@(pos, _) (TypedBinder t b) = do

222+ t' <- updateTypesEverywhere pos t

223+ return (s, TypedBinder t' b)

226224 updateBinder s v =

227225 return (s, v)

228226

@@ -244,82 +242,51 @@ renameInModule env imports (Module ss coms mn decls exps) =

244242 updateType :: Type -> m Type

245243 updateType (TypeOp name) = TypeOp <$> updateTypeOpName name pos

246244 updateType (TypeConstructor name) = TypeConstructor <$> updateTypeName name pos

247− updateType (ConstrainedType cs t) = ConstrainedType <$> updateConstraints pos cs <*> pure t

245+ updateType (ConstrainedType cs t) = ConstrainedType <$> traverse updateInConstraint cs <*> pure t

248246 updateType t = return t

247+ updateInConstraint :: Constraint -> m Constraint

248+ updateInConstraint (Constraint name ts info) =

249+ Constraint <$> updateClassName name pos <*> pure ts <*> pure info

249250

250251 updateConstraints :: Maybe SourceSpan -> [Constraint] -> m [Constraint]

251− updateConstraints pos = traverse (\(Constraint name ts info) ->

252− Constraint <$> updateClassName name pos

253− <*> traverse (updateTypesEverywhere pos) ts

254− <*> pure info)

252+ updateConstraints pos = traverse $ \(Constraint name ts info) ->

253+ Constraint

254+ <$> updateClassName name pos

255+ <*> traverse (updateTypesEverywhere pos) ts

256+ <*> pure info

255257

256258 updateTypeName

257259 :: Qualified (ProperName 'TypeName)

258260 -> Maybe SourceSpan

259261 -> m (Qualified (ProperName 'TypeName))

260− updateTypeName =

261− update (importedTypes imports) (resolveType . exportedTypes) TyName

262+ updateTypeName = update (importedTypes imports) TyName

262263

263264 updateTypeOpName

264265 :: Qualified (OpName 'TypeOpName)

265266 -> Maybe SourceSpan

266267 -> m (Qualified (OpName 'TypeOpName))

267− updateTypeOpName =

268− update (importedTypeOps imports) (resolve . exportedTypeOps) TyOpName

268+ updateTypeOpName = update (importedTypeOps imports) TyOpName

269269

270270 updateDataConstructorName

271271 :: Qualified (ProperName 'ConstructorName)

272272 -> Maybe SourceSpan

273273 -> m (Qualified (ProperName 'ConstructorName))

274− updateDataConstructorName =

275− update

276− (importedDataConstructors imports)

277− (resolveDctor . exportedTypes)

278− DctorName

274+ updateDataConstructorName = update (importedDataConstructors imports) DctorName

279275

280276 updateClassName

281277 :: Qualified (ProperName 'ClassName)

282278 -> Maybe SourceSpan

283279 -> m (Qualified (ProperName 'ClassName))

284− updateClassName =

285− update

286− (importedTypeClasses imports)

287− (resolve . exportedTypeClasses)

288− TyClassName

280+ updateClassName = update (importedTypeClasses imports) TyClassName

289281

290282 updateValueName :: Qualified Ident -> Maybe SourceSpan -> m (Qualified Ident)

291− updateValueName =

292− update (importedValues imports) (resolve . exportedValues) IdentName

283+ updateValueName = update (importedValues imports) IdentName

293284

294285 updateValueOpName

295286 :: Qualified (OpName 'ValueOpName)

296287 -> Maybe SourceSpan

297288 -> m (Qualified (OpName 'ValueOpName))

298− updateValueOpName =

299− update (importedValueOps imports) (resolve . exportedValueOps) ValOpName

300−

301− -- Used when performing an update to qualify values and classes with their

302− -- module of original definition.

303− resolve :: Ord a => M.Map a ModuleName -> a -> Maybe (Qualified a)

304− resolve as name = mkQualified name <$> name `M.lookup` as

305−

306− -- Used when performing an update to qualify types with their module of

307− -- original definition.

308− resolveType

309− :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ModuleName)

310− -> ProperName 'TypeName

311− -> Maybe (Qualified (ProperName 'TypeName))

312− resolveType tys name =

313− mkQualified name . snd <$> M.lookup name tys

314−

315− -- Used when performing an update to qualify data constructors with their

316− -- module of original definition.

317− resolveDctor

318− :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ModuleName)

319− -> ProperName 'ConstructorName

320− -> Maybe (Qualified (ProperName 'ConstructorName))

321− resolveDctor tys name =

322− mkQualified name . snd <$> find (elem name . fst) tys

289+ updateValueOpName = update (importedValueOps imports) ValOpName

323290

324291 -- Update names so unqualified references become qualified, and locally

325292 -- qualified references are replaced with their canoncial qualified names

@@ -327,12 +294,11 @@ renameInModule env imports (Module ss coms mn decls exps) =

327294 update

328295 :: (Ord a, Show a)

329296 => M.Map (Qualified a) [ImportRecord a]

330− -> (Exports -> a -> Maybe (Qualified a))

331297 -> (a -> Name)

332298 -> Qualified a

333299 -> Maybe SourceSpan

334300 -> m (Qualified a)

335− update imps getE toName qname@(Qualified mn' name) pos = positioned $

301+ update imps toName qname@(Qualified mn' name) pos = positioned $

336302 case (M.lookup qname imps, mn') of

337303

338304 -- We found the name in our imports, so we return the name for it,

@@ -354,13 +320,9 @@ renameInModule env imports (Module ss coms mn decls exps) =

354320 -- by qualified importing). If that's not the case, then we just need to

355321 -- check it refers to a symbol in another module.

356322 (Nothing, Just mn'') ->

357− case M.lookup mn'' env of

358− Nothing

359− | mn'' `S.member` importedVirtualModules imports -> throwUnknown

360− | otherwise ->

361− throwError . errorMessage .

362− UnknownName . Qualified Nothing $ ModName mn''

363− Just env' -> maybe throwUnknown return (getE (envModuleExports env') name)

323+ if mn'' `S.member` importedQualModules imports || mn'' `S.member` importedModules imports

324+ then throwUnknown

325+ else throwError . errorMessage . UnknownName . Qualified Nothing $ ModName mn''

364326

365327 -- If neither of the above cases are true then it's an undefined or

366328 -- unimported symbol.

src/Language/PureScript/Sugar/Names/Common.hs+3−1

@@ -43,15 +43,17 @@ warnDuplicateRefs pos toError refs = do

4343 -- referenced type is used in the duplicate check - constructors are handled

4444 -- separately

4545 deleteCtors :: DeclarationRef -> DeclarationRef

46+ deleteCtors (PositionedDeclarationRef ss com ref) =

47+ PositionedDeclarationRef ss com (deleteCtors ref)

4648 deleteCtors (TypeRef pn _) = TypeRef pn Nothing

4749 deleteCtors other = other

4850

4951 -- Extracts the names of duplicate constructor references from TypeRefs.

5052 extractCtors :: SourceSpan -> DeclarationRef -> Maybe [(SourceSpan, Name)]

53+ extractCtors _ (PositionedDeclarationRef pos' _ ref) = extractCtors pos' ref

5154 extractCtors pos' (TypeRef _ (Just dctors)) =

5255 let dupes = dctors \\ nub dctors

5356 in if null dupes then Nothing else Just $ ((pos',) . DctorName) <$> dupes

54− extractCtors _ (PositionedDeclarationRef pos' _ ref) = extractCtors pos' ref

5557 extractCtors _ _ = Nothing

5658

5759 -- Converts a DeclarationRef into a name for an error message.

src/Language/PureScript/Sugar/Names/Env.hs+29−12

@@ -2,7 +2,7 @@ module Language.PureScript.Sugar.Names.Env

22 ( ImportRecord(..)

33 , ImportProvenance(..)

44 , Imports(..)

5− , nullImports

5+ , primImports

66 , Exports(..)

77 , nullExports

88 , Env

@@ -58,6 +58,7 @@ data ImportProvenance

5858 = FromImplicit

5959 | FromExplicit

6060 | Local

61+ | Prim

6162 deriving (Eq, Ord, Show, Read)

6263

6364type ImportMap a = M.Map (Qualified a) [ImportRecord a]

@@ -98,18 +99,33 @@ data Imports = Imports

9899 --

99100 , importedModules :: S.Set ModuleName

100101 -- |

101− -- The names of "virtual" modules that come into existence when "import as"

102− -- is used.

102+ -- The "as" names of modules that have been imported qualified.

103103 --

104− , importedVirtualModules :: S.Set ModuleName

104+ , importedQualModules :: S.Set ModuleName

105105 } deriving (Show, Read)

106106

107−-- |

108−-- An empty 'Imports' value.

109−--

110107nullImports :: Imports

111108nullImports = Imports M.empty M.empty M.empty M.empty M.empty M.empty S.empty S.empty

112109

110+-- |

111+-- An 'Imports' value with imports for the `Prim` module.

112+--

113+primImports :: Imports

114+primImports =

115+ nullImports

116+ { importedTypes = M.fromList $ mkEntries `concatMap` M.keys primTypes

117+ , importedTypeClasses = M.fromList $ mkEntries `concatMap` M.keys primClasses

118+ }

119+ where

120+ mkEntries :: Qualified a -> [(Qualified a, [ImportRecord a])]

121+ mkEntries fullName@(Qualified _ name) =

122+ [ (fullName, [ImportRecord fullName primModuleName Prim])

123+ , (Qualified Nothing name, [ImportRecord fullName primModuleName Prim])

124+ ]

125+

126+primModuleName :: ModuleName

127+primModuleName = ModuleName [ProperName "Prim"]

128+

113129-- |

114130-- The exported declarations from a module.

115131--

@@ -186,7 +202,7 @@ primExports =

186202-- | Environment which only contains the Prim module.

187203primEnv :: Env

188204primEnv = M.singleton

189− (ModuleName [ProperName "Prim"])

205+ primModuleName

190206 (internalModuleSourceSpan "<Prim>", nullImports, primExports)

191207

192208-- |

@@ -203,9 +219,8 @@ exportType

203219exportType exps name dctors mn = do

204220 let exTypes = exportedTypes exps

205221 let exClasses = exportedTypeClasses exps

206− case name `M.lookup` exTypes of

207− Just (_, mn') | mn /= mn' -> throwConflictError ConflictingTypeDecls name

208− _ -> return ()

222+ forM_ (name `M.lookup` exTypes) $ \(_, mn') ->

223+ when (mn /= mn') $ throwConflictError ConflictingTypeDecls name

209224 when (coerceProperName name `M.member` exClasses) $

210225 throwConflictError TypeConflictsWithClass name

211226 forM_ dctors $ \dctor -> do

@@ -213,9 +228,11 @@ exportType exps name dctors mn = do

213228 throwConflictError ConflictingCtorDecls dctor

214229 when (coerceProperName dctor `M.member` exClasses) $

215230 throwConflictError CtorConflictsWithClass dctor

216− return $ exps { exportedTypes = M.insert name (dctors, mn) exTypes }

231+ return $ exps { exportedTypes = M.alter updateOrInsert name exTypes }

217232 where

218233 dctorExists dctor (dctors', mn') = mn /= mn' && elem dctor dctors'

234+ updateOrInsert Nothing = Just (dctors, mn)

235+ updateOrInsert (Just (dctors', _)) = Just (dctors ++ dctors', mn)

219236

220237-- |

221238-- Safely adds a type operator to some exports, returning an error if a

src/Language/PureScript/Sugar/Names/Exports.hs+15−2

@@ -9,8 +9,9 @@ import Control.Monad

99import Control.Monad.Writer.Class (MonadWriter(..))

1010import Control.Monad.Error.Class (MonadError(..))

1111

12+import Data.Function (on)

1213import Data.Foldable (traverse_)

13−import Data.List (intersect)

14+import Data.List (intersect, groupBy, sortBy)

1415import Data.Maybe (fromMaybe, mapMaybe)

1516import qualified Data.Map as M

1617

@@ -224,7 +225,7 @@ filterModule

224225 -> [DeclarationRef]

225226 -> m Exports

226227filterModule mn exps refs = do

227− types <- foldM filterTypes M.empty refs

228+ types <- foldM filterTypes M.empty (combineTypeRefs refs)

228229 typeOps <- foldM (filterExport TyOpName getTypeOpRef exportedTypeOps) M.empty refs

229230 classes <- foldM (filterExport TyClassName getTypeClassRef exportedTypeClasses) M.empty refs

230231 values <- foldM (filterExport IdentName getValueRef exportedValues) M.empty refs

@@ -239,6 +240,18 @@ filterModule mn exps refs = do

239240

240241 where

241242

243+ -- Takes the list of exported refs, filters out any non-TypeRefs, then

244+ -- combines any duplicate type exports to ensure that all constructors

245+ -- listed for the type are covered. Without this, only the data constructor

246+ -- listing for the last ref would be used.

247+ combineTypeRefs :: [DeclarationRef] -> [DeclarationRef]

248+ combineTypeRefs

249+ = fmap (uncurry TypeRef)

250+ . map (foldr1 $ \(tc, dcs1) (_, dcs2) -> (tc, liftM2 (++) dcs1 dcs2))

251+ . groupBy ((==) `on` fst)

252+ . sortBy (compare `on` fst)

253+ . mapMaybe getTypeRef

254+

242255 filterTypes

243256 :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ModuleName)

244257 -> DeclarationRef

src/Language/PureScript/Sugar/Names/Imports.hs+5−4

@@ -53,7 +53,7 @@ resolveImports env (Module ss coms currentModule decls exps) =

5353 imports' = M.map (map (\(ss', dt, mmn) -> (ss', Just dt, mmn))) imports

5454 scope = M.insert currentModule [(Nothing, Nothing, Nothing)] imports'

5555 (Module ss coms currentModule decls exps,) <$>

56− foldM (resolveModuleImport env) nullImports (M.toList scope)

56+ foldM (resolveModuleImport env) primImports (M.toList scope)

5757

5858-- | Constructs a set of imports for a single module import.

5959resolveModuleImport

@@ -74,9 +74,10 @@ resolveModuleImport env ie (mn, imps) = foldM go ie imps

7474 (throwError . errorMessage . UnknownName . Qualified Nothing $ ModName mn)

7575 (return . envModuleExports)

7676 (mn `M.lookup` env)

77− let virtualModules = importedVirtualModules ie'

78− ie'' = ie' { importedModules = S.insert mn (importedModules ie')

79− , importedVirtualModules = maybe virtualModules (`S.insert` virtualModules) impQual

77+ let impModules = importedModules ie'

78+ qualModules = importedQualModules ie'

79+ ie'' = ie' { importedModules = maybe (S.insert mn impModules) (const impModules) impQual

80+ , importedQualModules = maybe qualModules (`S.insert` qualModules) impQual

8081 }

8182 positioned $ resolveImport mn modExports ie'' impQual typ

8283 where

src/Language/PureScript/TypeChecker/Types.hs+8−3

@@ -26,6 +26,7 @@ module Language.PureScript.TypeChecker.Types

2626

2727import Prelude.Compat

2828

29+import Control.Arrow (second)

2930import Control.Monad

3031import Control.Monad.Error.Class (MonadError(..))

3132import Control.Monad.State.Class (MonadState(..), gets)

@@ -118,8 +119,9 @@ typesOf bindingGroupType moduleName vals = do

118119 -- Replace all the wildcards types with their inferred types

119120 replace sub (ErrorMessage hints (WildcardInferredType ty)) =

120121 ErrorMessage hints . WildcardInferredType $ substituteType sub ty

121− replace sub (ErrorMessage hints (HoleInferredType name ty)) =

122− ErrorMessage hints . HoleInferredType name $ substituteType sub ty

122+ replace sub (ErrorMessage hints (HoleInferredType name ty env)) =

123+ ErrorMessage hints $ HoleInferredType name (substituteType sub ty)

124+ (map (second (substituteType sub)) env)

123125 replace _ em = em

124126

125127 isHoleError :: ErrorMessage -> Bool

@@ -324,7 +326,10 @@ infer' (TypedValue checkType val ty) = do

324326 return $ TypedValue True val' ty'

325327infer' (Hole name) = do

326328 ty <- freshType

327− tell . errorMessage $ HoleInferredType name ty

329+ env <- M.toList . names <$> getEnv

330+ Just moduleName <- checkCurrentModule <$> get

331+ let ctx = [ (ident, ty') | ((mn, ident@Ident{}), (ty', _, Defined)) <- env, mn == moduleName ]

332+ tell . errorMessage $ HoleInferredType name ty ctx

328333 return $ TypedValue True (Hole name) ty

329334infer' (PositionedValue pos c val) = warnAndRethrowWithPosition pos $ do

330335 TypedValue t v ty <- infer' val

tests/Language/PureScript/Ide/Integration.hs+17−9

@@ -33,6 +33,7 @@ module Language.PureScript.Ide.Integration

3333 , loadModuleWithDeps

3434 , getCwd

3535 , getFlexCompletions

36+ , getFlexCompletionsInModule

3637 , getType

3738 , rebuildModule

3839 , reset

@@ -49,7 +50,7 @@ import Data.Aeson

4950import Data.Aeson.Types

5051import qualified Data.ByteString.Lazy.UTF8 as BSL

5152import Data.Either (isRight)

52−import Data.Maybe (fromJust, isNothing)

53+import Data.Maybe (fromJust, isNothing, fromMaybe)

5354import qualified Data.Text as T

5455import qualified Data.Vector as V

5556import Language.PureScript.Ide.Util

@@ -95,11 +96,12 @@ compileTestProject :: IO Bool

9596compileTestProject = do

9697 pdir <- projectDirectory

9798 (_, _, _, procHandle) <- createProcess $

98− (shell $ "psc " ++ fileGlob) {cwd=Just pdir

99− ,std_out=CreatePipe

100− ,std_err=CreatePipe

99+ (shell $ "psc " ++ fileGlob) { cwd = Just pdir

100+ , std_out = CreatePipe

101+ , std_err = CreatePipe

101102 }

102− isSuccess <$> waitForProcess procHandle

103+ r <- tryNTimes 5 (getProcessExitCode procHandle)

104+ pure (fromMaybe False (isSuccess <$> r))

103105

104106tryNTimes :: Int -> IO (Maybe a) -> IO (Maybe a)

105107tryNTimes 0 _ = pure Nothing

@@ -166,7 +168,10 @@ loadModule :: String -> IO String

166168loadModule m = sendCommand $ load [m] []

167169

168170getFlexCompletions :: String -> IO [(String, String, String)]

169−getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)))

171+getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) Nothing)

172+

173+getFlexCompletionsInModule :: String -> String -> IO [(String, String, String)]

174+getFlexCompletionsInModule q m = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) (Just m))

170175

171176getType :: String -> IO [(String, String, String)]

172177getType q = parseCompletions <$> sendCommand (typeC q [])

@@ -217,14 +222,17 @@ addImportW importCommand fp outfp =

217222 ])

218223

219224

220−completion :: [Value] -> Maybe Value -> Value

221−completion filters matcher =

225+completion :: [Value] -> Maybe Value -> Maybe String -> Value

226+completion filters matcher currentModule =

222227 let

223228 matcher' = case matcher of

224229 Nothing -> []

225230 Just m -> ["matcher" .= m]

231+ currentModule' = case currentModule of

232+ Nothing -> []

233+ Just cm -> ["currentModule" .= cm]

226234 in

227− commandWrapper "complete" (object $ "filters" .= filters : matcher')

235+ commandWrapper "complete" (object $ "filters" .= filters : matcher' ++ currentModule' )

228236

229237flexMatcher :: String -> Value

230238flexMatcher q = object [ "matcher" .= ("flex" :: String)

tests/Language/PureScript/Ide/RebuildSpec.hs+7−1

@@ -11,7 +11,7 @@ shouldBeFailure :: String -> IO ()

1111shouldBeFailure = shouldBe False . Integration.resultIsSuccess

1212

1313spec :: Spec

14−spec = before_ Integration.reset $ describe "Rebuilding single modules" $ do

14+spec = before_ Integration.reset . describe "Rebuilding single modules" $ do

1515 it "rebuilds a correct module without dependencies successfully" $ do

1616 _ <- Integration.loadModuleWithDeps "RebuildSpecSingleModule"

1717 pdir <- Integration.projectDirectory

@@ -45,3 +45,9 @@ spec = before_ Integration.reset $ describe "Rebuilding single modules" $ do

4545 pdir <- Integration.projectDirectory

4646 let file = pdir </> "src" </> "RebuildSpecWithMissingForeign.fail"

4747 Integration.rebuildModule file >>= shouldBeFailure

48+ it "completes a hidden identifier after rebuilding" $ do

49+ pdir <- Integration.projectDirectory

50+ let file = pdir </> "src" </> "RebuildSpecWithHiddenIdent.purs"

51+ Integration.rebuildModule file >>= shouldBeSuccess

52+ res <- Integration.getFlexCompletionsInModule "hid" "RebuildSpecWithHiddenIdent"

53+ shouldBe False (null res)

tests/Language/PureScript/IdeSpec.hs+1−1

@@ -11,7 +11,7 @@ import Language.PureScript.Ide.Types

1111import Test.Hspec

1212

1313testState :: PscIdeState

14−testState = PscIdeState (Map.fromList [("Data.Array", []), ("Control.Monad.Eff", [])]) Map.empty

14+testState = PscIdeState (Map.fromList [("Data.Array", []), ("Control.Monad.Eff", [])]) Map.empty Nothing

1515

1616defaultConfig :: Configuration

1717defaultConfig =

tests/TestCompiler.hs+65−30

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

2727

2828import Data.Char (isSpace)

2929import Data.Function (on)

30−import Data.List (sort, stripPrefix, intercalate, groupBy, sortBy)

30+import Data.List (sort, stripPrefix, intercalate, groupBy, sortBy, minimumBy)

3131import Data.Maybe (mapMaybe)

3232import Data.Time.Clock (UTCTime())

3333import Data.Tuple (swap)

@@ -58,31 +58,40 @@ main = hspec spec

5858spec :: Spec

5959spec = do

6060

61− (supportExterns, passingTestCases, failingTestCases) <- runIO $ do

61+ (supportExterns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do

6262 cwd <- getCurrentDirectory

6363 let passing = cwd </> "examples" </> "passing"

64+ let warning = cwd </> "examples" </> "warning"

6465 let failing = cwd </> "examples" </> "failing"

6566 let supportDir = cwd </> "tests" </> "support" </> "bower_components"

6667 let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/**/*." ++ ext)) supportDir

6768 passingFiles <- getTestFiles passing <$> testGlob passing

69+ warningFiles <- getTestFiles warning <$> testGlob warning

6870 failingFiles <- getTestFiles failing <$> testGlob failing

6971 supportPurs <- supportFiles "purs"

7072 supportPursFiles <- readInput supportPurs

7173 supportExterns <- runExceptT $ do

7274 modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles

7375 foreigns <- inferForeignModules modules

74− externs <- ExceptT . runTest $ P.make (makeActions foreigns) (map snd modules)

76+ externs <- ExceptT . fmap fst . runTest $ P.make (makeActions foreigns) (map snd modules)

7577 return (zip (map snd modules) externs)

7678 case supportExterns of

7779 Left errs -> fail (P.prettyPrintMultipleErrors False errs)

78− Right externs -> return (externs, passingFiles, failingFiles)

80+ Right externs -> return (externs, passingFiles, warningFiles, failingFiles)

7981

80− context ("Passing examples") $ do

82+ context "Passing examples" $

8183 forM_ passingTestCases $ \testPurs ->

8284 it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $

8385 assertCompiles supportExterns testPurs

8486

85− context ("Failing examples") $ do

87+ context "Warning examples" $

88+ forM_ warningTestCases $ \testPurs -> do

89+ let mainPath = getTestMain testPurs

90+ expectedWarnings <- runIO $ getShouldWarnWith mainPath

91+ it ("'" <> takeFileName mainPath <> "' should compile with warning(s) '" <> intercalate "', '" expectedWarnings <> "'") $

92+ assertCompilesWithWarnings supportExterns testPurs expectedWarnings

93+

94+ context "Failing examples" $

8695 forM_ failingTestCases $ \testPurs -> do

8796 let mainPath = getTestMain testPurs

8897 expectedFailures <- runIO $ getShouldFailWith mainPath

@@ -100,8 +109,7 @@ spec = do

100109 -- .purs files and the .js files for the test case.

101110 getTestFiles :: FilePath -> [FilePath] -> [[FilePath]]

102111 getTestFiles baseDir

103− = map (filter ((== ".purs") . takeExtensions))

104− . map (map (baseDir </>))

112+ = map (filter ((== ".purs") . takeExtensions) . map (baseDir </>))

105113 . groupBy ((==) `on` extractPrefix)

106114 . sortBy (compare `on` extractPrefix)

107115 . map (makeRelative baseDir)

@@ -110,7 +118,7 @@ spec = do

110118 -- by the file with the shortest path name, as everything but the main file

111119 -- will be under a subdirectory.

112120 getTestMain :: [FilePath] -> FilePath

113− getTestMain = head . sortBy (compare `on` length)

121+ getTestMain = minimumBy (compare `on` length)

114122

115123 -- Extracts the filename part of a .purs file, or if the file is in a

116124 -- subdirectory, the first part of that directory path.

@@ -125,9 +133,17 @@ spec = do

125133 -- Scans a file for @shouldFailWith directives in the comments, used to

126134 -- determine expected failures

127135 getShouldFailWith :: FilePath -> IO [String]

128− getShouldFailWith = fmap extractFailWiths . readUTF8File

136+ getShouldFailWith = extractPragma "shouldFailWith"

137+

138+ -- Scans a file for @shouldWarnWith directives in the comments, used to

139+ -- determine expected warnings

140+ getShouldWarnWith :: FilePath -> IO [String]

141+ getShouldWarnWith = extractPragma "shouldWarnWith"

142+

143+ extractPragma :: String -> FilePath -> IO [String]

144+ extractPragma pragma = fmap go . readUTF8File

129145 where

130− extractFailWiths = lines >>> mapMaybe (stripPrefix "-- @shouldFailWith ") >>> map trim

146+ go = lines >>> mapMaybe (stripPrefix ("-- @" ++ pragma ++ " ")) >>> map trim

131147

132148inferForeignModules

133149 :: MonadIO m

@@ -168,16 +184,14 @@ readInput inputFiles = forM inputFiles $ \inputFile -> do

168184 text <- readUTF8File inputFile

169185 return (inputFile, text)

170186

171−type TestM = WriterT [(FilePath, String)] IO

172−

173−runTest :: P.Make a -> IO (Either P.MultipleErrors a)

174−runTest = fmap fst . P.runMake P.defaultOptions

187+runTest :: P.Make a -> IO (Either P.MultipleErrors a, P.MultipleErrors)

188+runTest = P.runMake P.defaultOptions

175189

176190compile

177191 :: [(P.Module, P.ExternsFile)]

178192 -> [FilePath]

179193 -> ([P.Module] -> IO ())

180− -> IO (Either P.MultipleErrors [P.ExternsFile])

194+ -> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)

181195compile supportExterns inputFiles check = silence $ runTest $ do

182196 fs <- liftIO $ readInput inputFiles

183197 ms <- P.parseModulesFromFiles id fs

@@ -192,18 +206,30 @@ assert

192206 :: [(P.Module, P.ExternsFile)]

193207 -> [FilePath]

194208 -> ([P.Module] -> IO ())

195− -> (Either P.MultipleErrors [P.ExternsFile] -> IO (Maybe String))

209+ -> (Either P.MultipleErrors P.MultipleErrors -> IO (Maybe String))

196210 -> Expectation

197211assert supportExterns inputFiles check f = do

198− e <- compile supportExterns inputFiles check

199− maybeErr <- f e

212+ (e, w) <- compile supportExterns inputFiles check

213+ maybeErr <- f (const w <$> e)

200214 maybe (return ()) expectationFailure maybeErr

201215

216+checkMain :: [P.Module] -> IO ()

217+checkMain ms =

218+ unless (any ((== P.moduleNameFromString "Main") . P.getModuleName) ms)

219+ (fail "Main module missing")

220+

221+checkShouldFailWith :: [String] -> P.MultipleErrors -> Maybe String

222+checkShouldFailWith expected errs =

223+ let actual = map P.errorCode $ P.runMultipleErrors errs

224+ in if sort expected == sort actual

225+ then Nothing

226+ else Just $ "Expected these errors: " ++ show expected ++ ", but got these: " ++ show actual

227+

202228assertCompiles

203229 :: [(P.Module, P.ExternsFile)]

204230 -> [FilePath]

205231 -> Expectation

206−assertCompiles supportExterns inputFiles = do

232+assertCompiles supportExterns inputFiles =

207233 assert supportExterns inputFiles checkMain $ \e ->

208234 case e of

209235 Left errs -> return . Just . P.prettyPrintMultipleErrors False $ errs

@@ -219,17 +245,32 @@ assertCompiles supportExterns inputFiles = do

219245 | otherwise -> return $ Just $ "Test did not finish with 'Done':\n\n" <> out

220246 Just (ExitFailure _, _, err) -> return $ Just err

221247 Nothing -> return $ Just "Couldn't find node.js executable"

248+

249+assertCompilesWithWarnings

250+ :: [(P.Module, P.ExternsFile)]

251+ -> [FilePath]

252+ -> [String]

253+ -> Expectation

254+assertCompilesWithWarnings supportExterns inputFiles shouldWarnWith =

255+ assert supportExterns inputFiles checkMain $ \e ->

256+ case e of

257+ Left errs ->

258+ return . Just . P.prettyPrintMultipleErrors False $ errs

259+ Right warnings ->

260+ return

261+ . fmap (printAllWarnings warnings)

262+ $ checkShouldFailWith shouldWarnWith warnings

263+

222264 where

223− checkMain ms =

224− unless (any ((== P.moduleNameFromString "Main") . P.getModuleName) ms)

225− (fail "Main module missing")

265+ printAllWarnings warnings =

266+ (<> "\n\n" <> P.prettyPrintMultipleErrors False warnings)

226267

227268assertDoesNotCompile

228269 :: [(P.Module, P.ExternsFile)]

229270 -> [FilePath]

230271 -> [String]

231272 -> Expectation

232−assertDoesNotCompile supportExterns inputFiles shouldFailWith = do

273+assertDoesNotCompile supportExterns inputFiles shouldFailWith =

233274 assert supportExterns inputFiles noPreCheck $ \e ->

234275 case e of

235276 Left errs ->

@@ -243,9 +284,3 @@ assertDoesNotCompile supportExterns inputFiles shouldFailWith = do

243284

244285 where

245286 noPreCheck = const (return ())

246−

247− checkShouldFailWith expected errs =

248− let actual = map P.errorCode $ P.runMultipleErrors errs

249− in if sort expected == sort actual

250− then Nothing

251− else Just $ "Expected these errors: " ++ show expected ++ ", but got these: " ++ show actual

tests/support/bower.json+1−1

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

77 "purescript-functions": "1.0.0-rc.1",

88 "purescript-prelude": "1.0.0-rc.3",

99 "purescript-st": "1.0.0-rc.1",

10− "purescript-partial": "1.1.1"

10+ "purescript-partial": "1.1.2"

1111 }

1212}

tests/support/pscide/src/RebuildSpecWithHiddenIdent.pursnew file+6

@@ -0,0 +1,6 @@

1+module RebuildSpecWithHiddenIdent (exported) where

2+

3+hidden x _ = x

4+

5+exported :: forall a. a -> a

6+exported x = x