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

on golang help sign in

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

compare with golang

unifiedsplit

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

2

2

3import Prelude

3import Prelude

4

4

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

5+import Control.Monad.Eff (Eff)

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

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

7import Data.Generic

7import Data.Generic

8

8

9data Void

9data Void

10

10

11derive instance genericVoid :: Generic Void

11derive instance genericVoid :: Generic Void

12

12

13−data A a

13+data A a

14 = A Number String

14 = A Number String

15 | B Int

15 | B Int

16− | C (Array (A a))

16+ | C (Array (A a))

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

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

18 | E Void

18 | E Void

19

19

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

24derive instance genericX :: Generic (X String)

24derive instance genericX :: Generic (X String)

25

25

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

26main :: 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 @@

2module Main where

2module Main where

3

3

4import M1

4import M1

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

5

6

6testX = X

7testX = X

7

8

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

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

9testY = Y

10testY = Y

10

11

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

12+main = log "Done"

examples/failing/ExportExplicit3.purs+4−3

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

1-- @shouldFailWith UnknownName

1-- @shouldFailWith UnknownName

2module Main where

2module Main where

3

3

4−import M1

4+import M1 as M

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

5

6

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

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

7−testZ = M1.Z

8+testZ = M.Z

8

9

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

10+main = log "Done"

examples/failing/RowConstructors1.purs+2−2

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

1-- @shouldFailWith KindsDoNotUnify

1-- @shouldFailWith KindsDoNotUnify

2module Main where

2module Main where

3

3

4−import Prelude

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

5

5

6data Foo = Bar

6data Foo = Bar

7type Baz = { | Foo }

7type Baz = { | Foo }

8

8

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

9+main = log "Done"

examples/failing/RowConstructors2.purs+2−2

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

1-- @shouldFailWith KindsDoNotUnify

1-- @shouldFailWith KindsDoNotUnify

2module Main where

2module Main where

3

3

4−import Prelude

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

5

5

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

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

7type Bar = { | Foo }

7type Bar = { | Foo }

8

8

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

9+main = log "Done"

examples/failing/RowConstructors3.purs+2−2

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

1-- @shouldFailWith KindsDoNotUnify

1-- @shouldFailWith KindsDoNotUnify

2module Main where

2module Main where

3

3

4−import Prelude

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

5

5

6type Foo = { x :: Number }

6type Foo = { x :: Number }

7type Bar = { | Foo }

7type Bar = { | Foo }

8

8

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

2module Main where

2module Main where

3

3

4−import Prelude

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

5

5

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

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

7

7

8main = do

8main = do

9 let t1 = test

9 let t1 = test

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

10+ log "Done"

examples/failing/TypedBinders2.purs+3−3

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

2module Main where

2module Main where

3

3

4import Prelude

4import Prelude

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

5

6

6main = do

7main = do

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

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

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

9+ log "Done"

9−

examples/failing/TypedBinders3.purs+2−1

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

2module Main where

2module Main where

3

3

4import Prelude

4import Prelude

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

5

6

6test = case 1 of

7test = case 1 of

7 (0 :: String) -> true

8 (0 :: String) -> true

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

9

10

10main = do

11main = do

11 let t = test

12 let t = test

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

13+ log "Done"

examples/failing/UnderscoreModuleName.purs+2−2

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

1-- @shouldFailWith ErrorParsingModule

1-- @shouldFailWith ErrorParsingModule

2module Bad_Module where

2module Bad_Module where

3

3

4−import Prelude

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

5

5

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

6+main = log "Done"

examples/passing/1185.purs+3−1

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

1module Main where

1module Main where

2

2

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

4+

3data Person = Person String Boolean

5data Person = Person String Boolean

4

6

5getName :: Person -> String

7getName :: Person -> String

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

10name :: String

12name :: String

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

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

12

14

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

15+main = log "Done"

examples/passing/1570.purs+3−1

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

1module Main where

1module Main where

2

2

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

4+

3test :: forall a. a -> a

5test :: forall a. a -> a

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

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

5

7

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

8+main = log "Done"

examples/passing/1697.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5_2 :: forall a. a -> a

6_2 :: forall a. a -> a

6_2 a = a

7_2 a = a

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

21 let tmp = _2 1

22 let tmp = _2 1

22 pure unit

23 pure unit

23

24

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

25+main = log "Done"

examples/passing/1881.purs+5−3

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

1module Main where

1module Main where

2

2

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

4+

3−foo =

5+foo =

4 1

6 1

5

7

6−bar

8+bar

7 = 2

9 = 2

8

10

9baz

11baz

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

14 =

16 =

15 3

17 3

16

18

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

19+main = log "Done"

examples/passing/1991.purs+3−2

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

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

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

6singleton x = [x]

7singleton x = [x]

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

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

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

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

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

19 in as'

20 in as'

20−

21+

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

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 @@

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5class Foo a b

6class Foo a b

6

7

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

14

15

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

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

16

17

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

18+main = log "Done"

examples/passing/810.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data Maybe a = Nothing | Just a

6data Maybe a = Nothing | Just a

6

7

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

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

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

11 Just a -> { x : Just a }

12 Just a -> { x : Just a }

12

13

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

14+main = log "Done"

examples/passing/Applicative.purs+2−2

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

1module Main where

1module Main where

2

2

3−import Prelude ()

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

4

4

5class Applicative f where

5class Applicative f where

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

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

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

13 apply (Just f) (Just a) = Just (f a)

13 apply (Just f) (Just a) = Just (f a)

14 apply _ _ = Nothing

14 apply _ _ = Nothing

15

15

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

16+main = log "Done"

examples/passing/ArrayType.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5class Pointed p where

6class Pointed p where

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

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

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

8instance pointedArray :: Pointed Array where

9instance pointedArray :: Pointed Array where

9 point a = [a]

10 point a = [a]

10

11

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

12+main = log "Done"

examples/passing/Auto.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

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

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

6

7

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

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

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

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

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

14

15

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

16+main = log "Done"

examples/passing/BindersInFunctions.purs+2−1

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

4import Partial.Unsafe (unsafePartial)

4import Partial.Unsafe (unsafePartial)

5import Test.Assert (assert')

5import Test.Assert (assert')

6import Control.Monad.Eff (Eff)

6import Control.Monad.Eff (Eff)

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

7

8

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

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

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

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

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

12main = do

13main = do

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

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

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

15 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 @@

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5foo = bar

6foo = bar

6 where bar r = r + 1.0

7 where bar r = r + 1.0

7

8

8r = foo 2.0

9r = foo 2.0

9

10

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

11+main = log "Done"

examples/passing/BlockString.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5foo :: String

6foo :: String

6foo = """foo"""

7foo = """foo"""

7

8

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

9+main = log "Done"

examples/passing/CaseStatement.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data A = A | B | C

6data A = A | B | C

6

7

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

18h f a N = a

19h f a N = a

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

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

20

21

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 @@

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

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

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

6

7

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

8+main = log "Done"

examples/passing/CheckSynonymBug.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

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

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

6length _ = 0

7length _ = 0

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

9

10

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

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

11

12

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

13+main = log "Done"

examples/passing/CheckTypeClass.purs+2−2

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data Bar a = Bar

6data Bar a = Bar

6data Baz

7data Baz

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

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

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

15mkBar _ = Bar

16mkBar _ = Bar

16

17

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

18+main = log "Done"

18−

examples/passing/Church.purs+2−2

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

1module Main where

1module Main where

2

2

3−import Prelude ()

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

4

4

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

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

6

6

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

15

15

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

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

17

17

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

18+main = log "Done"

examples/passing/ClassRefSyntax.purs+5−4

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

1module Main where

1module Main where

2

2

3− import Lib (class X, go)

3+import Lib (class X, go)

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

4

5

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

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

6− go' = go

7+go' = go

7

8

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

9+main = log "Done"

examples/passing/Conditional.purs+2−2

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

1module Main where

1module Main where

2

2

3−import Prelude ()

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

4

4

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

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

6

6

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

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

8

8

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

9+main = log "Done"

examples/passing/DataAndType.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data A = A B

6data A = A B

6

7

7type B = A

8type B = A

8

9

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

2

2

3import Prelude

3import Prelude

4import Control.Monad.Eff

4import Control.Monad.Eff

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

5import Test.Assert

6import Test.Assert

6

7

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

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

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

13main = do

14main = do

14 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)))))))))

15 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)))))))))

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

16 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 @@

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data Maybe a = Nothing | Just a

6data Maybe a = Nothing | Just a

6

7

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

19 bind Nothing _ = Nothing

20 bind Nothing _ = Nothing

20 bind (Just a) f = f a

21 bind (Just a) f = f a

21

22

22−instance monadMaybe :: Prelude.Monad Maybe

23+instance monadMaybe :: Monad Maybe

23

24

24test1 = \_ -> do

25test1 = \_ -> do

25 Just "abc"

26 Just "abc"

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

64 g x = f x / 2.0

65 g x = f x / 2.0

65 Just (f 10.0)

66 Just (f 10.0)

66

67

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

68+main = log "Done"

examples/passing/Dollar.purs+2−2

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

1module Main where

1module Main where

2

2

3−import Prelude ()

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

4

4

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

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

6applyFn f x = f x

6applyFn f x = f x

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

13

13

14test2 x = id id $ id x

14test2 x = id id $ id x

15

15

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

2

2

3import Prelude

3import Prelude

4import Test.Assert

4import Test.Assert

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

5

6

6data Z

7data Z

7data S n

8data S n

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

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

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

16

17

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

18main = 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"

19 _ -> assert' "Failed" false

20 _ -> assert' "Failed" false

examples/passing/EmptyRow.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data Foo r = Foo { | r }

6data Foo r = Foo { | r }

6

7

7test :: Foo ()

8test :: Foo ()

8test = Foo {}

9test = Foo {}

9

10

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

11+main = log "Done"

examples/passing/ExplicitOperatorSections.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5subtractOne :: Int -> Int

6subtractOne :: Int -> Int

6subtractOne = (_ - 1)

7subtractOne = (_ - 1)

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

11named :: Int -> Int

12named :: Int -> Int

12named = (_ `sub` 1)

13named = (_ `sub` 1)

13

14

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

15+main = log "Done"

examples/passing/ExportExplicit.purs+2−1

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

1module Main where

1module Main where

2

2

3import M1

3import M1

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

4

5

5testX = X

6testX = X

6testZ = Z

7testZ = Z

7testFoo = foo

8testFoo = foo

8

9

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

10+main = log "Done"

examples/passing/ExportExplicit2.purs+2−1

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

1module Main where

1module Main where

2

2

3import M1

3import M1

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

4

5

5testBar = bar

6testBar = bar

6

7

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

2

2

3import Prelude

3import Prelude

4import Test.Assert

4import Test.Assert

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

5

6

6mkValue :: Number -> Number

7mkValue :: Number -> Number

7mkValue id = id

8mkValue id = id

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

9main = do

10main = do

10 let value = mkValue 1.0

11 let value = mkValue 1.0

11 assert $ value == 1.0

12 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

2

2

3import Prelude

3import Prelude

4import Test.Assert

4import Test.Assert

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

5

6

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

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

7test = \const _ -> const

8test = \const _ -> const

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

9main = do

10main = do

10 let value = test "Done" {}

11 let value = test "Done" {}

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

12 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 @@

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5collatz = \x -> case x of

6collatz = \x -> case x of

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

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

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

26 | otherwise

27 | otherwise

27 = y - x

28 = y - x

28

29

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 @@

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data Maybe a = Nothing | Just a

6data Maybe a = Nothing | Just a

6

7

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

8

9

9test2 = if true then Nothing else Just 10

10test2 = if true then Nothing else Just 10

10

11

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

12+main = log "Done"

examples/passing/ImplicitEmptyImport.purs+4−3

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5main = do

6main = do

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

7+ log "Hello"

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

8+ log "Goodbye"

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

9+ log "Done"

examples/passing/Import.purs+2−1

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

1module Main where

1module Main where

2

2

3import M2

3import M2

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

4

5

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

6+main = log "Done"

examples/passing/ImportExplicit.purs+2−1

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

1module Main where

1module Main where

2

2

3import M1 (X(..))

3import M1 (X(..))

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

4

5

5testX :: X

6testX :: X

6testX = X

7testX = X

7testY = Y

8testY = Y

8

9

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

10+main = log "Done"

examples/passing/InstanceBeforeClass.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5instance fooNumber :: Foo Number where

6instance fooNumber :: Foo Number where

6 foo = 0.0

7 foo = 0.0

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

8class Foo a where

9class Foo a where

9 foo :: a

10 foo :: a

10

11

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

2

2

3import Prelude

3import Prelude

4import Control.Monad.Eff

4import Control.Monad.Eff

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

5import Test.Assert

6import Test.Assert

6

7

7f 1 = 1

8f 1 = 1

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

15 assert $ f 0 == 0

16 assert $ f 0 == 0

16 assert $ g 'a' == 'a'

17 assert $ g 'a' == 'a'

17 assert $ g 'b' == 'b'

18 assert $ g 'b' == 'b'

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

19+ log "Done"

examples/passing/JSReserved.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5yield = 0

6yield = 0

6member = 1

7member = 1

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

9

10

10this catch = catch

11this catch = catch

11

12

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

13+main = log "Done"

examples/passing/KindedType.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

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

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

6

7

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

30instance clazzString :: Clazz String where

31instance clazzString :: Clazz String where

31 def = "test"

32 def = "test"

32

33

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

34+main = log "Done"

examples/passing/LargeSumType.purs+4−2

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

1module Main where

1module Main where

2−

2+

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

4+

3data 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

5data 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

4

6

5explode A A = "A"

7explode A A = "A"

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

30explode Z Z = "Z"

32explode Z Z = "Z"

31explode _ _ = ""

33explode _ _ = ""

32

34

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

35+main = log "Done"

examples/passing/LetInInstance.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5class Foo a where

6class Foo a where

6 foo :: a -> String

7 foo :: a -> String

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

11 go :: String -> String

12 go :: String -> String

12 go s = s

13 go s = s

13

14

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

15+main = log "Done"

examples/passing/LiberalTypeSynonyms.purs+3−2

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5type Reader = (->) String

6type Reader = (->) String

6

7

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

16

17

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

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

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

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

19− { x = x } -> x

20+ { x: x } -> x

20

21

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

22+main = log "Done"

examples/passing/MPTCs.purs+3−2

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5class NullaryTypeClass where

6class NullaryTypeClass where

6 greeting :: String

7 greeting :: String

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

14instance coerceRefl :: Coerce a a where

15instance coerceRefl :: Coerce a a where

15 coerce a = a

16 coerce a = a

16

17

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

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

18 coerce = show

19 coerce = show

19

20

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

21+main = log "Done"

examples/passing/Match.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data Foo a = Foo

6data Foo a = Foo

6

7

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

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

8

9

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

2

2

3import M1

3import M1

4import M2

4import M2

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

5

6

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

4

4

5data Foo = Foo String

5data Foo = Foo String

6

6

7−foo :: M1.Foo -> String

7+foo :: Foo -> String

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

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

9

9

10bar :: Foo -> String

10bar :: Foo -> String

examples/passing/Module/M2.purs+1

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

1module M2 where

1module M2 where

2

2

3import Prelude

3import Prelude

4+import M1 as M1

4

5

5baz :: M1.Foo -> String

6baz :: M1.Foo -> String

6baz = M1.foo

7baz = M1.foo

examples/passing/ModuleDeps.purs+2−1

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

1module Main where

1module Main where

2

2

3import M1

3import M1

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

4

5

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

6+main = log "Done"

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

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

1module M1 where

1module M1 where

2

2

3−import M2

3+import M2 as M2

4

4

5foo = M2.bar

5foo = M2.bar

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

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

1module M2 where

1module M2 where

2

2

3−import M3

3+import M3 as M3

4

4

5bar = M3.baz

5bar = M3.baz

examples/passing/Monad.purs+2−2

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

1module Main where

1module Main where

2

2

3−import Prelude ()

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

4

4

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

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

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

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

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

29

29

30test2 = test maybe

30test2 = test maybe

31

31

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

32+main = log "Done"

examples/passing/MutRec.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5f 0.0 = 0.0

6f 0.0 = 0.0

6f x = g x + 0.0

7f x = g x + 0.0

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

16

17

17oddToNumber (Odd n) = evenToNumber n + 0.0

18oddToNumber (Odd n) = evenToNumber n + 0.0

18

19

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

20+main = log "Done"

examples/passing/MutRec2.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data A = A B

6data A = A B

6

7

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

16showN :: A -> S

17showN :: A -> S

17showN a = f a

18showN a = f a

18

19

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

20+main = log "Done"

examples/passing/MutRec3.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data A = A B

6data A = A B

6

7

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

16showN :: A -> S

17showN :: A -> S

17showN a = f a

18showN a = f a

18

19

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

20+main = log "Done"

examples/passing/NamedPatterns.purs+3−2

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5foo = \x -> case x of

6foo = \x -> case x of

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

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

7 y -> y

8 y -> y

8

9

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

10+main = log "Done"

examples/passing/NegativeBinder.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5test :: Number -> Boolean

6test :: Number -> Boolean

6test -1.0 = false

7test -1.0 = false

7test _ = true

8test _ = true

8

9

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

10+main = log "Done"

examples/passing/NegativeIntInRange.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5n :: Int

6n :: Int

6n = -2147483648

7n = -2147483648

7

8

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

9+main = log "Done"

examples/passing/Nested.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

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

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

6

7

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

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

8

9

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

10+main = log "Done"

examples/passing/NestedWhere.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5f x = g x

6f x = g x

6 where

7 where

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

9 go x = go1 (x - 1.0)

10 go x = go1 (x - 1.0)

10 go1 x = go x

11 go1 x = go x

11

12

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

13+main = log "Done"

examples/passing/NonConflictingExports.purs+5−4

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

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

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

2module Main (thing, main) where

2module Main (thing, main) where

3

3

4− import A

4+import A

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

5

6

6− thing :: Int

7+thing :: Int

7− thing = 2

8+thing = 2

8

9

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

10+main = log "Done"

examples/passing/ObjectSynonym.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5type Inner = Number

6type Inner = Number

6

7

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

12outer :: Outer

13outer :: Outer

13outer = { inner: inner }

14outer = { inner: inner }

14

15

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 }

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

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

10

10

11replace = \o -> case o of

11replace = \o -> case o of

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

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

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

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

14 o -> o

14 o -> o

15

15

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

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

examples/passing/ObjectUpdate2.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5type X r = { | r }

6type X r = { | r }

6

7

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

14 { baz = "blah"

15 { baz = "blah"

15 }

16 }

16

17

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

18+main = log "Done"

examples/passing/Objects.purs+3−2

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

1module Main where

1module Main where

2

2

3import Prelude hiding (append)

3import Prelude hiding (append)

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

4

5

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

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

6

7

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

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

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

26

27

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

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

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

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

29

30

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

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

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

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

32

33

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

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

34

35

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

36+main = log "Done"

examples/passing/OneConstructor.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data One a = One a

6data One a = One a

6

7

7one' (One a) = a

8one' (One a) = a

8

9

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

10+main = log "Done"

examples/passing/Operators.purs+4−8

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

4+import Other (foo)

5+import Other as Other

4import Control.Monad.Eff

6import Control.Monad.Eff

5import Control.Monad.Eff.Console

7import Control.Monad.Eff.Console

6

8

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

9

11

10infix 4 op1 as ?!

12infix 4 op1 as ?!

11

13

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

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

14−

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

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

16test1 x y z = x * y + z x y

15test1 x y z = x * y + z x y

17

16

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

44

43

45infix 4 op4 as @@

44infix 4 op4 as @@

46

45

47−foo :: String -> String

48−foo = \s -> s

49−

50test8 = foo @@ "Hello World"

46test8 = foo @@ "Hello World"

51

47

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

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

53

49

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

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

55

51

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

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

57op5 = \as -> \bs -> as

53op5 = \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 @@

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5x a = 1.0 + y a

6x a = 1.0 + y a

6

7

7y a = x a

8y a = x a

8

9

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

10+main = log "Done"

examples/passing/Patterns.purs+5−4

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5test = \x -> case x of

6test = \x -> case x of

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

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

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

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

8 _ -> false

9 _ -> false

9

10

10f = \o -> case o of

11f = \o -> case o of

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

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

12 _ -> 0

13 _ -> 0

13

14

14h = \o -> case o of

15h = \o -> case o of

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

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

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

20isDesc _ = false

21isDesc _ = false

21

22

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

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

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

4import A

4import A

5import B

5import B

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

6

7

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

8+main = log "Done"

examples/passing/PendingConflictingImports2.purs+6−5

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

1module Main where

1module Main where

2

2

3− import A

3+import A

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

4

5

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

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

6− thing :: Int

7+thing :: Int

7− thing = 2

8+thing = 2

8

9

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

10+main = log "Done"

examples/passing/QualifiedNames.purs+3−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

4+import Either as Either

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

4

6

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

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

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

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

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

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

8

10

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

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

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

7

7

8foo :: Foo -> Number

8foo :: Foo -> Number

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

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

10

10

11main = log "Done"

11main = log "Done"

examples/passing/Rank2Types.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

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

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

6test1 = \f -> f 0.0

7test1 = \f -> f 0.0

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

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

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

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

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

10

11

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

2

2

3import Prelude

3import Prelude

4import C

4import C

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

5

6

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

7+main = log (x <> y)

examples/passing/Recursion.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5fib = \n -> case n of

6fib = \n -> case n of

6 0.0 -> 1.0

7 0.0 -> 1.0

7 1.0 -> 1.0

8 1.0 -> 1.0

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

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

9

10

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

11+main = log "Done"

examples/passing/RedefinedFixity.purs+2−1

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

1module Main where

1module Main where

2

2

3import M3

3import M3

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

4

5

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

3

3

4import Prelude

4import Prelude

5import Control.Monad.Eff

5import Control.Monad.Eff

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

6

7

7o :: { type :: String }

8o :: { type :: String }

8o = { type: "o" }

9o = { type: "o" }

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

11p = o { type = "p" }

12p = o { type = "p" }

12

13

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

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

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

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

15f _ = "Fail"

16f _ = "Fail"

16

17

17main :: Eff _ _

18main :: 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

2

2

3import A (thing)

3import A (thing)

4import B

4import B

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

5

6

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

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

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

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

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

9what true = thing

10what true = thing

10what false = zing

11what false = zing

11

12

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

13+main = log "Done"

examples/passing/ResolvableScopeConflict2.purs+2−1

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

1module Main where

1module Main where

2

2

3import A

3import A

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

4

5

5thing :: Int

6thing :: Int

6thing = 1

7thing = 1

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

11what true = thing

12what true = thing

12what false = zing

13what false = zing

13

14

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

15+main = log "Done"

examples/passing/ResolvableScopeConflict3.purs+2−1

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

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

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

2

2

3import A

3import A

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

4

5

5thing :: Int

6thing :: Int

6thing = 2

7thing = 2

7

8

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

9+main = log "Done"

examples/passing/RowConstructors.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

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

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

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

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

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

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

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

40wildcard' { q: q } = q

41wildcard' { q: q } = q

41

42

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

43+main = log "Done"

examples/passing/RowPolyInstanceContext.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5class T s m where

6class T s m where

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

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

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

19main = do

20main = do

20 let t1 = test1

21 let t1 = test1

21 let t2 = test2

22 let t2 = test2

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

23+ log "Done"

examples/passing/ScopedTypeVariables.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

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

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

6test1 f x = g (g x)

7test1 f x = g (g x)

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

33 j x = x

34 j x = x

34

35

35

36

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

2

2

3import Prelude

3import Prelude

4import Control.Monad.Eff

4import Control.Monad.Eff

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

5

6

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

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

7

8

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

12 sequence Nil = pure Nil

13 sequence Nil = pure Nil

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

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

14

15

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

2

2

3import Prelude

3import Prelude

4import Control.Monad.Eff

4import Control.Monad.Eff

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

5

6

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

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

7

8

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

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

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

32

33

33main = do

34main = do

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

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

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

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

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

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

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

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

examples/passing/ShadowedName.purs+2−1

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

2

2

3import Prelude

3import Prelude

4import Control.Monad.Eff.Console

4import Control.Monad.Eff.Console

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

5

6

6done :: String

7done :: String

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

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

8 let str = "Done" in str

9 let str = "Done" in str

9

10

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

11+main = log done

examples/passing/SignedNumericLiterals.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5p = 0.5

6p = 0.5

6q = 1.0

7q = 1.0

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

14

15

15test1 = 2.0 - 1.0

16test1 = 2.0 - 1.0

16

17

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

18+main = log "Done"

examples/passing/TCOCase.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data Data = One | More Data

6data Data = One | More Data

6

7

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

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

8 where

9 where

9 to 0.0 a = a

10 to 0.0 a = a

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

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

examples/passing/Tick.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5test' x = x

6test' x = x

6

7

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

8+main = log "Done"

examples/passing/TopLevelCase.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5gcd :: Number -> Number -> Number

6gcd :: Number -> Number -> Number

6gcd 0.0 x = x

7gcd 0.0 x = x

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

15

16

16parseTest A 0.0 = 0.0

17parseTest A 0.0 = 0.0

17

18

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

19+main = log "Done"

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

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

1module Middle where

1module Middle where

2

2

3+import Test (test)

4+

3−middle = Test.test

5+middle = test

examples/passing/TypeClasses.purs+3−3

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

5

5

6test1 = \_ -> show "testing"

6test1 = \_ -> show "testing"

7

7

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

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

9f x = show x

9f x = show x

10

10

11test2 = \_ -> f "testing"

11test2 = \_ -> f "testing"

12

12

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

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

14test7 = show

14test7 = show

15

15

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

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

17

17

18data Data a = Data a

18data Data a = Data a

19

19

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

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

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

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

22

22

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

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

examples/passing/TypeClassesInOrder.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5class Foo a where

6class Foo a where

6 foo :: a -> String

7 foo :: a -> String

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

8instance fooString :: Foo String where

9instance fooString :: Foo String where

9 foo s = s

10 foo s = s

10

11

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

12+main = log $ foo "Done"

examples/passing/TypeClassesWithOverlappingTypeVariables.purs+3−2

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data Either a b = Left a | Right b

6data Either a b = Left a | Right b

6

7

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

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

8 map _ (Left x) = Left x

9 map _ (Left x) = Left x

9 map f (Right y) = Right (f y)

10 map f (Right y) = Right (f y)

10

11

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

12+main = log "Done"

examples/passing/TypeDecl.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5k :: String -> Number -> String

6k :: String -> Number -> String

6k x y = x

7k x y = x

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

9iterate 0.0 f a = a

10iterate 0.0 f a = a

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

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

11

12

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

13+main = log "Done"

examples/passing/TypeOperators.purs+2−1

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

1module Main where

1module Main where

2

2

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

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

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

4

5

5natty ∷ ∀ f. f ~> f

6natty ∷ ∀ f. f ~> f

6natty x = x

7natty x = x

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

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

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

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

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

18

19

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

20+main = log "Done"

examples/passing/TypeSynonymInData.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5type A a = Array a

6type A a = Array a

6

7

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

8

9

9foo (Foo []) = Bar

10foo (Foo []) = Bar

10

11

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

12+main = log "Done"

examples/passing/TypeSynonyms.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5type Lens a b =

6type Lens a b =

6 { get :: a -> b

7 { get :: a -> b

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

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

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

25test1 = composeLenses fst fst

26test1 = composeLenses fst fst

26

27

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

28+main = log "Done"

examples/passing/TypeWildcards.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5testTopLevel :: _ -> _

6testTopLevel :: _ -> _

6testTopLevel n = n + 1.0

7testTopLevel n = n + 1.0

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

12 go a1 a2 | a1 == a2 = a1

13 go a1 a2 | a1 == a2 = a1

13 go a1 _ = go (f a1) a1

14 go a1 _ = go (f a1) a1

14

15

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

16+main = log "Done"

examples/passing/TypeWildcardsRecordExtension.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

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

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

6foo f = f

7foo f = f

7

8

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

9+main = log "Done"

examples/passing/TypeWithoutParens.purs+2−1

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

1module Main where

1module Main where

2

2

3import Lib (X, Y)

3import Lib (X, Y)

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

4

5

5idX :: X -> X

6idX :: X -> X

6idX x = x

7idX x = x

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

8idY :: Y -> Y

9idY :: Y -> Y

9idY y = y

10idY y = y

10

11

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

12+main = log "Done"

examples/passing/TypedBinders.purs+3−2

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data Tuple a b = Tuple a b

6data Tuple a b = Tuple a b

6

7

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

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

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

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

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

33

34

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 {}

35modify f = do

36modify f = do

36 s <- get

37 s <- get

37 put (f s)

38 put (f s)

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

64 t2 = test2 id

65 t2 = test2 id

65 t3 = test3 1

66 t3 = test3 1

66 t4 = test4 (Tuple 1 0)

67 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 @@

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data E a b = L a | R b

6data E a b = L a | R b

6

7

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

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

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

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

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

16

17

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

18+main = log "Done"

examples/passing/UnderscoreIdent.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5data Data_type = Con_Structor | Con_2 String

6data Data_type = Con_Structor | Con_2 String

6

7

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

9done (Con_2 s) = s

10done (Con_2 s) = s

10done _ = "Failed"

11done _ = "Failed"

11

12

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 @@

1module Main where

1module Main where

2

2

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

4+

3f asgård = asgård

5f asgård = asgård

4

6

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

7+main = log (f "Done")

examples/passing/UnicodeOperators.purs+3−1

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

1module Main where

1module Main where

2

2

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

4+

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

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

4compose f g a = f (g a)

6compose f g a = f (g a)

5

7

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

17

19

18test2 = 1 ∈ emptySet

20test2 = 1 ∈ emptySet

19

21

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

22+main = log "Done"

examples/passing/UnknownInTypeClassLookup.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

5class EQ a b

6class EQ a b

6

7

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

11

12

12runTest a = test a a

13runTest a = test a a

13

14

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 @@

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

4−import Control.Monad.Eff.Console

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

5

5

6class Show a <= Nonsense a where

6class Show a <= Nonsense a where

7 method :: a -> a

7 method :: a -> a

examples/passing/WildcardType.purs+2−3

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

4−import Control.Monad.Eff.Console

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

5

5

6f1 :: (_ -> _) -> _

6f1 :: (_ -> _) -> _

7f1 g = g 1

7f1 g = g 1

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

9f2 :: _ -> _

9f2 :: _ -> _

10f2 _ = "Done"

10f2 _ = "Done"

11

11

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

12+main = log $ f1 f2

13−

examples/passing/iota.purs+3−1

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

1module Main where

1module Main where

2

2

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

4+

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

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

4

6

5k = \x -> \y -> x

7k = \x -> \y -> x

6

8

7iota = \x -> x s k

9iota = \x -> x s k

8

10

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

11+main = log "Done"

examples/passing/s.purs+2−1

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

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

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

4

5

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

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

6

7

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.

38

38

39**Params:**

39**Params:**

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

40 - `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

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

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

43 of them to be eligible.

43 of them to be eligible.

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

44```json

45```json

45{

46{

46 "command": "type",

47 "command": "type",

47 "params": {

48 "params": {

48 "search": "filterM",

49 "search": "filterM",

49− "filters": [Filter]

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

51+ "currentModule": "Main"

50 }

52 }

51}

53}

52```

54```

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

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

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

59

61

60**Params**:

62**Params**:

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

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

62− all filters.

64+ match all filters.

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

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

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

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

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

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

66−

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+

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

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

68− particular order.

73+ in no particular order.

74+

69```json

75```json

70{

76{

71 "command": "complete",

77 "command": "complete",

72 "params": {

78 "params": {

73− "filters": [Filter],

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

74− "matcher": (optional) Matcher

80+ "matcher": {..}

81+ "currentModule": "Main"

75 }

82 }

76}

83}

77```

84```

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

244

251

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

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

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

253recompile 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.

248

256

249Arguments:

257Arguments:

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

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

251

259

252```json

260```json

253{

261{

purescript.cabal+4

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

21

21

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

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

23 , examples/passing/2018/*.purs

23 , examples/passing/2018/*.purs

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

24 , examples/passing/ClassRefSyntax/*.purs

25 , examples/passing/ClassRefSyntax/*.purs

25 , examples/passing/DctorOperatorAlias/*.purs

26 , examples/passing/DctorOperatorAlias/*.purs

26 , examples/passing/ExplicitImportReExport/*.purs

27 , examples/passing/ExplicitImportReExport/*.purs

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

38 , examples/passing/ModuleExportSelf/*.purs

39 , examples/passing/ModuleExportSelf/*.purs

39 , examples/passing/NonConflictingExports/*.purs

40 , examples/passing/NonConflictingExports/*.purs

40 , examples/passing/OperatorAliasElsewhere/*.purs

41 , examples/passing/OperatorAliasElsewhere/*.purs

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

41 , examples/passing/PendingConflictingImports/*.purs

43 , examples/passing/PendingConflictingImports/*.purs

42 , examples/passing/PendingConflictingImports2/*.purs

44 , examples/passing/PendingConflictingImports2/*.purs

43 , examples/passing/QualifiedNames/*.purs

45 , examples/passing/QualifiedNames/*.purs

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

66 , examples/failing/InstanceExport/*.purs

68 , examples/failing/InstanceExport/*.purs

67 , examples/failing/OrphanInstance/*.purs

69 , examples/failing/OrphanInstance/*.purs

68 , examples/failing/OverlappingReExport/*.purs

70 , examples/failing/OverlappingReExport/*.purs

71+ , examples/warning/*.purs

72+ , examples/warning/*.js

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

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

70 , examples/docs/bower.json

74 , examples/docs/bower.json

71 , examples/docs/src/*.purs

75 , examples/docs/src/*.purs

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

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

24import Language.PureScript.Kinds

24import Language.PureScript.Kinds

25import Language.PureScript.Names

25import Language.PureScript.Names

26import Language.PureScript.Pretty

26import Language.PureScript.Pretty

27+import Language.PureScript.Traversals

27import Language.PureScript.Types

28import Language.PureScript.Types

28import qualified Language.PureScript.Bundle as Bundle

29import qualified Language.PureScript.Bundle as Bundle

29import qualified Language.PureScript.Constants as C

30import qualified Language.PureScript.Constants as C

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

112 | ShadowedTypeVar String

113 | ShadowedTypeVar String

113 | UnusedTypeVar String

114 | UnusedTypeVar String

114 | WildcardInferredType Type

115 | WildcardInferredType Type

115− | HoleInferredType String Type

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

116 | MissingTypeDeclaration Ident Type

117 | MissingTypeDeclaration Ident Type

117 | OverlappingPattern [[Binder]] Bool

118 | OverlappingPattern [[Binder]] Bool

118 | IncompleteExhaustivityCheck

119 | IncompleteExhaustivityCheck

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

127 | DuplicateImportRef Name

128 | DuplicateImportRef Name

128 | DuplicateExportRef Name

129 | DuplicateExportRef Name

129 | IntOutOfRange Integer String Integer Integer

130 | IntOutOfRange Integer String Integer Integer

130− | RedundantEmptyHidingImport ModuleName

131 | ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]

131 | ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]

132 | ImplicitImport ModuleName [DeclarationRef]

132 | ImplicitImport ModuleName [DeclarationRef]

133 | HidingImport ModuleName [DeclarationRef]

133 | HidingImport ModuleName [DeclarationRef]

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

297 DuplicateImportRef{} -> "DuplicateImportRef"

297 DuplicateImportRef{} -> "DuplicateImportRef"

298 DuplicateExportRef{} -> "DuplicateExportRef"

298 DuplicateExportRef{} -> "DuplicateExportRef"

299 IntOutOfRange{} -> "IntOutOfRange"

299 IntOutOfRange{} -> "IntOutOfRange"

300− RedundantEmptyHidingImport{} -> "RedundantEmptyHidingImport"

301 ImplicitQualifiedImport{} -> "ImplicitQualifiedImport"

300 ImplicitQualifiedImport{} -> "ImplicitQualifiedImport"

302 ImplicitImport{} -> "ImplicitImport"

301 ImplicitImport{} -> "ImplicitImport"

303 HidingImport{} -> "HidingImport"

302 HidingImport{} -> "HidingImport"

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

339

338

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

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

341data TypeMap = TypeMap

340data TypeMap = TypeMap

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

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

343− , umNextSkolem :: Int

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

344− , umUnknownMap :: M.Map Int Int

343+ , umUnknownMap :: M.Map Int Int

345− , umNextUnknown :: 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.

346 } deriving Show

348 } deriving Show

347

349

348defaultUnknownMap :: TypeMap

350defaultUnknownMap :: TypeMap

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

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

350

352

351-- | How critical the issue is

353-- | How critical the issue is

352data Level = Error | Warning deriving Show

354data Level = Error | Warning deriving Show

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

365 m <- get

367 m <- get

366 case M.lookup u (umUnknownMap m) of

368 case M.lookup u (umUnknownMap m) of

367 Nothing -> do

369 Nothing -> do

368− let u' = umNextUnknown m

370+ let u' = umNextIndex m

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

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

370 return (TUnknown u')

372 return (TUnknown u')

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

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

372 replaceTypes (Skolem name s sko ss) = do

374 replaceTypes (Skolem name s sko ss) = do

373 m <- get

375 m <- get

374 case M.lookup s (umSkolemMap m) of

376 case M.lookup s (umSkolemMap m) of

375 Nothing -> do

377 Nothing -> do

376− let s' = umNextSkolem m

378+ let s' = umNextIndex m

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

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

378 return (Skolem name s' sko ss)

380 return (Skolem name s' sko ss)

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

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

380 replaceTypes other = return other

382 replaceTypes other = return other

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

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

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

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

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

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

399 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

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

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

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

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

401

403

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

418errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion

420errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion

419errorSuggestion err = case err of

421errorSuggestion err = case err of

420 UnusedImport{} -> emptySuggestion

422 UnusedImport{} -> emptySuggestion

421− RedundantEmptyHidingImport{} -> emptySuggestion

422 DuplicateImport{} -> emptySuggestion

423 DuplicateImport{} -> emptySuggestion

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

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

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

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

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

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

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

495

496

496 unknownInfo :: Int -> Box.Box

497 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"

498

499

499 renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box

500 renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box

500 renderSimpleErrorMessage (CannotGetFileInfo path) =

501 renderSimpleErrorMessage (CannotGetFileInfo path) =

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

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

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

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

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

578 ]

579 ]

579− renderSimpleErrorMessage (UnknownImportDataConstructor mn dcon tcon) =

580+ renderSimpleErrorMessage (UnknownImportDataConstructor mn tcon dcon) =

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

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

581 renderSimpleErrorMessage (UnknownExport name) =

582 renderSimpleErrorMessage (UnknownExport name) =

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

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

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

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

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

818 , indent $ typeAsBox ty

819 , indent $ typeAsBox ty

819 ]

820 ]

820− renderSimpleErrorMessage (HoleInferredType name ty) =

821+ renderSimpleErrorMessage (HoleInferredType name ty env) =

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

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

822− , indent $ typeAsBox ty

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+ ]

823− ]

834+ ]

824 renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =

835 renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =

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

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

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

837 , 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

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

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

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

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

870

881

871− renderSimpleErrorMessage (RedundantEmptyHidingImport mn) =

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

873−

874 renderSimpleErrorMessage msg@(ImplicitQualifiedImport importedModule asModule _) =

882 renderSimpleErrorMessage msg@(ImplicitQualifiedImport importedModule asModule _) =

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

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

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

884 , 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)

36import Data.Monoid

36import Data.Monoid

37import Data.Text (Text)

37import Data.Text (Text)

38import qualified Data.Text as T

38import qualified Data.Text as T

39+import qualified Language.PureScript as P

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

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

40import Language.PureScript.Ide.Command

41import Language.PureScript.Ide.Command

41import Language.PureScript.Ide.Completion

42import Language.PureScript.Ide.Completion

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

60handleCommand (Load [] []) = loadAllModules

61handleCommand (Load [] []) = loadAllModules

61handleCommand (Load modules deps) =

62handleCommand (Load modules deps) =

62 loadModulesAndDeps modules deps

63 loadModulesAndDeps modules deps

63−handleCommand (Type search filters) =

64+handleCommand (Type search filters currentModule) =

64− findType search filters

65+ findType search filters currentModule

65−handleCommand (Complete filters matcher) =

66+handleCommand (Complete filters matcher currentModule) =

66− findCompletions filters matcher

67+ findCompletions filters matcher currentModule

67handleCommand (Pursuit query Package) =

68handleCommand (Pursuit query Package) =

68 findPursuitPackages query

69 findPursuitPackages query

69handleCommand (Pursuit query Identifier) =

70handleCommand (Pursuit query Identifier) =

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

94handleCommand Quit = liftIO exitSuccess

95handleCommand Quit = liftIO exitSuccess

95

96

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

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

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

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

98−findCompletions filters matcher =

99+findCompletions filters matcher currentModule = do

100+ modules <- getAllModulesWithReexportsAndCache currentModule

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

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

100

102

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

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

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

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

103−findType search filters =

105+findType search filters currentModule = do

106+ modules <- getAllModulesWithReexportsAndCache currentModule

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

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

105

108

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

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

107 PursuitQuery -> m Success

110 PursuitQuery -> m Success

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

113findPursuitPackages (PursuitQuery q) =

116findPursuitPackages (PursuitQuery q) =

114 PursuitResult <$> liftIO (findPackagesForModuleIdent q)

117 PursuitResult <$> liftIO (findPackagesForModuleIdent q)

115

118

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

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

117 FilePath -> m ()

120 FilePath -> m ()

118loadExtern fp = do

121loadExtern fp = do

119 m <- readExternFile fp

122 m <- readExternFile fp

120 insertModule m

123 insertModule m

121

124

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

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

123−printModules = printModules' <$> getPscIdeState

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

124

127

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

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

126printModules' = ModuleList . M.keys

129printModules' = ModuleList . M.keys

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

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

21

21

22import Control.Monad

22import Control.Monad

23import Data.Aeson

23import Data.Aeson

24−import Data.Maybe

25import Data.Text (Text)

24import Data.Text (Text)

26−import Language.PureScript (ModuleName,

25+import qualified Language.PureScript as P

27− moduleNameFromString)

28import Language.PureScript.Ide.CaseSplit

26import Language.PureScript.Ide.CaseSplit

29import Language.PureScript.Ide.Filter

27import Language.PureScript.Ide.Filter

30import Language.PureScript.Ide.Matcher

28import Language.PureScript.Ide.Matcher

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

36 , loadDependencies :: [ModuleIdent]

34 , loadDependencies :: [ModuleIdent]

37 }

35 }

38 | Type

36 | Type

39− { typeSearch :: DeclIdent

37+ { typeSearch :: DeclIdent

40− , typeFilters :: [Filter]

38+ , typeFilters :: [Filter]

39+ , typeCurrentModule :: Maybe P.ModuleName

41 }

40 }

42 | Complete

41 | Complete

43− { completeFilters :: [Filter]

42+ { completeFilters :: [Filter]

44− , completeMatcher :: Matcher

43+ , completeMatcher :: Matcher

44+ , completeCurrentModule :: Maybe P.ModuleName

45 }

45 }

46 | Pursuit

46 | Pursuit

47 { pursuitQuery :: PursuitQuery

47 { pursuitQuery :: PursuitQuery

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

67 | Quit

67 | Quit

68

68

69data ImportCommand

69data ImportCommand

70− = AddImplicitImport ModuleName

70+ = AddImplicitImport P.ModuleName

71 | AddImportForIdentifier DeclIdent

71 | AddImportForIdentifier DeclIdent

72 deriving (Show, Eq)

72 deriving (Show, Eq)

73

73

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

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

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

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

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

77 case command of

77 case command of

78− "addImplicitImport" -> do

78+ "addImplicitImport" ->

79− mn <- o .: "module"

80− pure (AddImplicitImport (moduleNameFromString mn))

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

81− "addImport" -> do

80+ "addImport" ->

82− ident <- o .: "identifier"

83− pure (AddImportForIdentifier ident)

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

84 _ -> mzero

82 _ -> mzero

85

83

86data ListType = LoadedModules | Imports FilePath | AvailableModules

84data ListType = LoadedModules | Imports FilePath | AvailableModules

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

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

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

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

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

91 case listType' of

89 case listType' of

92− "import" -> do

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

93− fp <- o .: "file"

94− return (Imports fp)

95− "loadedModules" -> return LoadedModules

91+ "loadedModules" -> pure LoadedModules

96− "availableModules" -> return AvailableModules

92+ "availableModules" -> pure AvailableModules

97 _ -> mzero

93 _ -> mzero

98

94

99instance FromJSON Command where

95instance FromJSON Command where

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

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

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

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

102 case command of

98 case command of

103− "list" -> do

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

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

105− return $ List (fromMaybe LoadedModules listType')

106− "cwd" -> return Cwd

100+ "cwd" -> pure Cwd

107− "quit" -> return Quit

101+ "quit" -> pure Quit

108 "reset" -> pure Reset

102 "reset" -> pure Reset

109− "load" ->

103+ "load" -> do

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

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

105+ case params' of

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

107+ Just params ->

108+ Load

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

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

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

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

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

114 "type" -> do

111 "type" -> do

115 params <- o .: "params"

112 params <- o .: "params"

116− search <- params .: "search"

113+ Type

117− filters <- params .: "filters"

114+ <$> params .: "search"

118− return $ Type search filters

115+ <*> params .: "filters"

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

119 "complete" -> do

117 "complete" -> do

120 params <- o .: "params"

118 params <- o .: "params"

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

119+ Complete

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

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

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

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

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

124 "pursuit" -> do

123 "pursuit" -> do

125 params <- o .: "params"

124 params <- o .: "params"

125+ Pursuit

126− query <- params .: "query"

126+ <$> params .: "query"

127− queryType <- params .: "type"

127+ <*> params .: "type"

128− return $ Pursuit query queryType

129 "caseSplit" -> do

128 "caseSplit" -> do

130 params <- o .: "params"

129 params <- o .: "params"

131− line <- params .: "line"

130+ CaseSplit

132− begin <- params .: "begin"

131+ <$> params .: "line"

133− end <- params .: "end"

132+ <*> params .: "begin"

134− annotations <- params .: "annotations"

133+ <*> params .: "end"

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

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

136− return $ CaseSplit line begin end (if annotations

135+ <*> params .: "type"

137− then explicitAnnotations

138− else noAnnotations) type'

139 "addClause" -> do

136 "addClause" -> do

140 params <- o .: "params"

137 params <- o .: "params"

141− line <- params .: "line"

142− annotations <- params .: "annotations"

143− return $ AddClause line (if annotations

138+ AddClause

144− then explicitAnnotations

139+ <$> params .: "line"

145− else noAnnotations)

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

146 "import" -> do

141 "import" -> do

147 params <- o .: "params"

142 params <- o .: "params"

143+ Import

148− fp <- params .: "file"

144+ <$> params .: "file"

149− out <- params .:? "outfile"

145+ <*> params .:? "outfile"

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

146+ <*> params .:? "filters" .!= []

151− importCommand <- params .: "importCommand"

152− pure $ Import fp out (fromMaybe [] filters) importCommand

147+ <*> params .: "importCommand"

153 "rebuild" -> do

148 "rebuild" -> do

154 params <- o .: "params"

149 params <- o .: "params"

150+ Rebuild

155− filePath <- params .: "file"

151+ <$> params .: "file"

156− return $ Rebuild filePath

157 _ -> mzero

152 _ -> mzero

153+ where

154+ mkAnnotations True = explicitAnnotations

155+ mkAnnotations False = noAnnotations

src/Language/PureScript/Ide/Rebuild.hs+110−26

@@ -1,43 +1,64 @@

1{-# LANGUAGE OverloadedStrings #-}

1{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE PackageImports #-}

2{-# LANGUAGE PackageImports #-}

3+{-# LANGUAGE RecordWildCards #-}

4+{-# LANGUAGE TemplateHaskell #-}

5+{-# LANGUAGE TupleSections #-}

3

6

4−module Language.PureScript.Ide.Rebuild where

7+module Language.PureScript.Ide.Rebuild

5−

8+ ( rebuildFile

6−import Prelude.Compat

9+ ) where

7−

8−import Language.PureScript.Ide.Error

9−import Language.PureScript.Ide.State

10−import Language.PureScript.Ide.Types

11

10

12import Control.Monad.Error.Class

11import Control.Monad.Error.Class

13import Control.Monad.IO.Class

12import Control.Monad.IO.Class

14import "monad-logger" Control.Monad.Logger

13import "monad-logger" Control.Monad.Logger

15−import Control.Monad.Reader.Class

14+import Control.Monad.Reader

16import Control.Monad.Trans.Except

15import Control.Monad.Trans.Except

17import qualified Data.Map.Lazy as M

16import qualified Data.Map.Lazy as M

18import Data.Maybe (fromJust, mapMaybe)

17import Data.Maybe (fromJust, mapMaybe)

18+import Data.Monoid ((<>))

19import qualified Data.Set as S

19import qualified Data.Set as S

20import qualified Language.PureScript as P

20import qualified Language.PureScript as P

21import Language.PureScript.Errors.JSON

21import Language.PureScript.Errors.JSON

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

22−import System.IO.UTF8 (readUTF8File)

27+import System.IO.UTF8 (readUTF8File)

23

28

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.

24rebuildFile

44rebuildFile

25 :: (PscIde m, MonadLogger m, MonadError PscIdeError m)

45 :: (PscIde m, MonadLogger m, MonadError PscIdeError m)

26 => FilePath

46 => FilePath

27 -> m Success

47 -> m Success

28rebuildFile path = do

48rebuildFile path = do

29

49

30− input <- liftIO $ readUTF8File path

50+ input <- liftIO (readUTF8File path)

31

51

32− m <- case map snd <$> P.parseModulesFromFiles id [(path, input)] of

52+ m <- case snd <$> P.parseModuleFromFile id (path, input) of

33− Left parseError ->

53+ Left parseError -> throwError

54+ . RebuildError

34− throwError . RebuildError . toJSONErrors False P.Error $ parseError

55+ . toJSONErrors False P.Error

56+ $ P.MultipleErrors [P.toPositionedError parseError]

35− Right [m] -> pure m

57+ Right m -> pure m

36− Right _ -> throwError . GeneralError $ "Please define exactly one module."

37

58

38 -- Externs files must be sorted ahead of time, so that they get applied

59 -- Externs files must be sorted ahead of time, so that they get applied

39 -- correctly to the 'Environment'.

60 -- correctly to the 'Environment'.

40− externs <- sortExterns m . M.delete (P.getModuleName m) =<< getExternFiles

61+ externs <- sortExterns m =<< getExternFiles

41

62

42 outputDirectory <- confOutputPath . envConfiguration <$> ask

63 outputDirectory <- confOutputPath . envConfiguration <$> ask

43

64

@@ -46,26 +67,85 @@ rebuildFile path = do

46 let filePathMap = M.singleton (P.getModuleName m) (Left P.RebuildAlways)

67 let filePathMap = M.singleton (P.getModuleName m) (Left P.RebuildAlways)

47 foreigns <- P.inferForeignModules (M.singleton (P.getModuleName m) (Right path))

68 foreigns <- P.inferForeignModules (M.singleton (P.getModuleName m) (Right path))

48

69

49− -- Silence progress update messages during the build

50− let actions = (P.buildMakeActions outputDirectory filePathMap foreigns False)

70+ let makeEnv = MakeActionsEnv outputDirectory filePathMap foreigns False

51− { P.progress = const (pure ()) }

52−

53 -- Rebuild the single module using the cached externs

71 -- Rebuild the single module using the cached externs

54 (result, warnings) <- liftIO

72 (result, warnings) <- liftIO

55− . P.runMake P.defaultOptions

73+ . P.runMake P.defaultOptions

56− . P.rebuildModule actions externs

74+ . P.rebuildModule (buildMakeActions

57− $ m

75+ >>= shushProgress $ makeEnv) externs $ m

58 case result of

76 case result of

59− Left errors -> throwError . RebuildError $ toJSONErrors False P.Error errors

77+ Left errors -> throwError (RebuildError (toJSONErrors False P.Error errors))

78+ Right _ -> do

79+ rebuildModuleOpen makeEnv externs m

60− Right _ -> pure . RebuildSuccess $ toJSONErrors False P.Warning warnings

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+ }

61

113

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

62sortExterns

137sortExterns

63 :: (PscIde m, MonadError PscIdeError m)

138 :: (PscIde m, MonadError PscIdeError m)

64 => P.Module

139 => P.Module

65 -> M.Map P.ModuleName P.ExternsFile

140 -> M.Map P.ModuleName P.ExternsFile

66 -> m [P.ExternsFile]

141 -> m [P.ExternsFile]

67sortExterns m ex = do

142sortExterns m ex = do

143+ sorted' <- runExceptT

144+ . P.sortModules

145+ . (:) m

68− sorted' <- runExceptT . P.sortModules . (:) m . map mkShallowModule . M.elems $ ex

146+ . map mkShallowModule

147+ . M.elems

148+ . M.delete (P.getModuleName m) $ ex

69 case sorted' of

149 case sorted' of

70 Left _ -> throwError (GeneralError "There was a cycle in the dependencies")

150 Left _ -> throwError (GeneralError "There was a cycle in the dependencies")

71 Right (sorted, graph) -> do

151 Right (sorted, graph) -> do

@@ -80,3 +160,7 @@ sortExterns m ex = do

80 -- Sort a list so its elements appear in the same order as in another list.

160 -- Sort a list so its elements appear in the same order as in another list.

81 inOrderOf :: (Ord a) => [a] -> [a] -> [a]

161 inOrderOf :: (Ord a) => [a] -> [a] -> [a]

82 inOrderOf xs ys = let s = S.fromList xs in filter (`S.member` s) ys

162 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 @@

16{-# LANGUAGE PackageImports #-}

16{-# LANGUAGE PackageImports #-}

17{-# LANGUAGE TemplateHaskell #-}

17{-# LANGUAGE TemplateHaskell #-}

18

18

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

20

32

21import Prelude ()

33import Prelude ()

22import Prelude.Compat

34import Prelude.Compat

@@ -26,74 +38,106 @@ import Control.Monad.IO.Class

26import "monad-logger" Control.Monad.Logger

38import "monad-logger" Control.Monad.Logger

27import Control.Monad.Reader.Class

39import Control.Monad.Reader.Class

28import qualified Data.Map.Lazy as M

40import qualified Data.Map.Lazy as M

29−import Data.Maybe (catMaybes)

41+import Data.Maybe (mapMaybe)

30import Data.Monoid

42import Data.Monoid

31−import qualified Data.Text as T

32import Language.PureScript.Externs

43import Language.PureScript.Externs

33import Language.PureScript.Ide.Externs

44import Language.PureScript.Ide.Externs

34import Language.PureScript.Ide.Reexports

45import Language.PureScript.Ide.Reexports

35import Language.PureScript.Ide.Types

46import Language.PureScript.Ide.Types

36−import Language.PureScript.Names

47+import Language.PureScript.Ide.Util

48+import qualified Language.PureScript as P

37

49

50+-- | Resets the PscIdeState to emptyPscIdeState

38resetPscIdeState :: PscIde m => m ()

51resetPscIdeState :: PscIde m => m ()

39resetPscIdeState = do

52resetPscIdeState = do

40 stateVar <- envStateVar <$> ask

53 stateVar <- envStateVar <$> ask

41 liftIO $ atomically (writeTVar stateVar emptyPscIdeState)

54 liftIO $ atomically (writeTVar stateVar emptyPscIdeState)

42

55

56+-- | Gets the entire PscIdeState

43−getPscIdeState :: (PscIde m) =>

57+getPscIdeState :: PscIde m => m PscIdeState

44− m (M.Map ModuleIdent [ExternDecl])

45getPscIdeState = do

58getPscIdeState = do

46 stateVar <- envStateVar <$> ask

59 stateVar <- envStateVar <$> ask

47− liftIO $ pscStateModules <$> readTVarIO stateVar

60+ liftIO (readTVarIO stateVar)

48

61

49−getExternFiles :: (PscIde m) =>

62+-- | Gets all loaded ExternFiles

50− m (M.Map ModuleName ExternsFile)

63+getExternFiles :: (PscIde m) => m (M.Map P.ModuleName ExternsFile)

51getExternFiles = do

64getExternFiles = do

52 stateVar <- envStateVar <$> ask

65 stateVar <- envStateVar <$> ask

53− liftIO (externsFiles <$> readTVarIO stateVar)

66+ liftIO (pscIdeStateExternsFiles <$> readTVarIO stateVar)

54−

67+

55−getExternFile :: (PscIde m) =>

68+-- | Gets all loaded Modules and resolves Reexports

56− ModuleName -> m (Maybe ExternsFile)

69+getAllModulesWithReexports :: (PscIde m) => m [Module]

57−getExternFile mn = M.lookup mn <$> getExternFiles

70+getAllModulesWithReexports = getAllModulesWithReexports' <$> getPscIdeState

58−

71+

59−getAllDecls :: (PscIde m) => m [ExternDecl]

72+-- | Pure version of @getAllModulesWithReexports@

60−getAllDecls = concat <$> getPscIdeState

61−

62−getAllModules :: (PscIde m) => m [Module]

63−getAllModules = M.toList <$> getPscIdeState

64−

65−getAllModulesWithReexports :: (PscIde m, MonadLogger m) =>

73+getAllModulesWithReexports' :: PscIdeState -> [Module]

66− m [Module]

67−getAllModulesWithReexports = do

74+getAllModulesWithReexports' state =

68− mis <- M.keys <$> getPscIdeState

75+ mapMaybe (getModuleWithReexports' state) (M.keys (pscIdeStateModules state))

69− ms <- traverse getModuleWithReexports mis

76+

70− pure (catMaybes ms)

77+-- | Checks if the given ModuleName matches the last rebuild cache and if it

71−

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

72−getModule :: (PscIde m, MonadLogger m) =>

94+getModule :: (PscIde m, MonadLogger m) => ModuleIdent -> m (Maybe Module)

73− ModuleIdent -> m (Maybe Module)

74−getModule m = do

75− modules <- getPscIdeState

95+getModule m = getModule' <$> getPscIdeState <*> pure m

76− pure ((m,) <$> M.lookup m modules)

96+

77−

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

78−getModuleWithReexports :: (PscIde m, MonadLogger m) =>

102+getModuleWithReexports :: PscIde m => ModuleIdent -> m (Maybe Module)

79− ModuleIdent -> m (Maybe Module)

80−getModuleWithReexports mi = do

103+getModuleWithReexports i = getModuleWithReexports' <$> getPscIdeState <*> pure i

81− m <- getModule mi

104+

82− modules <- getPscIdeState

105+-- | Pure version of @getModuleWithReexports@

106+getModuleWithReexports' :: PscIdeState -> ModuleIdent -> Maybe Module

107+getModuleWithReexports' ps mi =

83− pure $ resolveReexports modules <$> m

108+ resolveReexports (pscIdeStateModules ps) <$> getModule' ps mi

84−

109+

110+-- | Inserts an @ExternsFile@ into the PscIdeState. Also converts the

111+-- ExternsFile into psc-ide's internal Declaration format

85−insertModule ::(PscIde m, MonadLogger m) =>

112+insertModule :: (PscIde m, MonadLogger m) =>

86 ExternsFile -> m ()

113 ExternsFile -> m ()

87insertModule externsFile = do

114insertModule externsFile = do

88− env <- ask

115+ stateVar <- envStateVar <$> ask

89 let moduleName = efModuleName externsFile

116 let moduleName = efModuleName externsFile

90− $(logDebug) $ "Inserting Module: " <> T.pack (runModuleName moduleName)

117+ $(logDebug) $ "Inserting Module: " <> runModuleNameT moduleName

91− liftIO . atomically $ insertModule' (envStateVar env) externsFile

118+ liftIO . atomically $ insertModuleSTM stateVar externsFile

92−

119+

120+-- | STM version of insertModule

93−insertModule' :: TVar PscIdeState -> ExternsFile -> STM ()

121+insertModuleSTM :: TVar PscIdeState -> ExternsFile -> STM ()

94−insertModule' st ef =

95− modifyTVar st $ \x ->

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 =

96− x { externsFiles = M.insert (efModuleName ef) ef (externsFiles x)

129+ M.insert (efModuleName ef) ef (pscIdeStateExternsFiles state)

97− , pscStateModules = let (mn, decls) = convertExterns ef

130+ , pscIdeStateModules = let (mn, decls) = convertExterns ef

98− in M.insert mn decls (pscStateModules x)

131+ in M.insert mn decls (pscIdeStateModules state)

99− }

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)

83

83

84data PscIdeState =

84data PscIdeState =

85 PscIdeState

85 PscIdeState

86− { pscStateModules :: M.Map Text [ExternDecl]

86+ { pscIdeStateModules :: M.Map Text [ExternDecl]

87− , externsFiles :: M.Map P.ModuleName ExternsFile

87+ , pscIdeStateExternsFiles :: M.Map P.ModuleName ExternsFile

88+ , pscIdeStateCachedRebuild :: Maybe (P.ModuleName, ExternsFile)

88 } deriving Show

89 } deriving Show

89

90

90emptyPscIdeState :: PscIdeState

91emptyPscIdeState :: PscIdeState

91−emptyPscIdeState = PscIdeState M.empty M.empty

92+emptyPscIdeState = PscIdeState M.empty M.empty Nothing

92

93

93data Match = Match ModuleIdent ExternDecl

94data Match = Match ModuleIdent ExternDecl

94 deriving (Show, Eq)

95 deriving (Show, Eq)

src/Language/PureScript/Ide/Util.hs+3

@@ -34,6 +34,9 @@ runIdentT = T.pack . P.runIdent

34runOpNameT :: P.OpName a -> Text

34runOpNameT :: P.OpName a -> Text

35runOpNameT = T.pack . P.runOpName

35runOpNameT = T.pack . P.runOpName

36

36

37+runModuleNameT :: P.ModuleName -> Text

38+runModuleNameT = T.pack . P.runModuleName

39+

37prettyTypeT :: P.Type -> Text

40prettyTypeT :: P.Type -> Text

38prettyTypeT = T.unwords . fmap T.strip . T.lines . T.pack . P.prettyPrintType

41prettyTypeT = T.unwords . fmap T.strip . T.lines . T.pack . P.prettyPrintType

39

42

src/Language/PureScript/Ide/Watcher.hs+7−6

@@ -35,14 +35,15 @@ reloadFile stateVar ev = do

35 case ef' of

35 case ef' of

36 Left _ -> pure ()

36 Left _ -> pure ()

37 Right ef -> do

37 Right ef -> do

38− atomically (insertModule' stateVar ef)

38+ atomically (insertModuleSTM stateVar ef)

39 putStrLn ("Reloaded File at: " ++ fp)

39 putStrLn ("Reloaded File at: " ++ fp)

40

40

41-- | Installs filewatchers for the given directory and reloads ExternsFiles when

41-- | Installs filewatchers for the given directory and reloads ExternsFiles when

42-- they change on disc

42-- they change on disc

43watcher :: TVar PscIdeState -> FilePath -> IO ()

43watcher :: TVar PscIdeState -> FilePath -> IO ()

44+watcher stateVar fp =

44−watcher stateVar fp = withManagerConf (defaultConfig { confDebounce = NoDebounce }) $ \mgr -> do

45+ withManagerConf (defaultConfig { confDebounce = NoDebounce }) $ \mgr -> do

45− _ <- watchTree mgr fp

46+ _ <- watchTree mgr fp

46− (\ev -> takeFileName (eventPath ev) == "externs.json")

47+ (\ev -> takeFileName (eventPath ev) == "externs.json")

47− (reloadFile stateVar)

48+ (reloadFile stateVar)

48− forever (threadDelay 100000)

49+ forever (threadDelay 100000)

src/Language/PureScript/Interactive/Module.hs+8−7

@@ -44,14 +44,15 @@ loadAllModules files = do

44createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module

44createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module

45createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindings = lets} val =

45createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindings = lets} val =

46 let

46 let

47− moduleName = P.ModuleName [P.ProperName "$PSCI"]

47+ moduleName = P.ModuleName [P.ProperName "$PSCI"]

48− trace = P.Var (P.Qualified (Just supportModuleName) (P.Ident "eval"))

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"))

49− mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))

50+ mainValue = P.App eval (P.Var (P.Qualified Nothing (P.Ident "it")))

50− itDecl = P.ValueDeclaration (P.Ident "it") P.Public [] $ Right val

51+ itDecl = P.ValueDeclaration (P.Ident "it") P.Public [] $ Right val

51− mainDecl = P.ValueDeclaration (P.Ident "$main") P.Public [] $ Right mainValue

52+ mainDecl = P.ValueDeclaration (P.Ident "$main") P.Public [] $ Right mainValue

52− decls = if exec then [itDecl, mainDecl] else [itDecl]

53+ decls = if exec then [itDecl, mainDecl] else [itDecl]

53 in

54 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

55

56

56

57

57-- |

58-- |

src/Language/PureScript/Linter/Exhaustive.hs+33−24

@@ -14,6 +14,7 @@ import Control.Applicative

14import Control.Arrow (first, second)

14import Control.Arrow (first, second)

15import Control.Monad (unless)

15import Control.Monad (unless)

16import Control.Monad.Writer.Class

16import Control.Monad.Writer.Class

17+import Control.Monad.Supply.Class (MonadSupply, fresh, freshName)

17

18

18import Data.Function (on)

19import Data.Function (on)

19import Data.List (foldl', sortBy, nub)

20import Data.List (foldl', sortBy, nub)

@@ -45,7 +46,7 @@ data RedundancyError = Incomplete | Unknown

45-- Qualifies a propername from a given qualified propername and a default module name

46-- Qualifies a propername from a given qualified propername and a default module name

46--

47--

47qualifyName

48qualifyName

48− :: (ProperName a)

49+ :: ProperName a

49 -> ModuleName

50 -> ModuleName

50 -> Qualified (ProperName b)

51 -> Qualified (ProperName b)

51 -> Qualified (ProperName a)

52 -> Qualified (ProperName a)

@@ -231,7 +232,7 @@ missingAlternative env mn ca uncovered

231--

232--

232checkExhaustive

233checkExhaustive

233 :: forall m

234 :: forall m

234− . (MonadWriter MultipleErrors m)

235+ . (MonadWriter MultipleErrors m, MonadSupply m)

235 => Environment

236 => Environment

236 -> ModuleName

237 -> ModuleName

237 -> Int

238 -> Int

@@ -262,7 +263,7 @@ checkExhaustive env mn numArgs cas expr = makeResult . first nub $ foldl' step (

262 _ -> return ()

263 _ -> return ()

263 if null bss

264 if null bss

264 then return expr

265 then return expr

265− else return (addPartialConstraint (second null (splitAt 5 bss)) expr)

266+ else addPartialConstraint (second null (splitAt 5 bss)) expr

266 where

267 where

267 tellRedundant = tell . errorMessage . uncurry OverlappingPattern . second null . splitAt 5 $ bss'

268 tellRedundant = tell . errorMessage . uncurry OverlappingPattern . second null . splitAt 5 $ bss'

268 tellIncomplete = tell . errorMessage $ IncompleteExhaustivityCheck

269 tellIncomplete = tell . errorMessage $ IncompleteExhaustivityCheck

@@ -273,34 +274,42 @@ checkExhaustive env mn numArgs cas expr = makeResult . first nub $ foldl' step (

273 --

274 --

274 -- The binder information is provided so that it can be embedded in the constraint,

275 -- The binder information is provided so that it can be embedded in the constraint,

275 -- and then included in the error message.

276 -- and then included in the error message.

276− addPartialConstraint :: ([[Binder]], Bool) -> Expr -> Expr

277+ addPartialConstraint :: MonadSupply m => ([[Binder]], Bool) -> Expr -> m Expr

277− addPartialConstraint (bss, complete) e =

278+ addPartialConstraint (bss, complete) e = do

279+ tyVar <- ("p" ++) . show <$> fresh

280+ var <- freshName

281+ return $

282+ Let

283+ [ partial var tyVar ]

278− Let [ partial ] (App (Var (Qualified Nothing (Ident C.__unused))) e)

284+ $ App (Var (Qualified Nothing (Ident C.__unused))) e

279 where

285 where

280− partial :: Declaration

286+ partial :: String -> String -> Declaration

287+ partial var tyVar =

281− partial = ValueDeclaration (Ident C.__unused)

288+ ValueDeclaration (Ident C.__unused) Private [] $ Right $

282− Private

283− []

284− (Right (TypedValue True (Abs (Left (Ident "x"))

289+ TypedValue

290+ True

285− (Var (Qualified Nothing (Ident "x"))))

291+ (Abs (Left (Ident var)) (Var (Qualified Nothing (Ident var))))

286− ty))

292+ (ty tyVar)

287−

293+

288− ty :: Type

294+ ty :: String -> Type

289− ty = ForAll "a" (ConstrainedType [ Constraint (Qualified (Just (ModuleName [ProperName C.prim]))

295+ ty tyVar =

290− (ProperName "Partial"))

296+ ForAll tyVar

291− []

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 =

292− (Just (PartialConstraintData (map (map prettyPrintBinderAtom) bss) complete))

305+ PartialConstraintData (map (map prettyPrintBinderAtom) bss) complete

293− ]

294− (TypeApp (TypeApp tyFunction (TypeVar "a"))

295− (TypeVar "a")))

296− Nothing

297

306

298-- |

307-- |

299-- Exhaustivity checking

308-- Exhaustivity checking

300--

309--

301checkExhaustiveExpr

310checkExhaustiveExpr

302 :: forall m

311 :: forall m

303− . MonadWriter MultipleErrors m

312+ . (MonadWriter MultipleErrors m, MonadSupply m)

304 => Environment

313 => Environment

305 -> ModuleName

314 -> ModuleName

306 -> Expr

315 -> Expr

src/Language/PureScript/Linter/Imports.hs+32−35

@@ -6,7 +6,7 @@ module Language.PureScript.Linter.Imports

6

6

7import Prelude.Compat

7import Prelude.Compat

8

8

9−import Control.Monad (join, unless, when, foldM, (<=<))

9+import Control.Monad (join, unless, foldM, (<=<))

10import Control.Monad.Writer.Class

10import Control.Monad.Writer.Class

11

11

12import Data.Function (on)

12import Data.Function (on)

@@ -54,12 +54,13 @@ lintImports

54 -> Env

54 -> Env

55 -> UsedImports

55 -> UsedImports

56 -> m ()

56 -> m ()

57−lintImports (Module _ _ _ _ Nothing) _ _ = return ()

57+lintImports (Module _ _ _ _ Nothing) _ _ =

58+ internalError "lintImports needs desugared exports"

58lintImports (Module ss _ mn mdecls (Just mexports)) env usedImps = do

59lintImports (Module ss _ mn mdecls (Just mexports)) env usedImps = do

59

60

60 -- TODO: this needs some work to be easier to understand

61 -- TODO: this needs some work to be easier to understand

61

62

62− let scope = maybe nullImports (\(_, imps', _) -> imps') (M.lookup mn env)

63+ let scope = maybe primImports (\(_, imps', _) -> imps') (M.lookup mn env)

63 usedImps' = foldr (elaborateUsed scope) usedImps exportedModules

64 usedImps' = foldr (elaborateUsed scope) usedImps exportedModules

64 numOpenImports = getSum $ foldMap (Sum . countOpenImports) mdecls

65 numOpenImports = getSum $ foldMap (Sum . countOpenImports) mdecls

65 allowImplicit = numOpenImports == 1

66 allowImplicit = numOpenImports == 1

@@ -100,13 +101,11 @@ lintImports (Module ss _ mn mdecls (Just mexports)) env usedImps = do

100 maybe id warnWithPosition pos $

101 maybe id warnWithPosition pos $

101 tell $ errorMessage $ DuplicateSelectiveImport mnq

102 tell $ errorMessage $ DuplicateSelectiveImport mnq

102

103

103− for_ (imps \\ (warned ++ duplicates)) $ \(pos, typ, _) -> do

104+ for_ (imps \\ (warned ++ duplicates)) $ \(pos, typ, _) ->

104 warnDuplicateRefs (fromMaybe ss pos) DuplicateImportRef $ case typ of

105 warnDuplicateRefs (fromMaybe ss pos) DuplicateImportRef $ case typ of

105 Explicit refs -> refs

106 Explicit refs -> refs

106 Hiding refs -> refs

107 Hiding refs -> refs

107 _ -> []

108 _ -> []

108− for_ (M.lookup mn env) $ \(_, imported, _) ->

109− checkEmptyImport mnq imported typ

110

109

111 where

110 where

112

111

@@ -120,9 +119,9 @@ lintImports (Module ss _ mn mdecls (Just mexports)) env usedImps = do

120 countOpenImports :: Declaration -> Int

119 countOpenImports :: Declaration -> Int

121 countOpenImports (PositionedDeclaration _ _ d) = countOpenImports d

120 countOpenImports (PositionedDeclaration _ _ d) = countOpenImports d

122 countOpenImports (ImportDeclaration mn' Implicit Nothing)

121 countOpenImports (ImportDeclaration mn' Implicit Nothing)

123− | not (isPrim mn') = 1

122+ | not (isPrim mn' || mn == mn') = 1

124 countOpenImports (ImportDeclaration mn' (Hiding _) Nothing)

123 countOpenImports (ImportDeclaration mn' (Hiding _) Nothing)

125− | not (isPrim mn') = 1

124+ | not (isPrim mn' || mn == mn') = 1

126 countOpenImports _ = 0

125 countOpenImports _ = 0

127

126

128 -- Checks whether a module is the Prim module - used to suppress any checks

127 -- 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

160 elaborateUsed scope mne used =

159 elaborateUsed scope mne used =

161 foldr go used

160 foldr go used

162 $ extractByQual mne (importedTypeClasses scope) TyClassName

161 $ extractByQual mne (importedTypeClasses scope) TyClassName

162+ ++ extractByQual mne (importedTypeOps scope) TyOpName

163 ++ extractByQual mne (importedTypes scope) TyName

163 ++ extractByQual mne (importedTypes scope) TyName

164 ++ extractByQual mne (importedDataConstructors scope) DctorName

164 ++ extractByQual mne (importedDataConstructors scope) DctorName

165 ++ extractByQual mne (importedValues scope) IdentName

165 ++ extractByQual mne (importedValues scope) IdentName

166+ ++ extractByQual mne (importedValueOps scope) ValOpName

166 where

167 where

167 go :: (ModuleName, Qualified Name) -> UsedImports -> UsedImports

168 go :: (ModuleName, Qualified Name) -> UsedImports -> UsedImports

168 go (q, name) = M.alter (Just . maybe [name] (name :)) q

169 go (q, name) = M.alter (Just . maybe [name] (name :)) q

@@ -199,7 +200,10 @@ lintImportDecl

199lintImportDecl env mni qualifierName names declType allowImplicit =

200lintImportDecl env mni qualifierName names declType allowImplicit =

200 case declType of

201 case declType of

201 Implicit -> case qualifierName of

202 Implicit -> case qualifierName of

203+ Nothing ->

204+ if null allRefs

205+ then unused

202− Nothing -> unless' allowImplicit (checkImplicit ImplicitImport)

206+ else unless' allowImplicit (checkImplicit ImplicitImport)

203 Just q -> unless' (q `elem` mapMaybe getQual names) unused

207 Just q -> unless' (q `elem` mapMaybe getQual names) unused

204 Hiding _ -> unless' allowImplicit (checkImplicit HidingImport)

208 Hiding _ -> unless' allowImplicit (checkImplicit HidingImport)

205 Explicit [] -> unused

209 Explicit [] -> unused

@@ -213,7 +217,15 @@ lintImportDecl env mni qualifierName names declType allowImplicit =

213 checkImplicit warning =

217 checkImplicit warning =

214 if null allRefs

218 if null allRefs

215 then unused

219 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

217

229

218 checkExplicit

230 checkExplicit

219 :: [DeclarationRef]

231 :: [DeclarationRef]

@@ -248,9 +260,15 @@ lintImportDecl env mni qualifierName names declType allowImplicit =

248 warn :: SimpleErrorMessage -> m Bool

260 warn :: SimpleErrorMessage -> m Bool

249 warn err = tell (errorMessage err) >> return True

261 warn err = tell (errorMessage err) >> return True

250

262

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.

251 unless' :: Bool -> m Bool -> m Bool

269 unless' :: Bool -> m Bool -> m Bool

252− unless' True m = m

270+ unless' False m = m

253− unless' False _ = return False

271+ unless' True _ = return False

254

272

255 allRefs :: [DeclarationRef]

273 allRefs :: [DeclarationRef]

256 allRefs = findUsedRefs env mni qualifierName names

274 allRefs = findUsedRefs env mni qualifierName names

@@ -282,6 +300,7 @@ findUsedRefs env mni qn names =

282 let

300 let

283 classRefs = TypeClassRef <$> mapMaybe (getClassName <=< disqualifyFor qn) names

301 classRefs = TypeClassRef <$> mapMaybe (getClassName <=< disqualifyFor qn) names

284 valueRefs = ValueRef <$> mapMaybe (getIdentName <=< disqualifyFor qn) names

302 valueRefs = ValueRef <$> mapMaybe (getIdentName <=< disqualifyFor qn) names

303+ valueOpRefs = ValueOpRef <$> mapMaybe (getValOpName <=< disqualifyFor qn) names

285 typeOpRefs = TypeOpRef <$> mapMaybe (getTypeOpName <=< disqualifyFor qn) names

304 typeOpRefs = TypeOpRef <$> mapMaybe (getTypeOpName <=< disqualifyFor qn) names

286 types = mapMaybe (getTypeName <=< disqualifyFor qn) names

305 types = mapMaybe (getTypeName <=< disqualifyFor qn) names

287 dctors = mapMaybe (getDctorName <=< disqualifyFor qn) names

306 dctors = mapMaybe (getDctorName <=< disqualifyFor qn) names

@@ -290,7 +309,7 @@ findUsedRefs env mni qn names =

290 typesRefs

309 typesRefs

291 = map (flip TypeRef (Just [])) typesWithoutDctors

310 = map (flip TypeRef (Just [])) typesWithoutDctors

292 ++ map (\(ty, ds) -> TypeRef ty (Just ds)) (M.toList typesWithDctors)

311 ++ map (\(ty, ds) -> TypeRef ty (Just ds)) (M.toList typesWithDctors)

293− in classRefs ++ typeOpRefs ++ typesRefs ++ valueRefs

312+ in classRefs ++ typeOpRefs ++ typesRefs ++ valueRefs ++ valueOpRefs

294

313

295 where

314 where

296

315

@@ -344,25 +363,3 @@ checkDuplicateImports mn xs ((_, t1, q1), (pos, t2, q2)) =

344 tell $ errorMessage $ DuplicateImport mn t2 q2

363 tell $ errorMessage $ DuplicateImport mn t2 q2

345 return $ (pos, t2, q2) : xs

364 return $ (pos, t2, q2) : xs

346 else return xs

365 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

5 ( parseDeclaration

5 ( parseDeclaration

6 , parseModule

6 , parseModule

7 , parseModulesFromFiles

7 , parseModulesFromFiles

8+ , parseModuleFromFile

8 , parseValue

9 , parseValue

9 , parseGuard

10 , parseGuard

10 , parseBinder

11 , parseBinder

11 , parseBinderNoParens

12 , parseBinderNoParens

12 , parseImportDeclaration'

13 , parseImportDeclaration'

13 , parseLocalDeclaration

14 , parseLocalDeclaration

15+ , toPositionedError

14 ) where

16 ) where

15

17

16import Prelude hiding (lex)

18import Prelude hiding (lex)

@@ -232,7 +234,6 @@ parseDeclaration = positioned (P.choice

232 , parseValueDeclaration

234 , parseValueDeclaration

233 , parseExternDeclaration

235 , parseExternDeclaration

234 , parseFixityDeclaration

236 , parseFixityDeclaration

235− , parseImportDeclaration

236 , parseTypeClassDeclaration

237 , parseTypeClassDeclaration

237 , parseTypeInstanceDeclaration

238 , parseTypeInstanceDeclaration

238 , parseDerivingInstanceDeclaration

239 , parseDerivingInstanceDeclaration

@@ -256,7 +257,13 @@ parseModule = do

256 name <- moduleName

257 name <- moduleName

257 exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef

258 exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef

258 reserved "where"

259 reserved "where"

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)

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

265+ decls <- P.many (same *> parseDeclaration)

266+ return (imports ++ decls)

260 _ <- P.eof

267 _ <- P.eof

261 end <- P.getPosition

268 end <- P.getPosition

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

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

@@ -270,11 +277,7 @@ parseModulesFromFiles

270 -> [(k, String)]

277 -> [(k, String)]

271 -> m [(k, Module)]

278 -> m [(k, Module)]

272parseModulesFromFiles toFilePath input =

279parseModulesFromFiles toFilePath input =

273− flip parU wrapError . inParallel . flip map input $ \(k, content) -> do

280+ flip parU wrapError . inParallel . flip map input $ parseModuleFromFile toFilePath

274− let filename = toFilePath k

275− ts <- lex filename content

276− m <- runTokenParser filename parseModule ts

277− return (k, m)

278 where

281 where

279 wrapError :: Either P.ParseError a -> m a

282 wrapError :: Either P.ParseError a -> m a

280 wrapError = either (throwError . MultipleErrors . pure . toPositionedError) return

283 wrapError = either (throwError . MultipleErrors . pure . toPositionedError) return

@@ -285,6 +288,18 @@ parseModulesFromFiles toFilePath input =

285 inParallel = withStrategy (parList rseq)

288 inParallel = withStrategy (parList rseq)

286

289

287

290

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@

288toPositionedError :: P.ParseError -> ErrorMessage

303toPositionedError :: P.ParseError -> ErrorMessage

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

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

290 where

305 where

@@ -494,12 +509,12 @@ parseNullBinder = underscore *> return NullBinder

494

509

495parseIdentifierAndBinder :: TokenParser (String, Binder)

510parseIdentifierAndBinder :: TokenParser (String, Binder)

496parseIdentifierAndBinder =

511parseIdentifierAndBinder =

497− do name <- lname

512+ do name <- lname

498− b <- P.option (VarBinder (Ident name)) rest

513+ b <- P.option (VarBinder (Ident name)) rest

499− return (name, b)

514+ return (name, b)

500− <|> (,) <$> stringLiteral <*> rest

515+ <|> (,) <$> stringLiteral <*> rest

501 where

516 where

502− rest = C.indented *> (equals <|> colon) *> C.indented *> parseBinder

517+ rest = C.indented *> colon *> C.indented *> parseBinder

503

518

504-- |

519-- |

505-- Parse a binder

520-- Parse a binder

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

@@ -34,7 +34,7 @@ typeLiterals = mkPattern match

34 match (TypeVar var) = Just $ text var

34 match (TypeVar var) = Just $ text var

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

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

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

36 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

38 match (Skolem name s _ _) = Just $ text $ name ++ show s

38 match (Skolem name s _ _) = Just $ text $ name ++ show s

39 match REmpty = Just $ text "()"

39 match REmpty = Just $ text "()"

40 match row@RCons{} = Just $ prettyPrintRowWith '(' ')' row

40 match row@RCons{} = Just $ prettyPrintRowWith '(' ')' row

src/Language/PureScript/Sugar/Names.hs+30−68

@@ -16,7 +16,7 @@ import Control.Monad.Error.Class (MonadError(..))

16import Control.Monad.State.Lazy

16import Control.Monad.State.Lazy

17import Control.Monad.Writer (MonadWriter(..), censor)

17import Control.Monad.Writer (MonadWriter(..), censor)

18

18

19−import Data.List (find, nub)

19+import Data.List (nub)

20import Data.Maybe (fromMaybe, mapMaybe)

20import Data.Maybe (fromMaybe, mapMaybe)

21import qualified Data.Map as M

21import qualified Data.Map as M

22import qualified Data.Set as S

22import qualified Data.Set as S

@@ -65,9 +65,9 @@ desugarImportsWithEnv externs modules = do

65 externsEnv env ExternsFile{..} = do

65 externsEnv env ExternsFile{..} = do

66 let members = Exports{..}

66 let members = Exports{..}

67 ss = internalModuleSourceSpan "<Externs>"

67 ss = internalModuleSourceSpan "<Externs>"

68− env' = M.insert efModuleName (ss, nullImports, members) env

68+ env' = M.insert efModuleName (ss, primImports, members) env

69 fromEFImport (ExternsImport mn mt qmn) = (mn, [(Nothing, Just mt, qmn)])

69 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)

71 exps <- resolveExports env' ss efModuleName imps members efExports

71 exps <- resolveExports env' ss efModuleName imps members efExports

72 return $ M.insert efModuleName (ss, imps, exps) env

72 return $ M.insert efModuleName (ss, imps, exps) env

73 where

73 where

@@ -101,7 +101,7 @@ desugarImportsWithEnv externs modules = do

101 Just m' -> throwError . errorMessage $ RedefinedModule mn [envModuleSourceSpan m', ss]

101 Just m' -> throwError . errorMessage $ RedefinedModule mn [envModuleSourceSpan m', ss]

102 Nothing -> do

102 Nothing -> do

103 members <- findExportable m

103 members <- findExportable m

104− let env' = M.insert mn (ss, nullImports, members) env

104+ let env' = M.insert mn (ss, primImports, members) env

105 (m', imps) <- resolveImports env' m

105 (m', imps) <- resolveImports env' m

106 exps <- maybe (return members) (resolveExports env' ss mn imps members) refs

106 exps <- maybe (return members) (resolveExports env' ss mn imps members) refs

107 return (m' : ms, M.insert mn (ss, imps, exps) env)

107 return (m' : ms, M.insert mn (ss, imps, exps) env)

@@ -110,8 +110,8 @@ desugarImportsWithEnv externs modules = do

110 renameInModule' env m@(Module _ _ mn _ _) =

110 renameInModule' env m@(Module _ _ mn _ _) =

111 warnAndRethrow (addHint (ErrorInModule mn)) $ do

111 warnAndRethrow (addHint (ErrorInModule mn)) $ do

112 let (_, imps, exps) = fromMaybe (internalError "Module is missing in renameInModule'") $ M.lookup mn env

112 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)

113+ (m', used) <- flip runStateT M.empty $ renameInModule imps (elaborateExports exps m)

114− lintImports m env used

114+ lintImports m' env used

115 return m'

115 return m'

116

116

117-- |

117-- |

@@ -147,11 +147,10 @@ elaborateExports exps (Module ss coms mn decls refs) =

147renameInModule

147renameInModule

148 :: forall m

148 :: forall m

149 . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadState UsedImports m)

149 . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadState UsedImports m)

150− => Env

151− -> Imports

150+ => Imports

152 -> Module

151 -> Module

153 -> m Module

152 -> m Module

154−renameInModule env imports (Module ss coms mn decls exps) =

153+renameInModule imports (Module ss coms mn decls exps) =

155 Module ss coms mn <$> parU decls go <*> pure exps

154 Module ss coms mn <$> parU decls go <*> pure exps

156 where

155 where

157

156

@@ -219,10 +218,9 @@ renameInModule env imports (Module ss coms mn decls exps) =

219 (,) s <$> (ConstructorBinder <$> updateDataConstructorName name pos <*> pure b)

218 (,) s <$> (ConstructorBinder <$> updateDataConstructorName name pos <*> pure b)

220 updateBinder s@(pos, _) (OpBinder op) =

219 updateBinder s@(pos, _) (OpBinder op) =

221 (,) s <$> (OpBinder <$> updateValueOpName op pos)

220 (,) s <$> (OpBinder <$> updateValueOpName op pos)

222− updateBinder s (TypedBinder t b) = do

221+ updateBinder s@(pos, _) (TypedBinder t b) = do

223− (s'@ (span', _), b') <- updateBinder s b

224− t' <- updateTypesEverywhere span' t

222+ t' <- updateTypesEverywhere pos t

225− return (s', TypedBinder t' b')

223+ return (s, TypedBinder t' b)

226 updateBinder s v =

224 updateBinder s v =

227 return (s, v)

225 return (s, v)

228

226

@@ -244,82 +242,51 @@ renameInModule env imports (Module ss coms mn decls exps) =

244 updateType :: Type -> m Type

242 updateType :: Type -> m Type

245 updateType (TypeOp name) = TypeOp <$> updateTypeOpName name pos

243 updateType (TypeOp name) = TypeOp <$> updateTypeOpName name pos

246 updateType (TypeConstructor name) = TypeConstructor <$> updateTypeName name pos

244 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

248 updateType t = return t

246 updateType t = return t

247+ updateInConstraint :: Constraint -> m Constraint

248+ updateInConstraint (Constraint name ts info) =

249+ Constraint <$> updateClassName name pos <*> pure ts <*> pure info

249

250

250 updateConstraints :: Maybe SourceSpan -> [Constraint] -> m [Constraint]

251 updateConstraints :: Maybe SourceSpan -> [Constraint] -> m [Constraint]

251− updateConstraints pos = traverse (\(Constraint name ts info) ->

252+ updateConstraints pos = traverse $ \(Constraint name ts info) ->

253+ Constraint

252− Constraint <$> updateClassName name pos

254+ <$> updateClassName name pos

253− <*> traverse (updateTypesEverywhere pos) ts

255+ <*> traverse (updateTypesEverywhere pos) ts

254− <*> pure info)

256+ <*> pure info

255

257

256 updateTypeName

258 updateTypeName

257 :: Qualified (ProperName 'TypeName)

259 :: Qualified (ProperName 'TypeName)

258 -> Maybe SourceSpan

260 -> Maybe SourceSpan

259 -> m (Qualified (ProperName 'TypeName))

261 -> m (Qualified (ProperName 'TypeName))

260− updateTypeName =

261− update (importedTypes imports) (resolveType . exportedTypes) TyName

262+ updateTypeName = update (importedTypes imports) TyName

262

263

263 updateTypeOpName

264 updateTypeOpName

264 :: Qualified (OpName 'TypeOpName)

265 :: Qualified (OpName 'TypeOpName)

265 -> Maybe SourceSpan

266 -> Maybe SourceSpan

266 -> m (Qualified (OpName 'TypeOpName))

267 -> m (Qualified (OpName 'TypeOpName))

267− updateTypeOpName =

268− update (importedTypeOps imports) (resolve . exportedTypeOps) TyOpName

268+ updateTypeOpName = update (importedTypeOps imports) TyOpName

269

269

270 updateDataConstructorName

270 updateDataConstructorName

271 :: Qualified (ProperName 'ConstructorName)

271 :: Qualified (ProperName 'ConstructorName)

272 -> Maybe SourceSpan

272 -> Maybe SourceSpan

273 -> m (Qualified (ProperName 'ConstructorName))

273 -> m (Qualified (ProperName 'ConstructorName))

274− updateDataConstructorName =

275− update

276− (importedDataConstructors imports)

274+ updateDataConstructorName = update (importedDataConstructors imports) DctorName

277− (resolveDctor . exportedTypes)

278− DctorName

279

275

280 updateClassName

276 updateClassName

281 :: Qualified (ProperName 'ClassName)

277 :: Qualified (ProperName 'ClassName)

282 -> Maybe SourceSpan

278 -> Maybe SourceSpan

283 -> m (Qualified (ProperName 'ClassName))

279 -> m (Qualified (ProperName 'ClassName))

284− updateClassName =

285− update

286− (importedTypeClasses imports)

280+ updateClassName = update (importedTypeClasses imports) TyClassName

287− (resolve . exportedTypeClasses)

288− TyClassName

289

281

290 updateValueName :: Qualified Ident -> Maybe SourceSpan -> m (Qualified Ident)

282 updateValueName :: Qualified Ident -> Maybe SourceSpan -> m (Qualified Ident)

291− updateValueName =

292− update (importedValues imports) (resolve . exportedValues) IdentName

283+ updateValueName = update (importedValues imports) IdentName

293

284

294 updateValueOpName

285 updateValueOpName

295 :: Qualified (OpName 'ValueOpName)

286 :: Qualified (OpName 'ValueOpName)

296 -> Maybe SourceSpan

287 -> Maybe SourceSpan

297 -> m (Qualified (OpName 'ValueOpName))

288 -> m (Qualified (OpName 'ValueOpName))

298− updateValueOpName =

299− update (importedValueOps imports) (resolve . exportedValueOps) ValOpName

289+ updateValueOpName = update (importedValueOps imports) 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

323

290

324 -- Update names so unqualified references become qualified, and locally

291 -- Update names so unqualified references become qualified, and locally

325 -- qualified references are replaced with their canoncial qualified names

292 -- qualified references are replaced with their canoncial qualified names

@@ -327,12 +294,11 @@ renameInModule env imports (Module ss coms mn decls exps) =

327 update

294 update

328 :: (Ord a, Show a)

295 :: (Ord a, Show a)

329 => M.Map (Qualified a) [ImportRecord a]

296 => M.Map (Qualified a) [ImportRecord a]

330− -> (Exports -> a -> Maybe (Qualified a))

331 -> (a -> Name)

297 -> (a -> Name)

332 -> Qualified a

298 -> Qualified a

333 -> Maybe SourceSpan

299 -> Maybe SourceSpan

334 -> m (Qualified a)

300 -> m (Qualified a)

335− update imps getE toName qname@(Qualified mn' name) pos = positioned $

301+ update imps toName qname@(Qualified mn' name) pos = positioned $

336 case (M.lookup qname imps, mn') of

302 case (M.lookup qname imps, mn') of

337

303

338 -- We found the name in our imports, so we return the name for it,

304 -- 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) =

354 -- by qualified importing). If that's not the case, then we just need to

320 -- by qualified importing). If that's not the case, then we just need to

355 -- check it refers to a symbol in another module.

321 -- check it refers to a symbol in another module.

356 (Nothing, Just mn'') ->

322 (Nothing, Just mn'') ->

357− case M.lookup mn'' env of

323+ if mn'' `S.member` importedQualModules imports || mn'' `S.member` importedModules imports

358− Nothing

324+ then throwUnknown

359− | mn'' `S.member` importedVirtualModules imports -> throwUnknown

360− | otherwise ->

361− throwError . errorMessage .

362− UnknownName . Qualified Nothing $ ModName mn''

325+ else throwError . errorMessage . UnknownName . Qualified Nothing $ ModName mn''

363− Just env' -> maybe throwUnknown return (getE (envModuleExports env') name)

364

326

365 -- If neither of the above cases are true then it's an undefined or

327 -- If neither of the above cases are true then it's an undefined or

366 -- unimported symbol.

328 -- unimported symbol.

src/Language/PureScript/Sugar/Names/Common.hs+3−1

@@ -43,15 +43,17 @@ warnDuplicateRefs pos toError refs = do

43 -- referenced type is used in the duplicate check - constructors are handled

43 -- referenced type is used in the duplicate check - constructors are handled

44 -- separately

44 -- separately

45 deleteCtors :: DeclarationRef -> DeclarationRef

45 deleteCtors :: DeclarationRef -> DeclarationRef

46+ deleteCtors (PositionedDeclarationRef ss com ref) =

47+ PositionedDeclarationRef ss com (deleteCtors ref)

46 deleteCtors (TypeRef pn _) = TypeRef pn Nothing

48 deleteCtors (TypeRef pn _) = TypeRef pn Nothing

47 deleteCtors other = other

49 deleteCtors other = other

48

50

49 -- Extracts the names of duplicate constructor references from TypeRefs.

51 -- Extracts the names of duplicate constructor references from TypeRefs.

50 extractCtors :: SourceSpan -> DeclarationRef -> Maybe [(SourceSpan, Name)]

52 extractCtors :: SourceSpan -> DeclarationRef -> Maybe [(SourceSpan, Name)]

53+ extractCtors _ (PositionedDeclarationRef pos' _ ref) = extractCtors pos' ref

51 extractCtors pos' (TypeRef _ (Just dctors)) =

54 extractCtors pos' (TypeRef _ (Just dctors)) =

52 let dupes = dctors \\ nub dctors

55 let dupes = dctors \\ nub dctors

53 in if null dupes then Nothing else Just $ ((pos',) . DctorName) <$> dupes

56 in if null dupes then Nothing else Just $ ((pos',) . DctorName) <$> dupes

54− extractCtors _ (PositionedDeclarationRef pos' _ ref) = extractCtors pos' ref

55 extractCtors _ _ = Nothing

57 extractCtors _ _ = Nothing

56

58

57 -- Converts a DeclarationRef into a name for an error message.

59 -- 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

2 ( ImportRecord(..)

2 ( ImportRecord(..)

3 , ImportProvenance(..)

3 , ImportProvenance(..)

4 , Imports(..)

4 , Imports(..)

5− , nullImports

5+ , primImports

6 , Exports(..)

6 , Exports(..)

7 , nullExports

7 , nullExports

8 , Env

8 , Env

@@ -58,6 +58,7 @@ data ImportProvenance

58 = FromImplicit

58 = FromImplicit

59 | FromExplicit

59 | FromExplicit

60 | Local

60 | Local

61+ | Prim

61 deriving (Eq, Ord, Show, Read)

62 deriving (Eq, Ord, Show, Read)

62

63

63type ImportMap a = M.Map (Qualified a) [ImportRecord a]

64type ImportMap a = M.Map (Qualified a) [ImportRecord a]

@@ -98,18 +99,33 @@ data Imports = Imports

98 --

99 --

99 , importedModules :: S.Set ModuleName

100 , importedModules :: S.Set ModuleName

100 -- |

101 -- |

101− -- The names of "virtual" modules that come into existence when "import as"

102+ -- The "as" names of modules that have been imported qualified.

102− -- is used.

103 --

103 --

104− , importedVirtualModules :: S.Set ModuleName

104+ , importedQualModules :: S.Set ModuleName

105 } deriving (Show, Read)

105 } deriving (Show, Read)

106

106

107−-- |

108−-- An empty 'Imports' value.

109−--

110nullImports :: Imports

107nullImports :: Imports

111nullImports = Imports M.empty M.empty M.empty M.empty M.empty M.empty S.empty S.empty

108nullImports = Imports M.empty M.empty M.empty M.empty M.empty M.empty S.empty S.empty

112

109

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+

113-- |

129-- |

114-- The exported declarations from a module.

130-- The exported declarations from a module.

115--

131--

@@ -186,7 +202,7 @@ primExports =

186-- | Environment which only contains the Prim module.

202-- | Environment which only contains the Prim module.

187primEnv :: Env

203primEnv :: Env

188primEnv = M.singleton

204primEnv = M.singleton

189− (ModuleName [ProperName "Prim"])

205+ primModuleName

190 (internalModuleSourceSpan "<Prim>", nullImports, primExports)

206 (internalModuleSourceSpan "<Prim>", nullImports, primExports)

191

207

192-- |

208-- |

@@ -203,9 +219,8 @@ exportType

203exportType exps name dctors mn = do

219exportType exps name dctors mn = do

204 let exTypes = exportedTypes exps

220 let exTypes = exportedTypes exps

205 let exClasses = exportedTypeClasses exps

221 let exClasses = exportedTypeClasses exps

206− case name `M.lookup` exTypes of

222+ forM_ (name `M.lookup` exTypes) $ \(_, mn') ->

207− Just (_, mn') | mn /= mn' -> throwConflictError ConflictingTypeDecls name

223+ when (mn /= mn') $ throwConflictError ConflictingTypeDecls name

208− _ -> return ()

209 when (coerceProperName name `M.member` exClasses) $

224 when (coerceProperName name `M.member` exClasses) $

210 throwConflictError TypeConflictsWithClass name

225 throwConflictError TypeConflictsWithClass name

211 forM_ dctors $ \dctor -> do

226 forM_ dctors $ \dctor -> do

@@ -213,9 +228,11 @@ exportType exps name dctors mn = do

213 throwConflictError ConflictingCtorDecls dctor

228 throwConflictError ConflictingCtorDecls dctor

214 when (coerceProperName dctor `M.member` exClasses) $

229 when (coerceProperName dctor `M.member` exClasses) $

215 throwConflictError CtorConflictsWithClass dctor

230 throwConflictError CtorConflictsWithClass dctor

216− return $ exps { exportedTypes = M.insert name (dctors, mn) exTypes }

231+ return $ exps { exportedTypes = M.alter updateOrInsert name exTypes }

217 where

232 where

218 dctorExists dctor (dctors', mn') = mn /= mn' && elem dctor dctors'

233 dctorExists dctor (dctors', mn') = mn /= mn' && elem dctor dctors'

234+ updateOrInsert Nothing = Just (dctors, mn)

235+ updateOrInsert (Just (dctors', _)) = Just (dctors ++ dctors', mn)

219

236

220-- |

237-- |

221-- Safely adds a type operator to some exports, returning an error if a

238-- 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

9import Control.Monad.Writer.Class (MonadWriter(..))

9import Control.Monad.Writer.Class (MonadWriter(..))

10import Control.Monad.Error.Class (MonadError(..))

10import Control.Monad.Error.Class (MonadError(..))

11

11

12+import Data.Function (on)

12import Data.Foldable (traverse_)

13import Data.Foldable (traverse_)

13−import Data.List (intersect)

14+import Data.List (intersect, groupBy, sortBy)

14import Data.Maybe (fromMaybe, mapMaybe)

15import Data.Maybe (fromMaybe, mapMaybe)

15import qualified Data.Map as M

16import qualified Data.Map as M

16

17

@@ -224,7 +225,7 @@ filterModule

224 -> [DeclarationRef]

225 -> [DeclarationRef]

225 -> m Exports

226 -> m Exports

226filterModule mn exps refs = do

227filterModule mn exps refs = do

227− types <- foldM filterTypes M.empty refs

228+ types <- foldM filterTypes M.empty (combineTypeRefs refs)

228 typeOps <- foldM (filterExport TyOpName getTypeOpRef exportedTypeOps) M.empty refs

229 typeOps <- foldM (filterExport TyOpName getTypeOpRef exportedTypeOps) M.empty refs

229 classes <- foldM (filterExport TyClassName getTypeClassRef exportedTypeClasses) M.empty refs

230 classes <- foldM (filterExport TyClassName getTypeClassRef exportedTypeClasses) M.empty refs

230 values <- foldM (filterExport IdentName getValueRef exportedValues) M.empty refs

231 values <- foldM (filterExport IdentName getValueRef exportedValues) M.empty refs

@@ -239,6 +240,18 @@ filterModule mn exps refs = do

239

240

240 where

241 where

241

242

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+

242 filterTypes

255 filterTypes

243 :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ModuleName)

256 :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ModuleName)

244 -> DeclarationRef

257 -> DeclarationRef

src/Language/PureScript/Sugar/Names/Imports.hs+5−4

@@ -53,7 +53,7 @@ resolveImports env (Module ss coms currentModule decls exps) =

53 imports' = M.map (map (\(ss', dt, mmn) -> (ss', Just dt, mmn))) imports

53 imports' = M.map (map (\(ss', dt, mmn) -> (ss', Just dt, mmn))) imports

54 scope = M.insert currentModule [(Nothing, Nothing, Nothing)] imports'

54 scope = M.insert currentModule [(Nothing, Nothing, Nothing)] imports'

55 (Module ss coms currentModule decls exps,) <$>

55 (Module ss coms currentModule decls exps,) <$>

56− foldM (resolveModuleImport env) nullImports (M.toList scope)

56+ foldM (resolveModuleImport env) primImports (M.toList scope)

57

57

58-- | Constructs a set of imports for a single module import.

58-- | Constructs a set of imports for a single module import.

59resolveModuleImport

59resolveModuleImport

@@ -74,9 +74,10 @@ resolveModuleImport env ie (mn, imps) = foldM go ie imps

74 (throwError . errorMessage . UnknownName . Qualified Nothing $ ModName mn)

74 (throwError . errorMessage . UnknownName . Qualified Nothing $ ModName mn)

75 (return . envModuleExports)

75 (return . envModuleExports)

76 (mn `M.lookup` env)

76 (mn `M.lookup` env)

77− let virtualModules = importedVirtualModules ie'

77+ let impModules = importedModules ie'

78+ qualModules = importedQualModules ie'

78− ie'' = ie' { importedModules = S.insert mn (importedModules ie')

79+ ie'' = ie' { importedModules = maybe (S.insert mn impModules) (const impModules) impQual

79− , importedVirtualModules = maybe virtualModules (`S.insert` virtualModules) impQual

80+ , importedQualModules = maybe qualModules (`S.insert` qualModules) impQual

80 }

81 }

81 positioned $ resolveImport mn modExports ie'' impQual typ

82 positioned $ resolveImport mn modExports ie'' impQual typ

82 where

83 where

src/Language/PureScript/TypeChecker/Types.hs+8−3

@@ -26,6 +26,7 @@ module Language.PureScript.TypeChecker.Types

26

26

27import Prelude.Compat

27import Prelude.Compat

28

28

29+import Control.Arrow (second)

29import Control.Monad

30import Control.Monad

30import Control.Monad.Error.Class (MonadError(..))

31import Control.Monad.Error.Class (MonadError(..))

31import Control.Monad.State.Class (MonadState(..), gets)

32import Control.Monad.State.Class (MonadState(..), gets)

@@ -118,8 +119,9 @@ typesOf bindingGroupType moduleName vals = do

118 -- Replace all the wildcards types with their inferred types

119 -- Replace all the wildcards types with their inferred types

119 replace sub (ErrorMessage hints (WildcardInferredType ty)) =

120 replace sub (ErrorMessage hints (WildcardInferredType ty)) =

120 ErrorMessage hints . WildcardInferredType $ substituteType sub ty

121 ErrorMessage hints . WildcardInferredType $ substituteType sub ty

121− replace sub (ErrorMessage hints (HoleInferredType name ty)) =

122+ replace sub (ErrorMessage hints (HoleInferredType name ty env)) =

122− ErrorMessage hints . HoleInferredType name $ substituteType sub ty

123+ ErrorMessage hints $ HoleInferredType name (substituteType sub ty)

124+ (map (second (substituteType sub)) env)

123 replace _ em = em

125 replace _ em = em

124

126

125 isHoleError :: ErrorMessage -> Bool

127 isHoleError :: ErrorMessage -> Bool

@@ -324,7 +326,10 @@ infer' (TypedValue checkType val ty) = do

324 return $ TypedValue True val' ty'

326 return $ TypedValue True val' ty'

325infer' (Hole name) = do

327infer' (Hole name) = do

326 ty <- freshType

328 ty <- freshType

329+ env <- M.toList . names <$> getEnv

330+ Just moduleName <- checkCurrentModule <$> get

331+ let ctx = [ (ident, ty') | ((mn, ident@Ident{}), (ty', _, Defined)) <- env, mn == moduleName ]

327− tell . errorMessage $ HoleInferredType name ty

332+ tell . errorMessage $ HoleInferredType name ty ctx

328 return $ TypedValue True (Hole name) ty

333 return $ TypedValue True (Hole name) ty

329infer' (PositionedValue pos c val) = warnAndRethrowWithPosition pos $ do

334infer' (PositionedValue pos c val) = warnAndRethrowWithPosition pos $ do

330 TypedValue t v ty <- infer' val

335 TypedValue t v ty <- infer' val

tests/Language/PureScript/Ide/Integration.hs+17−9

@@ -33,6 +33,7 @@ module Language.PureScript.Ide.Integration

33 , loadModuleWithDeps

33 , loadModuleWithDeps

34 , getCwd

34 , getCwd

35 , getFlexCompletions

35 , getFlexCompletions

36+ , getFlexCompletionsInModule

36 , getType

37 , getType

37 , rebuildModule

38 , rebuildModule

38 , reset

39 , reset

@@ -49,7 +50,7 @@ import Data.Aeson

49import Data.Aeson.Types

50import Data.Aeson.Types

50import qualified Data.ByteString.Lazy.UTF8 as BSL

51import qualified Data.ByteString.Lazy.UTF8 as BSL

51import Data.Either (isRight)

52import Data.Either (isRight)

52−import Data.Maybe (fromJust, isNothing)

53+import Data.Maybe (fromJust, isNothing, fromMaybe)

53import qualified Data.Text as T

54import qualified Data.Text as T

54import qualified Data.Vector as V

55import qualified Data.Vector as V

55import Language.PureScript.Ide.Util

56import Language.PureScript.Ide.Util

@@ -95,11 +96,12 @@ compileTestProject :: IO Bool

95compileTestProject = do

96compileTestProject = do

96 pdir <- projectDirectory

97 pdir <- projectDirectory

97 (_, _, _, procHandle) <- createProcess $

98 (_, _, _, procHandle) <- createProcess $

98− (shell $ "psc " ++ fileGlob) {cwd=Just pdir

99+ (shell $ "psc " ++ fileGlob) { cwd = Just pdir

99− ,std_out=CreatePipe

100+ , std_out = CreatePipe

100− ,std_err=CreatePipe

101+ , std_err = CreatePipe

101 }

102 }

102− isSuccess <$> waitForProcess procHandle

103+ r <- tryNTimes 5 (getProcessExitCode procHandle)

104+ pure (fromMaybe False (isSuccess <$> r))

103

105

104tryNTimes :: Int -> IO (Maybe a) -> IO (Maybe a)

106tryNTimes :: Int -> IO (Maybe a) -> IO (Maybe a)

105tryNTimes 0 _ = pure Nothing

107tryNTimes 0 _ = pure Nothing

@@ -166,7 +168,10 @@ loadModule :: String -> IO String

166loadModule m = sendCommand $ load [m] []

168loadModule m = sendCommand $ load [m] []

167

169

168getFlexCompletions :: String -> IO [(String, String, String)]

170getFlexCompletions :: 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))

170

175

171getType :: String -> IO [(String, String, String)]

176getType :: String -> IO [(String, String, String)]

172getType q = parseCompletions <$> sendCommand (typeC q [])

177getType q = parseCompletions <$> sendCommand (typeC q [])

@@ -217,14 +222,17 @@ addImportW importCommand fp outfp =

217 ])

222 ])

218

223

219

224

220−completion :: [Value] -> Maybe Value -> Value

225+completion :: [Value] -> Maybe Value -> Maybe String -> Value

221−completion filters matcher =

226+completion filters matcher currentModule =

222 let

227 let

223 matcher' = case matcher of

228 matcher' = case matcher of

224 Nothing -> []

229 Nothing -> []

225 Just m -> ["matcher" .= m]

230 Just m -> ["matcher" .= m]

231+ currentModule' = case currentModule of

232+ Nothing -> []

233+ Just cm -> ["currentModule" .= cm]

226 in

234 in

227− commandWrapper "complete" (object $ "filters" .= filters : matcher')

235+ commandWrapper "complete" (object $ "filters" .= filters : matcher' ++ currentModule' )

228

236

229flexMatcher :: String -> Value

237flexMatcher :: String -> Value

230flexMatcher q = object [ "matcher" .= ("flex" :: String)

238flexMatcher q = object [ "matcher" .= ("flex" :: String)

tests/Language/PureScript/Ide/RebuildSpec.hs+7−1

@@ -11,7 +11,7 @@ shouldBeFailure :: String -> IO ()

11shouldBeFailure = shouldBe False . Integration.resultIsSuccess

11shouldBeFailure = shouldBe False . Integration.resultIsSuccess

12

12

13spec :: Spec

13spec :: Spec

14−spec = before_ Integration.reset $ describe "Rebuilding single modules" $ do

14+spec = before_ Integration.reset . describe "Rebuilding single modules" $ do

15 it "rebuilds a correct module without dependencies successfully" $ do

15 it "rebuilds a correct module without dependencies successfully" $ do

16 _ <- Integration.loadModuleWithDeps "RebuildSpecSingleModule"

16 _ <- Integration.loadModuleWithDeps "RebuildSpecSingleModule"

17 pdir <- Integration.projectDirectory

17 pdir <- Integration.projectDirectory

@@ -45,3 +45,9 @@ spec = before_ Integration.reset $ describe "Rebuilding single modules" $ do

45 pdir <- Integration.projectDirectory

45 pdir <- Integration.projectDirectory

46 let file = pdir </> "src" </> "RebuildSpecWithMissingForeign.fail"

46 let file = pdir </> "src" </> "RebuildSpecWithMissingForeign.fail"

47 Integration.rebuildModule file >>= shouldBeFailure

47 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

11import Test.Hspec

11import Test.Hspec

12

12

13testState :: PscIdeState

13testState :: 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

15

15

16defaultConfig :: Configuration

16defaultConfig :: Configuration

17defaultConfig =

17defaultConfig =

tests/TestCompiler.hs+65−30

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

27

27

28import Data.Char (isSpace)

28import Data.Char (isSpace)

29import Data.Function (on)

29import Data.Function (on)

30−import Data.List (sort, stripPrefix, intercalate, groupBy, sortBy)

30+import Data.List (sort, stripPrefix, intercalate, groupBy, sortBy, minimumBy)

31import Data.Maybe (mapMaybe)

31import Data.Maybe (mapMaybe)

32import Data.Time.Clock (UTCTime())

32import Data.Time.Clock (UTCTime())

33import Data.Tuple (swap)

33import Data.Tuple (swap)

@@ -58,31 +58,40 @@ main = hspec spec

58spec :: Spec

58spec :: Spec

59spec = do

59spec = do

60

60

61− (supportExterns, passingTestCases, failingTestCases) <- runIO $ do

61+ (supportExterns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do

62 cwd <- getCurrentDirectory

62 cwd <- getCurrentDirectory

63 let passing = cwd </> "examples" </> "passing"

63 let passing = cwd </> "examples" </> "passing"

64+ let warning = cwd </> "examples" </> "warning"

64 let failing = cwd </> "examples" </> "failing"

65 let failing = cwd </> "examples" </> "failing"

65 let supportDir = cwd </> "tests" </> "support" </> "bower_components"

66 let supportDir = cwd </> "tests" </> "support" </> "bower_components"

66 let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/**/*." ++ ext)) supportDir

67 let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/**/*." ++ ext)) supportDir

67 passingFiles <- getTestFiles passing <$> testGlob passing

68 passingFiles <- getTestFiles passing <$> testGlob passing

69+ warningFiles <- getTestFiles warning <$> testGlob warning

68 failingFiles <- getTestFiles failing <$> testGlob failing

70 failingFiles <- getTestFiles failing <$> testGlob failing

69 supportPurs <- supportFiles "purs"

71 supportPurs <- supportFiles "purs"

70 supportPursFiles <- readInput supportPurs

72 supportPursFiles <- readInput supportPurs

71 supportExterns <- runExceptT $ do

73 supportExterns <- runExceptT $ do

72 modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles

74 modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles

73 foreigns <- inferForeignModules modules

75 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)

75 return (zip (map snd modules) externs)

77 return (zip (map snd modules) externs)

76 case supportExterns of

78 case supportExterns of

77 Left errs -> fail (P.prettyPrintMultipleErrors False errs)

79 Left errs -> fail (P.prettyPrintMultipleErrors False errs)

78− Right externs -> return (externs, passingFiles, failingFiles)

80+ Right externs -> return (externs, passingFiles, warningFiles, failingFiles)

79

81

80− context ("Passing examples") $ do

82+ context "Passing examples" $

81 forM_ passingTestCases $ \testPurs ->

83 forM_ passingTestCases $ \testPurs ->

82 it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $

84 it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $

83 assertCompiles supportExterns testPurs

85 assertCompiles supportExterns testPurs

84

86

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+

85− context ("Failing examples") $ do

94+ context "Failing examples" $

86 forM_ failingTestCases $ \testPurs -> do

95 forM_ failingTestCases $ \testPurs -> do

87 let mainPath = getTestMain testPurs

96 let mainPath = getTestMain testPurs

88 expectedFailures <- runIO $ getShouldFailWith mainPath

97 expectedFailures <- runIO $ getShouldFailWith mainPath

@@ -100,8 +109,7 @@ spec = do

100 -- .purs files and the .js files for the test case.

109 -- .purs files and the .js files for the test case.

101 getTestFiles :: FilePath -> [FilePath] -> [[FilePath]]

110 getTestFiles :: FilePath -> [FilePath] -> [[FilePath]]

102 getTestFiles baseDir

111 getTestFiles baseDir

103− = map (filter ((== ".purs") . takeExtensions))

112+ = map (filter ((== ".purs") . takeExtensions) . map (baseDir </>))

104− . map (map (baseDir </>))

105 . groupBy ((==) `on` extractPrefix)

113 . groupBy ((==) `on` extractPrefix)

106 . sortBy (compare `on` extractPrefix)

114 . sortBy (compare `on` extractPrefix)

107 . map (makeRelative baseDir)

115 . map (makeRelative baseDir)

@@ -110,7 +118,7 @@ spec = do

110 -- by the file with the shortest path name, as everything but the main file

118 -- by the file with the shortest path name, as everything but the main file

111 -- will be under a subdirectory.

119 -- will be under a subdirectory.

112 getTestMain :: [FilePath] -> FilePath

120 getTestMain :: [FilePath] -> FilePath

113− getTestMain = head . sortBy (compare `on` length)

121+ getTestMain = minimumBy (compare `on` length)

114

122

115 -- Extracts the filename part of a .purs file, or if the file is in a

123 -- Extracts the filename part of a .purs file, or if the file is in a

116 -- subdirectory, the first part of that directory path.

124 -- subdirectory, the first part of that directory path.

@@ -125,9 +133,17 @@ spec = do

125 -- Scans a file for @shouldFailWith directives in the comments, used to

133 -- Scans a file for @shouldFailWith directives in the comments, used to

126 -- determine expected failures

134 -- determine expected failures

127 getShouldFailWith :: FilePath -> IO [String]

135 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

129 where

145 where

130− extractFailWiths = lines >>> mapMaybe (stripPrefix "-- @shouldFailWith ") >>> map trim

146+ go = lines >>> mapMaybe (stripPrefix ("-- @" ++ pragma ++ " ")) >>> map trim

131

147

132inferForeignModules

148inferForeignModules

133 :: MonadIO m

149 :: MonadIO m

@@ -168,16 +184,14 @@ readInput inputFiles = forM inputFiles $ \inputFile -> do

168 text <- readUTF8File inputFile

184 text <- readUTF8File inputFile

169 return (inputFile, text)

185 return (inputFile, text)

170

186

171−type TestM = WriterT [(FilePath, String)] IO

172−

173−runTest :: P.Make a -> IO (Either P.MultipleErrors a)

187+runTest :: P.Make a -> IO (Either P.MultipleErrors a, P.MultipleErrors)

174−runTest = fmap fst . P.runMake P.defaultOptions

188+runTest = P.runMake P.defaultOptions

175

189

176compile

190compile

177 :: [(P.Module, P.ExternsFile)]

191 :: [(P.Module, P.ExternsFile)]

178 -> [FilePath]

192 -> [FilePath]

179 -> ([P.Module] -> IO ())

193 -> ([P.Module] -> IO ())

180− -> IO (Either P.MultipleErrors [P.ExternsFile])

194+ -> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)

181compile supportExterns inputFiles check = silence $ runTest $ do

195compile supportExterns inputFiles check = silence $ runTest $ do

182 fs <- liftIO $ readInput inputFiles

196 fs <- liftIO $ readInput inputFiles

183 ms <- P.parseModulesFromFiles id fs

197 ms <- P.parseModulesFromFiles id fs

@@ -192,18 +206,30 @@ assert

192 :: [(P.Module, P.ExternsFile)]

206 :: [(P.Module, P.ExternsFile)]

193 -> [FilePath]

207 -> [FilePath]

194 -> ([P.Module] -> IO ())

208 -> ([P.Module] -> IO ())

195− -> (Either P.MultipleErrors [P.ExternsFile] -> IO (Maybe String))

209+ -> (Either P.MultipleErrors P.MultipleErrors -> IO (Maybe String))

196 -> Expectation

210 -> Expectation

197assert supportExterns inputFiles check f = do

211assert supportExterns inputFiles check f = do

198− e <- compile supportExterns inputFiles check

212+ (e, w) <- compile supportExterns inputFiles check

199− maybeErr <- f e

213+ maybeErr <- f (const w <$> e)

200 maybe (return ()) expectationFailure maybeErr

214 maybe (return ()) expectationFailure maybeErr

201

215

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+

202assertCompiles

228assertCompiles

203 :: [(P.Module, P.ExternsFile)]

229 :: [(P.Module, P.ExternsFile)]

204 -> [FilePath]

230 -> [FilePath]

205 -> Expectation

231 -> Expectation

206−assertCompiles supportExterns inputFiles = do

232+assertCompiles supportExterns inputFiles =

207 assert supportExterns inputFiles checkMain $ \e ->

233 assert supportExterns inputFiles checkMain $ \e ->

208 case e of

234 case e of

209 Left errs -> return . Just . P.prettyPrintMultipleErrors False $ errs

235 Left errs -> return . Just . P.prettyPrintMultipleErrors False $ errs

@@ -219,17 +245,32 @@ assertCompiles supportExterns inputFiles = do

219 | otherwise -> return $ Just $ "Test did not finish with 'Done':\n\n" <> out

245 | otherwise -> return $ Just $ "Test did not finish with 'Done':\n\n" <> out

220 Just (ExitFailure _, _, err) -> return $ Just err

246 Just (ExitFailure _, _, err) -> return $ Just err

221 Nothing -> return $ Just "Couldn't find node.js executable"

247 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+

222 where

264 where

223− checkMain ms =

265+ printAllWarnings warnings =

224− unless (any ((== P.moduleNameFromString "Main") . P.getModuleName) ms)

266+ (<> "\n\n" <> P.prettyPrintMultipleErrors False warnings)

225− (fail "Main module missing")

226

267

227assertDoesNotCompile

268assertDoesNotCompile

228 :: [(P.Module, P.ExternsFile)]

269 :: [(P.Module, P.ExternsFile)]

229 -> [FilePath]

270 -> [FilePath]

230 -> [String]

271 -> [String]

231 -> Expectation

272 -> Expectation

232−assertDoesNotCompile supportExterns inputFiles shouldFailWith = do

273+assertDoesNotCompile supportExterns inputFiles shouldFailWith =

233 assert supportExterns inputFiles noPreCheck $ \e ->

274 assert supportExterns inputFiles noPreCheck $ \e ->

234 case e of

275 case e of

235 Left errs ->

276 Left errs ->

@@ -243,9 +284,3 @@ assertDoesNotCompile supportExterns inputFiles shouldFailWith = do

243

284

244 where

285 where

245 noPreCheck = const (return ())

286 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 @@

7 "purescript-functions": "1.0.0-rc.1",

7 "purescript-functions": "1.0.0-rc.1",

8 "purescript-prelude": "1.0.0-rc.3",

8 "purescript-prelude": "1.0.0-rc.3",

9 "purescript-st": "1.0.0-rc.1",

9 "purescript-st": "1.0.0-rc.1",

10− "purescript-partial": "1.1.1"

10+ "purescript-partial": "1.1.2"

11 }

11 }

12}

12}

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