packages feed

purescript 0.7.1.0 → 0.7.2.0

raw patch · 233 files changed

+3514/−1381 lines, 233 filesdep ~Globdep ~aeson-better-errorsdep ~bower-json

Dependency ranges changed: Glob, aeson-better-errors, bower-json, boxes, directory, mtl, optparse-applicative, pattern-arrows, process, safe, semigroups, transformers, transformers-compat

Files

examples/failing/365.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith CycleInDeclaration module Main where  import Prelude
examples/failing/438.purs view
@@ -1,3 +1,8 @@+-- @shouldFailWith NoInstanceFound++-- See issue 438 for details: this test is mainly here to test that code like+-- this doesn't cause the compiler to loop.+ module Main where  import Prelude@@ -5,7 +10,6 @@ data Fix f = In (f (Fix f))  instance eqFix :: (Eq (f (Fix f))) => Eq (Fix f) where-  (==) (In f) (In g) = f == g-  (/=) a b = not (a == b)+  eq (In f) (In g) = f == g  example = In [] == In []
examples/failing/ArrayType.purs view
@@ -1,7 +1,9 @@+-- @shouldFailWith TypesDoNotUnify+ module Main where  import Prelude-import Debug.Trace+import Control.Monad.Eff.Console  bar :: Number -> Number -> Number bar n m = n + m
examples/failing/Arrays.purs view
@@ -1,5 +1,8 @@+-- @shouldFailWith ExprDoesNotHaveType module Main where  import Prelude++foreign import (!!) :: forall a. Array a -> Int -> a  test = \arr -> arr !! (0 !! 0)
examples/failing/CaseDoesNotMatchAllConstructorArgs.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith IncorrectConstructorArity module Main where  import Prelude
examples/failing/Do.purs view
@@ -1,3 +1,5 @@+-- @shouldFailWith InvalidDoBind+-- @shouldFailWith InvalidDoLet module Main where  import Prelude
+ examples/failing/DoNotSuggestComposition.purs view
@@ -0,0 +1,13 @@+-- @shouldFailWith TypesDoNotUnify+-- TODO: Check that this does not produce a "function composition is (<<<)"+-- suggestion.+module DoNotSuggestComposition where++import Prelude++x = { y: 3 }++foo :: String -> String+foo y = y++bar = foo x
+ examples/failing/DoNotSuggestComposition2.purs view
@@ -0,0 +1,7 @@+-- @shouldFailWith CannotApplyFunction+-- TODO: Check that this does not produce a "function composition is (<<<)"+-- suggestion.++module DoNotSuggestComposition2 where++foo = let x = { y: 3 } in x 2
examples/failing/DuplicateDeclarationsInLet.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith OverlappingNamesInLet module Main where  import Prelude
examples/failing/DuplicateProperties1.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith TypesDoNotUnify module DuplicateProperties where  import Prelude
examples/failing/DuplicateProperties2.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith DuplicateLabel module DuplicateProperties where  import Prelude
examples/failing/DuplicateTypeVars.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith DuplicateTypeArgument module Main where  import Prelude
examples/failing/Eff.purs view
@@ -1,12 +1,13 @@+-- @shouldFailWith TypesDoNotUnify module Main where  import Prelude import Control.Monad.Eff import Control.Monad.ST-import Debug.Trace+import Control.Monad.Eff.Console  test = pureST (do          ref <- newSTRef 0-         trace "ST"+         log "ST"          modifySTRef ref $ \n -> n + 1          readSTRef ref)
+ examples/failing/ExtraRecordField.purs view
@@ -0,0 +1,10 @@+-- @shouldFailWith PropertyIsMissing+-- TODO: Make this fail with a new error ExtraProperty instead.+module ExtraRecordField where++import Prelude ((<>))++full :: { first :: String, last :: String } -> String+full p = p.first <> " " <> p.last++oops = full { first: "Jane", last: "Smith", age: 29 }
examples/failing/Foldable.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith CycleInDeclaration module Main where  import Prelude
examples/failing/InstanceExport.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith TransitiveExportError module InstanceExport (S(..), f) where  import Prelude@@ -13,5 +14,6 @@ module Test where  import InstanceExport+import Prelude  test = f $ S "Test"
examples/failing/KindError.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith KindsDoNotUnify module Main where  import Prelude
examples/failing/LeadingZeros1.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith ErrorParsingModule module Main where  import Prelude
examples/failing/LeadingZeros2.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith ErrorParsingModule module Main where  import Prelude
examples/failing/Let.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith CycleInDeclaration module Main where  import Prelude
examples/failing/MPTCs.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith KindsDoNotUnify module Main where  import Prelude
examples/failing/MissingClassExport.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith TransitiveExportError module Test (bar) where  import Prelude
examples/failing/MissingClassMemberExport.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith TransitiveExportError module Test (Foo) where  import Prelude
+ examples/failing/MissingRecordField.purs view
@@ -0,0 +1,11 @@+-- @shouldFailWith TypesDoNotUnify+-- TODO: Update type checker to make this fail with PropertyIsMissing instead. +module MissingRecordField where++import Prelude ((>))++john = { first: "John", last: "Smith" }++isOver50 p = p.age > 50.0++result = isOver50 john
examples/failing/MultipleErrors.purs view
@@ -1,11 +1,13 @@+-- @shouldFailWith ExprDoesNotHaveType+-- @shouldFailWith ExprDoesNotHaveType module MultipleErrors where  import Prelude -foo :: Number -> Number+foo :: Int -> Int foo 0 = "Test" foo n = bar (n - 1) -bar :: Number -> Number+bar :: Int -> Int bar 0 = "Test" bar n = foo (n - 1)
examples/failing/MultipleErrors2.purs view
@@ -1,3 +1,5 @@+-- @shouldFailWith UnknownValue+-- @shouldFailWith UnknownValue module MultipleErrors2 where  import Prelude
examples/failing/MutRec.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith CycleInDeclaration module MutRec where  import Prelude
examples/failing/MutRec2.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith CycleInDeclaration module Main where  import Prelude
examples/failing/NewtypeMultiArgs.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith InvalidNewtype module Main where  import Prelude
examples/failing/NewtypeMultiCtor.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith InvalidNewtype module Main where  import Prelude
− examples/failing/NoOverlap.purs 
@@ -1,13 +0,0 @@-module Main where--import Prelude--data Foo = Foo--instance showFoo1 :: Show Foo where-  show _ = "Foo"--instance showFoo2 :: Show Foo where-  show _ = "Bar"--test = show Foo
examples/failing/NullaryAbs.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith ErrorParsingModule module Main where  import Prelude
examples/failing/Object.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith PropertyIsMissing module Main where  import Prelude
examples/failing/OverlappingArguments.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith OverlappingArgNames module OverlappingArguments where  import Prelude
examples/failing/OverlappingBinders.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith OverlappingArgNames module OverlappingBinders where  import Prelude
examples/failing/OverlappingInstances.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith OverlappingInstances module OverlappingInstances where  import Prelude@@ -10,4 +11,4 @@ instance showA2 :: Show A where   show A = "Instance 2" -main = Debug.Trace.trace $ show A+main = Control.Monad.Eff.Console.log $ show A
examples/failing/OverlappingInstances2.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith OverlappingInstances module OverlappingInstances where  import Prelude@@ -5,14 +6,12 @@ data A = A | B  instance eqA1 :: Eq A where-  (==) A A = true-  (==) B B = true-  (==) _ _ = false-  (/=) x y = not (x == y)+  eq A A = true+  eq B B = true+  eq _ _ = false  instance eqA2 :: Eq A where-  (==) _ _ = true-  (/=) _ _ = false+  eq _ _ = true  instance ordA :: Ord A where   compare A B = LT@@ -22,4 +21,4 @@ test :: forall a. (Ord a) => a -> a -> String test x y = show $ x == y -main = Debug.Trace.trace $ test A B+main = Control.Monad.Eff.Console.log $ test A B
examples/failing/OverlappingVars.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith NoInstanceFound module Main where  import Prelude
examples/failing/Rank2Types.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith ExprDoesNotHaveType module Main where  import Prelude
examples/failing/Reserved.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith ErrorParsingModule module Main where  import Prelude
examples/failing/RowConstructors1.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith KindsDoNotUnify module Main where  import Prelude@@ -5,4 +6,4 @@ data Foo = Bar type Baz = { | Foo } -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/failing/RowConstructors2.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith KindsDoNotUnify module Main where  import Prelude@@ -5,4 +6,4 @@ type Foo r = (x :: Number | r) type Bar = { | Foo } -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/failing/RowConstructors3.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith KindsDoNotUnify module Main where  import Prelude@@ -5,4 +6,4 @@ type Foo = { x :: Number } type Bar = { | Foo } -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/failing/SkolemEscape.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith EscapedSkolem module Main where  import Prelude
examples/failing/SkolemEscape2.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith EscapedSkolem module Main where  import Prelude
+ examples/failing/SuggestComposition.purs view
@@ -0,0 +1,7 @@+-- @shouldFailWith TypesDoNotUnify+-- TODO: Ensure the correct suggestion is produced.+module SuggestComposition where++import Prelude++f = g . g where g = (+1)
examples/failing/Superclasses1.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith NoInstanceFound module Main where  import Prelude
examples/failing/Superclasses2.purs view
@@ -1,3 +1,5 @@+-- @shouldFailWith CycleInTypeSynonym+-- TODO: Should this have its own error, perhaps CycleInTypeClassDeclaration? module CycleInSuperclasses where  import Prelude
examples/failing/Superclasses3.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith UndefinedTypeVariable module UnknownSuperclassTypeVar where  import Prelude
examples/failing/Superclasses4.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith OverlappingInstances module OverlappingInstances where  import Prelude@@ -11,4 +12,4 @@ test :: forall a. (Foo a) => a -> a test a = a -test1 = test 0+test1 = test 0.0
examples/failing/TopLevelCaseNoArgs.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith DuplicateValueDeclaration module Main where  import Prelude
examples/failing/TypeClassInstances.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith MissingClassMember module Main where  import Prelude
examples/failing/TypeClasses2.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith NoInstanceFound module Main where  import Prelude ()
examples/failing/TypeError.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith ExprDoesNotHaveType module Main where  import Prelude
examples/failing/TypeSynonyms.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith CycleInTypeSynonym module Main where  import Prelude
examples/failing/TypeSynonyms2.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith TypeSynonymInstance module Main where  import Prelude
examples/failing/TypeSynonyms3.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith TypeSynonymInstance module Main where  import Prelude
examples/failing/TypeSynonyms4.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith PartiallyAppliedSynonym module TypeSynonyms4 where  import Prelude
examples/failing/TypeSynonyms5.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith CycleInTypeSynonym module Main where  import Prelude
examples/failing/TypeWildcards1.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith ErrorParsingModule module TypeWildcards where  import Prelude
examples/failing/TypeWildcards2.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith ErrorParsingModule module TypeWildcards where  import Prelude
examples/failing/TypeWildcards3.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith ErrorParsingModule module TypeWildcards where  import Prelude
examples/failing/UnderscoreModuleName.purs view
@@ -1,5 +1,6 @@+-- @shouldFailWith ErrorParsingModule module Bad_Module where  import Prelude -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/failing/UnifyInTypeInstanceLookup.purs view
@@ -1,3 +1,6 @@+-- @shouldFailWith NoInstanceFound+-- See issue #390.+-- TODO: Improve this error. module Main where  import Prelude
examples/failing/UnknownType.purs view
@@ -1,3 +1,4 @@+-- @shouldFailWith UnknownType module Main where  import Prelude
examples/passing/652.purs view
@@ -14,4 +14,4 @@  instance baz :: (Eq a) => Baz (a -> b) a b -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/810.purs view
@@ -10,4 +10,4 @@     o = case m of Nothing -> { x : Nothing }                   Just a  -> { x : Just a } -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Applicative.purs view
@@ -4,13 +4,13 @@  class Applicative f where   pure :: forall a. a -> f a-  (<*>) :: forall a b. f (a -> b) -> f a -> f b+  apply :: forall a b. f (a -> b) -> f a -> f b  data Maybe a = Nothing | Just a  instance applicativeMaybe :: Applicative Maybe where   pure = Just-  (<*>) (Just f) (Just a) = Just (f a)-  (<*>) _ _ = Nothing+  apply (Just f) (Just a) = Just (f a)+  apply _ _ = Nothing -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ArrayType.purs view
@@ -8,4 +8,4 @@ instance pointedArray :: Pointed Array where   point a = [a] -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Auto.purs view
@@ -12,4 +12,4 @@ run :: forall i o. SomeAuto i o -> i -> o run = \s i -> s (\a -> case a of Auto a -> a.step a.state i) -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/AutoPrelude.purs view
@@ -1,9 +1,9 @@ module Main where  import Prelude-import Debug.Trace+import Control.Monad.Eff.Console  f x = x * 10.0 g y = y - 10.0 -main = trace $ show $ (f <<< g) 100.0+main = log $ show $ (f <<< g) 100.0
examples/passing/AutoPrelude2.purs view
@@ -2,9 +2,9 @@  import Prelude import qualified Prelude as P-import Debug.Trace+import Control.Monad.Eff.Console  f :: forall a. a -> a f = P.id -main = P.($) trace ((f P.<<< f) "Done")+main = P.($) log ((f P.<<< f) "Done")
examples/passing/BindersInFunctions.purs view
@@ -1,12 +1,11 @@ module Main where  import Prelude-import Assert+import Test.Assert  snd = \[_, y] -> y -main =-  let ts = snd [1.0, 2.0] in-  if ts == 2.0-  then Debug.Trace.trace "Done"-  else error "Incorrect result from 'snd'."+main = do+  let ts = snd [1.0, 2.0]+  assert' "Incorrect result from 'snd'." (ts == 2.0)+  Control.Monad.Eff.Console.log "Done"
examples/passing/BindingGroups.purs view
@@ -7,4 +7,4 @@  r = foo 2.0 -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/BlockString.purs view
@@ -5,4 +5,4 @@ foo :: String foo = """foo""" -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/CaseInDo.purs view
@@ -1,14 +1,14 @@ module Main where  import Prelude-import Debug.Trace+import Control.Monad.Eff.Console import Control.Monad.Eff  doIt :: forall eff. Eff eff Boolean doIt = return true  set = do-  trace "Testing..."+  log "Testing..."   case 0 of     0 -> doIt     _ -> return false@@ -16,4 +16,4 @@ main = do   b <- set   case b of-    true -> trace "Done"+    true -> log "Done"
examples/passing/CaseStatement.purs view
@@ -18,4 +18,4 @@ h f a N = a h f (J a) (J b) = J (f a b) -main = Debug.Trace.trace $ f "Done" "Failed" A+main = Control.Monad.Eff.Console.log $ f "Done" "Failed" A
examples/passing/CheckFunction.purs view
@@ -4,4 +4,4 @@  test = ((\x -> x+1.0) >>> (\x -> x*2.0)) 4.0 -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/CheckSynonymBug.purs view
@@ -2,8 +2,11 @@  import Prelude +length :: forall a. Array a -> Int+length _ = 0+ type Foo a = Array a  foo _ = length ([] :: Foo Number) -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/CheckTypeClass.purs view
@@ -14,5 +14,5 @@ mkBar :: forall a. a -> Bar a mkBar _ = Bar -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Church.purs view
@@ -15,4 +15,4 @@  test = append (cons 1 empty) (cons 2 empty) -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Collatz.purs view
@@ -4,15 +4,15 @@ import Control.Monad.Eff import Control.Monad.ST -collatz :: Number -> Number+collatz :: Int -> Int collatz n = runPure (runST (do   r <- newSTRef n-  count <- newSTRef 0.0+  count <- newSTRef 0   untilE $ do-    modifySTRef count $ (+) 1.0+    modifySTRef count $ (+) 1     m <- readSTRef r-    writeSTRef r $ if m % 2.0 == 0.0 then m / 2.0 else 3.0 * m + 1.0-    return $ m == 1.0+    writeSTRef r $ if m `mod` 2 == 0 then m / 2 else 3 * m + 1+    return $ m == 1   readSTRef count)) -main = Debug.Trace.print $ collatz 1000.0+main = Control.Monad.Eff.Console.print $ collatz 1000
examples/passing/Comparisons.purs view
@@ -2,8 +2,8 @@  import Prelude import Control.Monad.Eff-import Debug.Trace-import Assert+import Control.Monad.Eff.Console+import Test.Assert  main = do   assert (1.0 < 2.0)@@ -12,4 +12,4 @@   assert ("a" < "b")   assert ("a" == "a")   assert ("z" > "a")-  trace "Done!"+  log "Done!"
examples/passing/Conditional.purs view
@@ -6,4 +6,4 @@  not = \x -> if x then false else true -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Console.purs view
@@ -2,7 +2,7 @@  import Prelude import Control.Monad.Eff-import Debug.Trace+import Control.Monad.Eff.Console  replicateM_ :: forall m a. (Monad m) => Number -> m a -> m {} replicateM_ 0.0 _ = return {}@@ -10,4 +10,4 @@   act   replicateM_ (n - 1.0) act -main = replicateM_ 10.0 (trace "Hello World!")+main = replicateM_ 10.0 (log "Hello World!")
examples/passing/DataAndType.purs view
@@ -6,4 +6,4 @@  type B = A -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/DeepArrayBinder.purs view
@@ -2,7 +2,7 @@  import Prelude import Control.Monad.Eff-import Assert+import Test.Assert  data List a = Cons a (List a) | Nil @@ -10,6 +10,7 @@ match2 (Cons x (Cons y xs)) = x * y + match2 xs match2 _ = 0.0 -main = case 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))))))))) of-  100.0 -> Debug.Trace.trace "Done"-  _ -> error "Incorrect result!"+main = do+  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)))))))))+  assert' "Incorrect result!" (result == 100.0)+  Control.Monad.Eff.Console.log "Done"
examples/passing/DeepCase.purs view
@@ -1,7 +1,7 @@ module Main where  import Prelude-import Debug.Trace+import Control.Monad.Eff.Console import Control.Monad.Eff import Control.Monad.ST
examples/passing/Do.purs view
@@ -5,12 +5,12 @@ data Maybe a = Nothing | Just a  instance functorMaybe :: Functor Maybe where-  (<$>) f Nothing = Nothing-  (<$>) f (Just x) = Just (f x)+  map f Nothing = Nothing+  map f (Just x) = Just (f x)  instance applyMaybe :: Apply Maybe where-  (<*>) (Just f) (Just x) = Just (f x)-  (<*>) _ _ = Nothing+  apply (Just f) (Just x) = Just (f x)+  apply _ _ = Nothing  instance applicativeMaybe :: Applicative Maybe where   pure = Just@@ -64,4 +64,4 @@     g x = f x / 2.0   Just (f 10.0) -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Dollar.purs view
@@ -13,4 +13,4 @@  test2 x = id id $ id x -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Eff.purs view
@@ -3,11 +3,11 @@ import Prelude import Control.Monad.Eff import Control.Monad.ST-import Debug.Trace+import Control.Monad.Eff.Console  test1 = do-  trace "Line 1"-  trace "Line 2"+  log "Line 1"+  log "Line 2"  test2 = runPure (runST (do           ref <- newSTRef 0.0@@ -21,5 +21,5 @@  main = do   test1-  Debug.Trace.print test2-  Debug.Trace.print test3+  Control.Monad.Eff.Console.print test2+  Control.Monad.Eff.Console.print test3
examples/passing/EmptyDataDecls.purs view
@@ -1,7 +1,7 @@ module Main where  import Prelude-import Assert+import Test.Assert  data Z data S n@@ -12,8 +12,8 @@ nil = ArrayBox []  cons' :: forall a n. a -> ArrayBox n a -> ArrayBox (S n) a-cons' x (ArrayBox xs) = ArrayBox $ concat [x] xs+cons' x (ArrayBox xs) = ArrayBox $ append [x] xs  main = case cons' 1 $ cons' 2 $ cons' 3 nil of-         ArrayBox [1, 2, 3] -> Debug.Trace.trace "Done"-         _ -> error "Failed"+         ArrayBox [1, 2, 3] -> Control.Monad.Eff.Console.log "Done"+         _ -> assert' "Failed" false
examples/passing/EmptyRow.purs view
@@ -7,4 +7,4 @@ test :: Foo () test = Foo {} -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/EmptyTypeClass.purs view
@@ -9,4 +9,4 @@  instance allowPartials :: Partial -main = Debug.Trace.trace $ head ["Done"]+main = Control.Monad.Eff.Console.log $ head ["Done"]
examples/passing/EqOrd.purs view
@@ -10,7 +10,6 @@     r -> r  instance eqPair :: (Eq a, Eq b) => Eq (Pair a b) where-  (==) (Pair a1 b1) (Pair a2 b2) = a1 == a2 && b1 == b2-  (/=) (Pair a1 b1) (Pair a2 b2) = a1 /= a2 || b1 /= b2+  eq (Pair a1 b1) (Pair a2 b2) = a1 == a2 && b1 == b2 -main = Debug.Trace.print $ Pair 1.0 2.0 == Pair 1.0 2.0+main = Control.Monad.Eff.Console.print $ Pair 1.0 2.0 == Pair 1.0 2.0
examples/passing/ExtendedInfixOperators.purs view
@@ -11,4 +11,4 @@ test = [1.0, 2.0, 3.0] `comparing null` [4.0, 5.0, 6.0]  main = do-  Debug.Trace.print test+  Control.Monad.Eff.Console.print test
examples/passing/Fib.purs view
@@ -12,4 +12,4 @@     n2' <- readSTRef n2     writeSTRef n2 $ n1' + n2'     writeSTRef n1 n2'-    Debug.Trace.print n2')+    Control.Monad.Eff.Console.print n2')
examples/passing/FinalTagless.purs view
@@ -1,6 +1,6 @@ module Main where -import Prelude+import Prelude hiding (add)  class E e where   num :: Number -> e Number@@ -19,4 +19,4 @@ three :: Expr Number three = add (num 1.0) (num 2.0) -main = Debug.Trace.print $ runId three+main = Control.Monad.Eff.Console.print $ runId three
examples/passing/FunctionScope.purs view
@@ -1,13 +1,12 @@ module Main where  import Prelude-import Assert+import Test.Assert  mkValue :: Number -> Number mkValue id = id  main = do   let value = mkValue 1.0-  if value == 1.0-    then Debug.Trace.trace "Done"-    else error "Not done"+  assert $ value == 1.0+  Control.Monad.Eff.Console.log "Done"
examples/passing/Functions.purs view
@@ -12,4 +12,4 @@  test5 = \(+++) (***) -> 1.0 +++ 2.0 *** 3.0 -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Functions2.purs view
@@ -1,13 +1,12 @@ module Main where  import Prelude-import Assert+import Test.Assert  test :: forall a b. a -> b -> a test = \const _ -> const  main = do   let value = test "Done" {}-  if value == "Done"-    then Debug.Trace.trace "Done"-    else error "Not done"+  assert' "Not done" $ value == "Done"+  Control.Monad.Eff.Console.log "Done"
examples/passing/Guards.purs view
@@ -3,7 +3,7 @@ import Prelude  collatz = \x -> case x of-  y | y % 2.0 == 0.0 -> y / 2.0+  y | y `mod` 2.0 == 0.0 -> y / 2.0   y -> y * 3.0 + 1.0  -- Guards have access to current scope@@ -26,4 +26,4 @@                     | otherwise   = y - x -main = Debug.Trace.trace $ min "Done" "ZZZZ"+main = Control.Monad.Eff.Console.log $ min "Done" "ZZZZ"
examples/passing/HoistError.purs view
@@ -2,11 +2,11 @@  import Prelude import Control.Monad.Eff-import Debug.Trace-import Assert+import Control.Monad.Eff.Console+import Test.Assert  main = do   let x = 0.0   assert $ x == 0.0   let x = 1.0 + 1.0-  trace "Done"+  log "Done"
examples/passing/IfThenElseMaybe.purs view
@@ -8,4 +8,4 @@  test2 = if true then Nothing else Just 10 -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ImplicitEmptyImport.purs view
@@ -3,6 +3,6 @@ import Prelude  main = do-  Debug.Trace.trace "Hello"-  Debug.Trace.trace "Goodbye"-  Debug.Trace.trace "Done"+  Control.Monad.Eff.Console.log "Hello"+  Control.Monad.Eff.Console.log "Goodbye"+  Control.Monad.Eff.Console.log "Done"
examples/passing/ImportHiding.purs view
@@ -1,6 +1,6 @@ module Main where -import Debug.Trace+import Control.Monad.Eff.Console import Prelude hiding (   show, -- a value   Show, -- a type class
examples/passing/InferRecFunWithConstrainedArgument.purs view
@@ -5,4 +5,4 @@ test 100.0 = 100.0 test n = test(1.0 + n) -main = Debug.Trace.print $ test 0.0+main = Control.Monad.Eff.Console.print $ test 0.0
examples/passing/InstanceBeforeClass.purs view
@@ -8,4 +8,4 @@ class Foo a where   foo :: a -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/IntAndChar.purs view
@@ -2,7 +2,7 @@  import Prelude import Control.Monad.Eff-import Assert+import Test.Assert  f 1 = 1 f _ = 0@@ -15,4 +15,4 @@   assert $ f 0 == 0   assert $ g 'a' == 'a'   assert $ g 'b' == 'b'-  Debug.Trace.trace "Done"+  Control.Monad.Eff.Console.log "Done"
examples/passing/JSReserved.purs view
@@ -9,4 +9,4 @@  this catch = catch -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/KindedType.purs view
@@ -30,4 +30,4 @@ instance clazzString :: Clazz String where   def = "test" -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Let.purs view
@@ -44,10 +44,10 @@   in f 10.0  main = do-  Debug.Trace.print (test1 1.0)-  Debug.Trace.print (test2 1.0 2.0)-  Debug.Trace.print test3-  Debug.Trace.print test4-  Debug.Trace.print test5-  Debug.Trace.print test7-  Debug.Trace.print (test8 100.0)+  Control.Monad.Eff.Console.print (test1 1.0)+  Control.Monad.Eff.Console.print (test2 1.0 2.0)+  Control.Monad.Eff.Console.print test3+  Control.Monad.Eff.Console.print test4+  Control.Monad.Eff.Console.print test5+  Control.Monad.Eff.Console.print test7+  Control.Monad.Eff.Console.print (test8 100.0)
examples/passing/Let2.purs view
@@ -14,4 +14,4 @@       x = f 1.0   in not x -main = Debug.Trace.print test+main = Control.Monad.Eff.Console.print test
examples/passing/LetInInstance.purs view
@@ -11,4 +11,4 @@     go :: String -> String     go s = s -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/LiberalTypeSynonyms.purs view
@@ -18,4 +18,4 @@ f g = case g { x: "Hello" } of         { x = x } -> x -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/MPTCs.purs view
@@ -17,4 +17,4 @@ instance coerceShow :: (Prelude.Show a) => Coerce a String where   coerce = show -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Match.purs view
@@ -6,4 +6,4 @@  foo = \f -> case f of Foo -> "foo" -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ModuleExport.purs view
@@ -2,7 +2,7 @@   import Prelude  module Main where-  import Debug.Trace+  import Control.Monad.Eff.Console   import A    main = do
examples/passing/ModuleExportDupes.purs view
@@ -9,7 +9,7 @@   import A  module Main where-  import Debug.Trace+  import Control.Monad.Eff.Console   import A   import B   import C
examples/passing/ModuleExportExcluded.purs view
@@ -5,7 +5,7 @@   foo _ = 0.0  module Main where-  import Debug.Trace+  import Control.Monad.Eff.Console   import A (foo)    otherwise = false
examples/passing/ModuleExportHiding.purs view
@@ -2,7 +2,7 @@   import Prelude  module Main where-  import Debug.Trace+  import Control.Monad.Eff.Console   import A hiding (module Prelude)    otherwise = false
examples/passing/ModuleExportQualified.purs view
@@ -2,7 +2,7 @@   import Prelude  module Main where-  import Debug.Trace+  import Control.Monad.Eff.Console   import qualified A as B    main = do
examples/passing/ModuleExportSelf.purs view
@@ -4,7 +4,7 @@   type Foo = Boolean  module Main where-  import Debug.Trace+  import Control.Monad.Eff.Console   import A    bar :: Foo
examples/passing/Monad.purs view
@@ -29,4 +29,4 @@  test2 = test maybe -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/MonadState.purs view
@@ -13,10 +13,10 @@ runState s (State f) = f s  instance functorState :: Functor (State s) where-  (<$>) = liftM1+  map = liftM1  instance applyState :: Apply (State s) where-  (<*>) = ap+  apply = ap  instance applicativeState :: Applicative (State s) where   pure a = State $ \s -> Tuple s a@@ -44,5 +44,5 @@  main = do   let t1 = test-  Debug.Trace.trace "Done"+  Control.Monad.Eff.Console.log "Done"
examples/passing/MultiArgFunctions.purs view
@@ -3,7 +3,7 @@ import Prelude import Data.Function import Control.Monad.Eff-import Debug.Trace+import Control.Monad.Eff.Console  f = mkFn2 $ \a b -> runFn2 g a b + runFn2 g b a @@ -12,16 +12,16 @@   _ -> runFn2 f (a - 0.0) (b - 0.0)  main = do-  runFn0 (mkFn0 $ \_ -> trace $ show 0.0)-  runFn1 (mkFn1 $ \a -> trace $ show a) 0.0-  runFn2 (mkFn2 $ \a b -> trace $ show [a, b]) 0.0 0.0-  runFn3 (mkFn3 $ \a b c -> trace $ show [a, b, c]) 0.0 0.0 0.0-  runFn4 (mkFn4 $ \a b c d -> trace $ show [a, b, c, d]) 0.0 0.0 0.0 0.0-  runFn5 (mkFn5 $ \a b c d e -> trace $ show [a, b, c, d, e]) 0.0 0.0 0.0 0.0 0.0-  runFn6 (mkFn6 $ \a b c d e f -> trace $ show [a, b, c, d, e, f]) 0.0 0.0 0.0 0.0 0.0 0.0-  runFn7 (mkFn7 $ \a b c d e f g -> trace $ show [a, b, c, d, e, f, g]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0-  runFn8 (mkFn8 $ \a b c d e f g h -> trace $ show [a, b, c, d, e, f, g, h]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0-  runFn9 (mkFn9 $ \a b c d e f g h i -> trace $ show [a, b, c, d, e, f, g, h, i]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0-  runFn10 (mkFn10 $ \a b c d e f g h i j-> trace $ show [a, b, c, d, e, f, g, h, i, j]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0+  runFn0 (mkFn0 $ \_ -> log $ show 0.0)+  runFn1 (mkFn1 $ \a -> log $ show a) 0.0+  runFn2 (mkFn2 $ \a b -> log $ show [a, b]) 0.0 0.0+  runFn3 (mkFn3 $ \a b c -> log $ show [a, b, c]) 0.0 0.0 0.0+  runFn4 (mkFn4 $ \a b c d -> log $ show [a, b, c, d]) 0.0 0.0 0.0 0.0+  runFn5 (mkFn5 $ \a b c d e -> log $ show [a, b, c, d, e]) 0.0 0.0 0.0 0.0 0.0+  runFn6 (mkFn6 $ \a b c d e f -> log $ show [a, b, c, d, e, f]) 0.0 0.0 0.0 0.0 0.0 0.0+  runFn7 (mkFn7 $ \a b c d e f g -> log $ show [a, b, c, d, e, f, g]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0+  runFn8 (mkFn8 $ \a b c d e f g h -> log $ show [a, b, c, d, e, f, g, h]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0+  runFn9 (mkFn9 $ \a b c d e f g h i -> log $ show [a, b, c, d, e, f, g, h, i]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0+  runFn10 (mkFn10 $ \a b c d e f g h i j-> log $ show [a, b, c, d, e, f, g, h, i, j]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0   print $ runFn2 g 0.0 0.0-  trace "Done!"+  log "Done!"
examples/passing/MutRec.purs view
@@ -16,4 +16,4 @@  oddToNumber (Odd n) = evenToNumber n + 0.0 -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/MutRec2.purs view
@@ -16,4 +16,4 @@ showN :: A -> S showN a = f a -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/MutRec3.purs view
@@ -16,4 +16,4 @@ showN :: A -> S showN a = f a -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/NamedPatterns.purs view
@@ -6,4 +6,4 @@   y@{ foo = "Foo" } -> y   y -> y -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/NegativeBinder.purs view
@@ -6,4 +6,4 @@ test -1.0 = false test _  = true -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Nested.purs view
@@ -6,4 +6,4 @@  data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a) -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/NestedTypeSynonyms.purs view
@@ -8,4 +8,4 @@ fn :: Y fn a = a -main = Debug.Trace.print (fn "Done")+main = Control.Monad.Eff.Console.print (fn "Done")
examples/passing/NestedWhere.purs view
@@ -9,4 +9,4 @@     go x = go1 (x - 1.0)     go1 x = go x -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Newtype.purs view
@@ -1,8 +1,8 @@ module Main where -import Prelude+import Prelude hiding (apply) import Control.Monad.Eff-import Debug.Trace+import Control.Monad.Eff.Console  newtype Thing = Thing String @@ -20,4 +20,4 @@   print $ Thing "hello"   print $ Box 42.0   print $ apply Box 9000.0-  trace "Done"+  log "Done"
examples/passing/NewtypeEff.purs view
@@ -1,19 +1,19 @@ module Main where  import Prelude-import Debug.Trace+import Control.Monad.Eff.Console import Control.Monad.Eff -newtype T a = T (Eff (trace :: Trace) a)+newtype T a = T (Eff (console :: CONSOLE) a) -runT :: forall a. T a -> Eff (trace :: Trace) a+runT :: forall a. T a -> Eff (console :: CONSOLE) a runT (T t) = t  instance functorT :: Functor T where-  (<$>) f (T t) = T (f <$> t)+  map f (T t) = T (f <$> t)  instance applyT :: Apply T where-  (<*>) (T f) (T x) = T (f <*> x)+  apply (T f) (T x) = T (f <*> x)  instance applicativeT :: Applicative T where   pure t = T (pure t)@@ -24,6 +24,6 @@ instance monadT :: Monad T  main = runT do-  T $ trace "Done"-  T $ trace "Done"-  T $ trace "Done"+  T $ log "Done"+  T $ log "Done"+  T $ log "Done"
examples/passing/NewtypeWithRecordUpdate.purs view
@@ -3,7 +3,7 @@ module Main where  import Prelude-import Debug.Trace+import Control.Monad.Eff.Console  newtype NewType a = NewType (Object a) @@ -13,4 +13,4 @@ rec2 :: NewType (a :: Number, b :: Number, c :: Number) rec2 = NewType (rec1 { a = 1.0 }) -main = trace "Done"+main = log "Done"
examples/passing/ObjectGetter.purs view
@@ -7,7 +7,7 @@ point = { x: 1.0, y: 0.0 }  main = do-  Debug.Trace.print $ getX point-  Debug.Trace.trace $ _." 123 string Prop Name " { " 123 string Prop Name ": "OK" }-  Debug.Trace.trace $ (_.x >>> _.y) { x: { y: "Nested" } }-  Debug.Trace.trace $ _.value { value: "Done!" }+  Control.Monad.Eff.Console.print $ getX point+  Control.Monad.Eff.Console.log $ _." 123 string Prop Name " { " 123 string Prop Name ": "OK" }+  Control.Monad.Eff.Console.log $ (_.x >>> _.y) { x: { y: "Nested" } }+  Control.Monad.Eff.Console.log $ _.value { value: "Done!" }
examples/passing/ObjectSynonym.purs view
@@ -12,4 +12,4 @@ outer :: Outer outer = { inner: inner } -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ObjectUpdate.purs view
@@ -17,4 +17,4 @@  inferPolyUpdate = \o -> o { foo = "Foo" } -main = Debug.Trace.trace ((update1 {foo: ""}).foo)+main = Control.Monad.Eff.Console.log ((update1 {foo: ""}).foo)
examples/passing/ObjectUpdate2.purs view
@@ -14,4 +14,4 @@   { baz = "blah"   } -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ObjectUpdater.purs view
@@ -2,8 +2,8 @@  import Prelude import Control.Monad.Eff-import Debug.Trace-import Assert+import Control.Monad.Eff.Console+import Test.Assert  getValue :: forall e. Eff (| e) Boolean getValue = return true
examples/passing/ObjectWildcards.purs view
@@ -2,8 +2,8 @@  import Prelude import Control.Monad.Eff-import Debug.Trace-import Assert+import Control.Monad.Eff.Console+import Test.Assert  mkRecord = { foo: _, bar: _, baz: "baz" } @@ -17,4 +17,4 @@   point <- { x: _, y: x } <$> return 2.0   assert $ point.x == 2.0   assert $ point.y == 1.0-  trace (mkRecord 1.0 "Done!").bar+  log (mkRecord 1.0 "Done!").bar
examples/passing/Objects.purs view
@@ -1,6 +1,6 @@ module Main where -import Prelude+import Prelude hiding (append)  test = \x -> x.foo + x.bar + 1.0 @@ -32,4 +32,4 @@  test7 {a:    snoog , b     : blah } = blah -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/OneConstructor.purs view
@@ -6,4 +6,4 @@  one' (One a) = a -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/OperatorAssociativity.purs view
@@ -2,8 +2,8 @@  import Prelude import Control.Monad.Eff-import Debug.Trace-import Assert+import Control.Monad.Eff.Console+import Test.Assert  bug :: Number -> Number -> Number bug a b = 0.0 - (a - b)@@ -22,4 +22,4 @@   assert (1.0 + 10.0 - 5.0 == 6.0)   assert (1.0 + 10.0 * 5.0 == 51.0)   assert (10.0 * 5.0 - 1.0 == 49.0)-  trace "Success!"+  log "Success!"
examples/passing/OperatorInlining.purs view
@@ -1,7 +1,7 @@ module Main where  import Prelude-import Debug.Trace+import Control.Monad.Eff.Console  main = do
examples/passing/OperatorSections.purs view
@@ -1,11 +1,11 @@ module Main where  import Prelude-import Assert+import Test.Assert  main = do   assert $ (/ 2.0) 4.0 == 2.0   assert $ (2.0 /) 4.0 == 0.5   assert $ (`const` 1.0) 2.0 == 2.0   assert $ (1.0 `const`) 2.0 == 1.0-  Debug.Trace.trace "Done!"+  Control.Monad.Eff.Console.log "Done!"
examples/passing/Operators.purs view
@@ -2,7 +2,7 @@  import Prelude import Control.Monad.Eff-import Debug.Trace+import Control.Monad.Eff.Console  (?!) :: forall a. a -> a -> a (?!) x _ = x@@ -96,4 +96,4 @@   let t18 = test18   let t19 = test19   let t20 = test20-  trace "Done"+  log "Done"
examples/passing/OptimizerBug.purs view
@@ -6,4 +6,4 @@  y a = x a -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/PartialFunction.purs view
@@ -1,10 +1,10 @@ module Main where  import Prelude-import Assert+import Test.Assert  fn :: Number -> Number fn 0.0 = 0.0 fn 1.0 = 2.0 -main = assertPartial $ \_ -> fn 2.0+main = assertThrows $ \_ -> fn 2.0
examples/passing/Patterns.purs view
@@ -19,4 +19,4 @@ isDesc [x, y] | x > y = true isDesc _ = false -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Person.purs view
@@ -8,4 +8,4 @@ showPerson = \p -> case p of   Person o -> o.name ++ ", aged " ++ show o.age -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Rank2Data.purs view
@@ -1,6 +1,6 @@ module Main where -import Prelude+import Prelude hiding (add)  data Id = Id forall a. a -> a @@ -26,4 +26,4 @@ four = add two two fourNumber = runNat four -main = Debug.Trace.trace "Done'"+main = Control.Monad.Eff.Console.log "Done'"
examples/passing/Rank2Object.purs view
@@ -1,11 +1,11 @@ module Main where  import Prelude-import Debug.Trace+import Control.Monad.Eff.Console  data Foo = Foo { id :: forall a. a -> a }  foo :: Foo -> Number foo (Foo { id = f }) = f 0.0 -main = trace "Done"+main = log "Done"
examples/passing/Rank2TypeSynonym.purs view
@@ -13,4 +13,4 @@  main = do   x <- bar-  Debug.Trace.print x+  Control.Monad.Eff.Console.print x
examples/passing/Rank2Types.purs view
@@ -8,4 +8,4 @@ forever :: forall m a b. (forall a b. m a -> (a -> m b) -> m b) -> m a -> m b forever = \bind action -> bind action $ \_ -> forever bind action -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/RebindableSyntax.purs view
@@ -20,10 +20,10 @@ runConst (Const a) = a  instance functorConst :: Functor (Const a) where-  (<$>) _ (Const a) = Const a+  map _ (Const a) = Const a  instance applyConst :: (Semigroup a) => Apply (Const a) where-  (<*>) (Const a1) (Const a2) = Const (a1 <> a2)+  apply (Const a1) (Const a2) = Const (a1 <> a2)  example2 :: Const String Unit example2 = do@@ -35,5 +35,5 @@   bind x f = x *> f unit  main = do-  Debug.Trace.trace example1-  Debug.Trace.trace $ runConst example2+  Control.Monad.Eff.Console.log example1+  Control.Monad.Eff.Console.log $ runConst example2
examples/passing/Recursion.purs view
@@ -7,4 +7,4 @@   1.0 -> 1.0   n -> fib (n - 1.0) + fib (n - 2.0) -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ReservedWords.purs view
@@ -12,4 +12,4 @@ f :: forall r. { type :: String | r } -> String f { type = "p" } = "Done" -main = Debug.Trace.trace $ f { type: p.type, foo: "bar" }+main = Control.Monad.Eff.Console.log $ f { type: p.type, foo: "bar" }
examples/passing/RowConstructors.purs view
@@ -39,4 +39,4 @@ wildcard' :: { | Quux _ } -> Number wildcard' { q: q } = q -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/RowPolyInstanceContext.purs view
@@ -19,4 +19,4 @@ main = do   let t1 = test1   let t2 = test2-  Debug.Trace.trace "Done"+  Control.Monad.Eff.Console.log "Done"
examples/passing/RuntimeScopeIssue.purs view
@@ -16,4 +16,4 @@   b 0.0 = false   b n = a (n - 1.0) -main = Debug.Trace.print $ a 10.0+main = Control.Monad.Eff.Console.print $ a 10.0
examples/passing/ScopedTypeVariables.purs view
@@ -33,4 +33,4 @@       j x = x  -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Sequence.purs view
@@ -12,4 +12,4 @@   sequence Nil = pure Nil   sequence (Cons x xs) = Cons <$> x <*> sequence xs -main = sequence $ Cons (Debug.Trace.trace "Done") Nil+main = sequence $ Cons (Control.Monad.Eff.Console.log "Done") Nil
examples/passing/SequenceDesugared.purs view
@@ -31,7 +31,7 @@   Cons x xs -> Cons <$> x <*> sequence sequenceList''' xs) :: forall m a. (Monad m) => List (m a) -> m (List a))  main = do-  sequence sequenceList $ Cons (Debug.Trace.trace "Done") Nil-  sequence sequenceList' $ Cons (Debug.Trace.trace "Done") Nil-  sequence sequenceList'' $ Cons (Debug.Trace.trace "Done") Nil-  sequence sequenceList''' $ Cons (Debug.Trace.trace "Done") Nil+  sequence sequenceList $ Cons (Control.Monad.Eff.Console.log "Done") Nil+  sequence sequenceList' $ Cons (Control.Monad.Eff.Console.log "Done") Nil+  sequence sequenceList'' $ Cons (Control.Monad.Eff.Console.log "Done") Nil+  sequence sequenceList''' $ Cons (Control.Monad.Eff.Console.log "Done") Nil
examples/passing/ShadowedRename.purs view
@@ -2,8 +2,8 @@  import Prelude import Control.Monad.Eff-import Debug.Trace-import Assert+import Control.Monad.Eff.Console+import Test.Assert  foo foo = let foo_1 = \_ -> foo               foo_2 = foo_1 unit + 1.0@@ -11,4 +11,4 @@  main = do   assert $ foo 1.0 == 2.0-  trace "Done"+  log "Done"
examples/passing/ShadowedTCO.purs view
@@ -1,6 +1,6 @@ module Main where -import Prelude+import Prelude hiding (add)  runNat f = f 0.0 (\n -> n + 1.0) @@ -15,4 +15,4 @@ four = add two two fourNumber = runNat four -main = Debug.Trace.trace $ show fourNumber+main = Control.Monad.Eff.Console.log $ show fourNumber
examples/passing/ShadowedTCOLet.purs view
@@ -6,4 +6,4 @@   let f 1.0 2.0 3.0 = 1.0   in f x z y -main = Debug.Trace.trace $ show $ f 1.0 3.0 2.0+main = Control.Monad.Eff.Console.log $ show $ f 1.0 3.0 2.0
examples/passing/SignedNumericLiterals.purs view
@@ -14,4 +14,4 @@  test1 = 2.0 - 1.0 -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Superclasses1.purs view
@@ -17,4 +17,4 @@ test :: forall a. (Cl a) => a -> a test a = su (cl a a) -main = Debug.Trace.print $ test 10.0+main = Control.Monad.Eff.Console.print $ test 10.0
examples/passing/Superclasses2.purs view
@@ -1,7 +1,6 @@ module Main where  import Prelude-import Prelude.Unsafe (unsafeIndex)  class Su a where   su :: a -> a@@ -21,4 +20,4 @@ test :: forall a. (Cl a) => a -> Array a test x = su [cl x x] -main = Debug.Trace.print $ test 10.0 `unsafeIndex` 0.0+main = Control.Monad.Eff.Console.print $ test 10.0
examples/passing/Superclasses3.purs view
@@ -1,7 +1,7 @@ module Main where  import Prelude-import Debug.Trace+import Control.Monad.Eff.Console import Control.Monad.Eff  class (Monad m) <= MonadWriter w m where@@ -16,16 +16,16 @@   tell w   tell w -data MTrace a = MTrace (Eff (trace :: Trace) a)+data MTrace a = MTrace (Eff (console :: CONSOLE) a) -runMTrace :: forall a. MTrace a -> Eff (trace :: Trace) a+runMTrace :: forall a. MTrace a -> Eff (console :: CONSOLE) a runMTrace (MTrace a) = a  instance functorMTrace :: Functor MTrace where-  (<$>) = liftM1+  map = liftM1  instance applyMTrace :: Apply MTrace where-  (<*>) = ap+  apply = ap  instance applicativeMTrace :: Applicative MTrace where   pure = MTrace <<< return@@ -36,6 +36,6 @@ instance monadMTrace :: Monad MTrace  instance writerMTrace :: MonadWriter String MTrace where-  tell s = MTrace (trace s)+  tell s = MTrace (log s)  main = runMTrace $ test "Done"
examples/passing/TCOCase.purs view
@@ -4,7 +4,7 @@  data Data = One | More Data -main = Debug.Trace.trace (from (to 10000.0 One))+main = Control.Monad.Eff.Console.log (from (to 10000.0 One))   where   to 0.0 a = a   to n a = to (n - 1.0) (More a)
examples/passing/TailCall.purs view
@@ -14,4 +14,4 @@ notATailCall = \x ->   (\notATailCall -> notATailCall x) (\x -> x) -main = Debug.Trace.print (test 0.0 (1.0 `C` (2.0 `C` (3.0 `C` N))))+main = Control.Monad.Eff.Console.print (test 0.0 (1.0 `C` (2.0 `C` (3.0 `C` N))))
examples/passing/Tick.purs view
@@ -4,4 +4,4 @@  test' x = x -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TopLevelCase.purs view
@@ -5,8 +5,8 @@ gcd :: Number -> Number -> Number gcd 0.0 x = x gcd x 0.0 = x-gcd x y | x > y = gcd (x % y) y-gcd x y = gcd (y % x) x+gcd x y | x > y = gcd (x `mod` y) y+gcd x y = gcd (y `mod` x) x  guardsTest [x] | x > 0.0 = [] guardsTest xs = xs@@ -15,4 +15,4 @@  parseTest A 0.0 = 0.0 -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeClassMemberOrderChange.purs view
@@ -10,4 +10,4 @@   val = true   fn x y = y -main = Debug.Trace.trace (show (fn true val))+main = Control.Monad.Eff.Console.log (show (fn true val))
examples/passing/TypeClasses.purs view
@@ -22,10 +22,10 @@ test3 = \_ -> show (Data "testing")  instance functorData :: Functor Data where-  (<$>) = liftM1+  map = liftM1  instance applyData :: Apply Data where-  (<*>) = ap+  apply = ap  instance applicativeData :: Applicative Data where   pure = Data@@ -38,10 +38,10 @@ data Maybe a = Nothing | Just a  instance functorMaybe :: Functor Maybe where-  (<$>) = liftM1+  map = liftM1  instance applyMaybe :: Apply Maybe where-  (<*>) = ap+  apply = ap  instance applicativeMaybe :: Applicative Maybe where   pure = Just@@ -65,5 +65,5 @@   n <- ask   return $ n + 1.0 -main = Debug.Trace.trace (test7 "Done")+main = Control.Monad.Eff.Console.log (test7 "Done")
examples/passing/TypeClassesInOrder.purs view
@@ -8,4 +8,4 @@ instance fooString :: Foo String where   foo s = s -main = Debug.Trace.trace $ foo "Done"+main = Control.Monad.Eff.Console.log $ foo "Done"
examples/passing/TypeClassesWithOverlappingTypeVariables.purs view
@@ -5,7 +5,7 @@ data Either a b = Left a | Right b  instance functorEither :: Prelude.Functor (Either a) where-  (<$>) _ (Left x) = Left x-  (<$>) f (Right y) = Right (f y)+  map _ (Left x) = Left x+  map f (Right y) = Right (f y) -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeDecl.purs view
@@ -9,4 +9,4 @@ iterate 0.0 f a = a iterate n f a = iterate (n - 1.0) f (f a) -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeSynonymInData.purs view
@@ -8,4 +8,4 @@  foo (Foo []) = Bar -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeSynonyms.purs view
@@ -24,4 +24,4 @@ test1 :: forall a b c. Lens (Pair (Pair a b) c) a test1 = composeLenses fst fst -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeWildcards.purs view
@@ -12,4 +12,4 @@   go a1 a2 | a1 == a2 = a1   go a1 _ = go (f a1) a1 -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeWildcardsRecordExtension.purs view
@@ -5,4 +5,4 @@ foo :: forall a. {b :: Number | a} -> {b :: Number | _} foo f = f -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypedWhere.purs view
@@ -14,4 +14,4 @@   go ls (C (L a) rest) = go (C a ls) rest   go ls (C _ rest) = go ls rest -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/UnderscoreIdent.purs view
@@ -8,4 +8,4 @@  done (Con_2 s) = s -main = Debug.Trace.trace (done (Con_2 "Done"))+main = Control.Monad.Eff.Console.log (done (Con_2 "Done"))
examples/passing/Unit.purs view
@@ -1,6 +1,6 @@ module Main where  import Prelude-import Debug.Trace+import Control.Monad.Eff.Console  main = print (const unit $ "Hello world")
examples/passing/UnknownInTypeClassLookup.purs view
@@ -11,4 +11,4 @@  runTest a = test a a -main = Debug.Trace.trace $ runTest 0.0+main = Control.Monad.Eff.Console.log $ runTest 0.0
examples/passing/Where.purs view
@@ -40,10 +40,10 @@   go y = go $ (y + x / y) / 2.0  main = do-  Debug.Trace.print (test1 1.0)-  Debug.Trace.print (test2 1.0 2.0)-  Debug.Trace.print test3-  Debug.Trace.print test4-  Debug.Trace.print test5-  Debug.Trace.print test6-  Debug.Trace.print (test7 100.0)+  Control.Monad.Eff.Console.print (test1 1.0)+  Control.Monad.Eff.Console.print (test2 1.0 2.0)+  Control.Monad.Eff.Console.print test3+  Control.Monad.Eff.Console.print test4+  Control.Monad.Eff.Console.print test5+  Control.Monad.Eff.Console.print test6+  Control.Monad.Eff.Console.print (test7 100.0)
examples/passing/iota.purs view
@@ -6,4 +6,4 @@  iota = \x -> x s k -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
examples/passing/s.purs view
@@ -4,4 +4,4 @@  s = \x y z -> x z (y z) -main = Debug.Trace.trace "Done"+main = Control.Monad.Eff.Console.log "Done"
− psc-publish/BoxesHelpers.hs 
@@ -1,38 +0,0 @@-module BoxesHelpers-  ( Boxes.Box-  , Boxes.nullBox-  , module BoxesHelpers-  ) where--import System.IO (hPutStr, stderr)-import qualified Text.PrettyPrint.Boxes as Boxes--width :: Int-width = 79--indentWidth :: Int-indentWidth = 2--para :: String -> Boxes.Box-para = Boxes.para Boxes.left width--indented :: Boxes.Box -> Boxes.Box-indented b = Boxes.hcat Boxes.left [Boxes.emptyBox 1 indentWidth, b]--successivelyIndented :: [String] -> Boxes.Box-successivelyIndented [] =-  Boxes.nullBox-successivelyIndented (x:xs) =-  Boxes.vcat Boxes.left [para x, indented (successivelyIndented xs)]--vcat :: [Boxes.Box] -> Boxes.Box-vcat = Boxes.vcat Boxes.left--spacer :: Boxes.Box-spacer = Boxes.emptyBox 1 1--bulletedList :: (a -> String) -> [a] -> [Boxes.Box]-bulletedList f = map (indented . para . ("* " ++) . f)--printToStderr :: Boxes.Box -> IO ()-printToStderr = hPutStr stderr . Boxes.render
− psc-publish/ErrorsWarnings.hs 
@@ -1,359 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--module ErrorsWarnings where--import Control.Applicative ((<$>))-import Data.Aeson.BetterErrors-import Data.Version-import Data.Maybe-import Data.Monoid-import Data.Foldable (foldMap)-import Data.List (intersperse)-import Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NonEmpty--import qualified Data.Text as T--import Control.Exception (IOException)-import Web.Bower.PackageMeta (BowerError, PackageName, runPackageName)-import qualified Web.Bower.PackageMeta as Bower--import qualified Language.PureScript as P-import qualified Language.PureScript.Docs as D--import BoxesHelpers---- | An error which meant that it was not possible to retrieve metadata for a--- package.-data PackageError-  = UserError UserError-  | InternalError InternalError-  | OtherError OtherError-  deriving (Show)--data PackageWarning-  = NoResolvedVersion PackageName-  | UndeclaredDependency PackageName-  | UnacceptableVersion (PackageName, String)-  deriving (Show)---- | An error that should be fixed by the user.-data UserError-  = BowerJSONNotFound-  | CouldntParseBowerJSON (ParseError BowerError)-  | BowerJSONNameMissing-  | TagMustBeCheckedOut-  | AmbiguousVersions [Version] -- Invariant: should contain at least two elements-  | BadRepositoryField RepositoryFieldError-  | MissingDependencies (NonEmpty PackageName)-  | ParseAndDesugarError D.ParseDesugarError-  deriving (Show)--data RepositoryFieldError-  = RepositoryFieldMissing-  | BadRepositoryType String-  | NotOnGithub-  deriving (Show)---- | An error that probably indicates a bug in this module.-data InternalError-  = JSONError JSONSource (ParseError BowerError)-  deriving (Show)--data JSONSource-  = FromFile FilePath-  | FromBowerList-  deriving (Show)--data OtherError-  = ProcessFailed String [String] IOException-  | IOExceptionThrown IOException-  deriving (Show)--printError :: PackageError -> IO ()-printError = printToStderr . renderError--renderError :: PackageError -> Box-renderError err =-  case err of-    UserError e ->-      vcat-        [ para (concat-          [ "There is a problem with your package, which meant that "-          , "it could not be published."-          ])-        , para "Details:"-        , indented (displayUserError e)-        ]-    InternalError e ->-      vcat-        [ para "Internal error: this is probably a bug. Please report it:"-        , indented (para "https://github.com/purescript/purescript/issues/new")-        , spacer-        , para "Details:"-        , successivelyIndented (displayInternalError e)-        ]-    OtherError e ->-      vcat-        [ para "An error occurred, and your package could not be published."-        , para "Details:"-        , indented (displayOtherError e)-        ]--displayUserError :: UserError -> Box-displayUserError e = case e of-  BowerJSONNotFound ->-    para (concat-      [ "The bower.json file was not found. Please create one, or run "-      , "`pulp init`."-      ])-  CouldntParseBowerJSON err ->-    vcat-      [ successivelyIndented-        [ "The bower.json file could not be parsed as JSON:"-        , "aeson reported: " ++ show err-        ]-      , para "Please ensure that your bower.json file is valid JSON."-      ]-  BowerJSONNameMissing ->-    vcat-      [ successivelyIndented-        [ "In bower.json:"-        , "the \"name\" key was not found."-        ]-      , para "Please give your package a name first."-      ]-  TagMustBeCheckedOut ->-      vcat-        [ para (concat-            [ "psc-publish requires a tagged version to be checked out in "-            , "order to build documentation, and no suitable tag was found. "-            , "Please check out a previously tagged version, or tag a new "-            , "version."-            ])-        , spacer-        , para "Note: tagged versions must be in one of the following forms:"-        , indented (para "* v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")-        , indented (para "* {MAJOR}.{MINOR}.{PATCH} (example: \"1.6.2\")")-        ]-  AmbiguousVersions vs ->-    vcat $-      [ para (concat-          [ "The currently checked out commit seems to have been tagged with "-          , "more than 1 version, and I don't know which one should be used. "-          , "Please either delete some of the tags, or create a new commit "-          , "to tag the desired verson with."-          ])-      , spacer-      , para "Tags for the currently checked out commit:"-      ] ++ bulletedList showVersion vs-  BadRepositoryField err ->-    displayRepositoryError err-  MissingDependencies pkgs ->-    let singular = NonEmpty.length pkgs == 1-        pl a b = if singular then b else a-        do_          = pl "do" "does"-        dependencies = pl "dependencies" "dependency"-        them         = pl "them" "it"-    in vcat $-      [ para (concat-        [ "The following Bower ", dependencies, " ", do_, " not appear to be "-        , "installed:"-        ])-      ] ++-        bulletedList runPackageName (NonEmpty.toList pkgs)-        ++-      [ spacer-      , para (concat-        [ "Please install ", them, " first, by running `bower install`."-        ])-      ]-  ParseAndDesugarError (D.ParseError err) ->-    vcat-      [ para "Parse error:"-      , indented (para (show err))-      ]-  ParseAndDesugarError (D.SortModulesError err) ->-    vcat-      [ para "Error in sortModules:"-      , indented (para (P.prettyPrintMultipleErrors False err))-      ]-  ParseAndDesugarError (D.DesugarError err) ->-    vcat-      [ para "Error while desugaring:"-      , indented (para (P.prettyPrintMultipleErrors False err))-      ]--displayRepositoryError :: RepositoryFieldError -> Box-displayRepositoryError err = case err of-  RepositoryFieldMissing ->-    vcat-      [ para (concat-         [ "The 'repository' field is not present in your bower.json file. "-         , "Without this information, Pursuit would not be able to generate "-         , "source links in your package's documentation. Please add one - like "-         , "this, for example:"-         ])-      , spacer-      , indented (vcat-          [ para "\"repository\": {"-          , indented (para "\"type\": \"git\",")-          , indented (para "\"url\": \"git://github.com/purescript/purescript-prelude.git\"")-          , para "}"-          ]-        )-      ]-  BadRepositoryType ty ->-    para (concat-      [ "In your bower.json file, the repository type is currently listed as "-      , "\"" ++ ty ++ "\". Currently, only git repositories are supported. "-      , "Please publish your code in a git repository, and then update the "-      , "repository type in your bower.json file to \"git\"."-      ])-  NotOnGithub ->-    vcat-      [ para (concat-        [ "The repository url in your bower.json file does not point to a "-        , "GitHub repository. Currently, Pursuit does not support packages "-        , "which are not hosted on GitHub."-        ])-      , spacer-      , para (concat-        [ "Please update your bower.json file to point to a GitHub repository. "-        , "Alternatively, if you would prefer not to host your package on "-        , "GitHub, please open an issue:"-        ])-      , indented (para "https://github.com/purescript/purescript/issues/new")-      ]--displayInternalError :: InternalError -> [String]-displayInternalError e = case e of-  JSONError src r ->-    [ "Error in JSON " ++ displayJSONSource src ++ ":"-    , T.unpack (Bower.displayError r)-    ]--displayJSONSource :: JSONSource -> String-displayJSONSource s = case s of-  FromFile fp ->-    "in file " ++ show fp-  FromBowerList ->-    "in the output of `bower list --json --offline`"--displayOtherError :: OtherError -> Box-displayOtherError e = case e of-  ProcessFailed prog args exc ->-    successivelyIndented-      [ "While running `" ++ prog ++ " " ++ unwords args ++ "`:"-      , show exc-      ]-  IOExceptionThrown exc ->-    successivelyIndented-      [ "An IO exception occurred:", show exc ]--data CollectedWarnings = CollectedWarnings-  { noResolvedVersions     :: [PackageName]-  , undeclaredDependencies :: [PackageName]-  , unacceptableVersions   :: [(PackageName, String)]-  }-  deriving (Show, Eq, Ord)--instance Monoid CollectedWarnings where-  mempty = CollectedWarnings mempty mempty mempty-  mappend (CollectedWarnings as bs cs) (CollectedWarnings as' bs' cs') =-    CollectedWarnings (as <> as') (bs <> bs') (cs <> cs')--collectWarnings :: [PackageWarning] -> CollectedWarnings-collectWarnings = foldMap singular-  where-  singular w = case w of-    NoResolvedVersion    pn -> CollectedWarnings [pn] [] []-    UndeclaredDependency pn -> CollectedWarnings [] [pn] []-    UnacceptableVersion t   -> CollectedWarnings [] [] [t]--renderWarnings :: [PackageWarning] -> Box-renderWarnings warns =-  let CollectedWarnings{..} = collectWarnings warns-      go toBox warns' = toBox <$> NonEmpty.nonEmpty warns'-      mboxes = [ go warnNoResolvedVersions     noResolvedVersions-               , go warnUndeclaredDependencies undeclaredDependencies-               , go warnUnacceptableVersions   unacceptableVersions-               ]-  in case catMaybes mboxes of-       []    -> nullBox-       boxes -> vcat [ para "Warnings:"-                     , indented (vcat (intersperse spacer boxes))-                     ]--warnNoResolvedVersions :: NonEmpty PackageName -> Box-warnNoResolvedVersions pkgNames =-  let singular = NonEmpty.length pkgNames == 1-      pl a b = if singular then b else a--      packages   = pl "packages" "package"-      anyOfThese = pl "any of these" "this"-      these      = pl "these" "this"-  in vcat $-    [ para (concat-      ["The following ", packages, " did not appear to have a resolved "-      , "version:"])-    ] ++-      bulletedList runPackageName (NonEmpty.toList pkgNames)-      ++-    [ spacer-    , para (concat-      ["Links to types in ", anyOfThese, " ", packages, " will not work. In "-      , "order to make links work, edit your bower.json to specify a version"-      , " or a version range for ", these, " ", packages, ", and rerun "-      , "`bower install`."-      ])-    ]--warnUndeclaredDependencies :: NonEmpty PackageName -> Box-warnUndeclaredDependencies pkgNames =-  let singular = NonEmpty.length pkgNames == 1-      pl a b = if singular then b else a--      packages     = pl "packages" "package"-      are          = pl "are" "is"-      dependencies = pl "dependencies" "a dependency"-  in vcat $-    [ para (concat-      [ "The following Bower ", packages, " ", are, " installed, but not "-      , "declared as ", dependencies, " in your bower.json file:"-      ])-    ] ++-      bulletedList runPackageName (NonEmpty.toList pkgNames)--warnUnacceptableVersions :: NonEmpty (PackageName, String) -> Box-warnUnacceptableVersions pkgs =-  let singular = NonEmpty.length pkgs == 1-      pl a b = if singular then b else a--      packages'  = pl "packages'" "package's"-      packages   = pl "packages" "package"-      anyOfThese = pl "any of these" "this"-      these      = pl "these" "this"-      versions   = pl "versions" "version"-  in vcat $-    [ para (concat-      [ "The following installed Bower ", packages', " ", versions, " could "-      , "not be parsed:"-      ])-    ] ++-      bulletedList showTuple (NonEmpty.toList pkgs)-      ++-    [ spacer-    , para (concat-      ["Links to types in ", anyOfThese, " ", packages, " will not work. In "-      , "order to make links work, edit your bower.json to specify an "-      , "acceptable version or version range for ", these, " ", packages, ", "-      , "and rerun `bower install`."-      ])-    ]-  where-  showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ tag--printWarnings :: [PackageWarning] -> IO ()-printWarnings = printToStderr . renderWarnings
psc-publish/Main.hs view
@@ -1,315 +1,38 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}  module Main where -import Prelude hiding (userError)--import Data.Maybe-import Data.Char (isSpace)-import Data.String (fromString)-import Data.List (stripPrefix, isSuffixOf, (\\), nubBy)-import Data.List.Split (splitOn)-import Data.List.NonEmpty (NonEmpty(..))-import Data.Version-import Data.Function (on)-import Safe (headMay)--import qualified Data.ByteString.Lazy.Char8 as BL-import qualified Data.Text as T-+import Data.Version (Version(..), showVersion) import qualified Data.Aeson as A-import Data.Aeson.BetterErrors--import Control.Applicative-import Control.Category ((>>>))-import Control.Arrow ((***))-import Control.Exception (catch, try)-import Control.Monad.Trans.Except-import Control.Monad.Error.Class (MonadError(..))-import Control.Monad.Writer+import qualified Data.ByteString.Lazy.Char8 as BL -import System.Directory (doesFileExist)-import System.Process (readProcess)-import System.Exit (exitFailure)-import qualified System.FilePath.Glob as Glob+import Options.Applicative hiding (str) -import Web.Bower.PackageMeta (PackageMeta(..), BowerError(..), PackageName,-                              runPackageName, parsePackageName, Repository(..))-import qualified Web.Bower.PackageMeta as Bower+import qualified Paths_purescript as Paths+import Language.PureScript.Publish -import qualified Language.PureScript as P (version)-import qualified Language.PureScript.Docs as D-import Utils-import ErrorsWarnings+dryRun :: Parser Bool+dryRun = switch $+     long "dry-run"+  <> help "Produce no output, and don't require a tagged version to be checked out."  main :: IO ()-main = do-  pkg <- preparePackage-  BL.putStrLn (A.encode pkg)---- | Attempt to retrieve package metadata from the current directory.--- Calls exitFailure if no package metadata could be retrieved.-preparePackage :: IO D.UploadedPackage-preparePackage =-  runPrepareM preparePackage'-    >>= either (\e -> printError e >> exitFailure)-               handleWarnings-  where-  handleWarnings (result, warns) = do-    printWarnings warns-    return result--newtype PrepareM a =-  PrepareM { unPrepareM :: WriterT [PackageWarning] (ExceptT PackageError IO) a }-  deriving (Functor, Applicative, Monad,-            MonadWriter [PackageWarning],-            MonadError PackageError)---- This MonadIO instance ensures that IO errors don't crash the program.-instance MonadIO PrepareM where-  liftIO act =-    lift' (try act) >>= either (otherError . IOExceptionThrown) return-    where-    lift' :: IO a -> PrepareM a-    lift' = PrepareM . lift . lift--runPrepareM :: PrepareM a -> IO (Either PackageError (a, [PackageWarning]))-runPrepareM = runExceptT . runWriterT . unPrepareM--warn :: PackageWarning -> PrepareM ()-warn w = tell [w]--userError :: UserError -> PrepareM a-userError = throwError . UserError--internalError :: InternalError -> PrepareM a-internalError = throwError . InternalError--otherError :: OtherError -> PrepareM a-otherError = throwError . OtherError--catchLeft :: Applicative f => Either a b -> (a -> f b) -> f b-catchLeft a f = either f pure a--preparePackage' :: PrepareM D.UploadedPackage-preparePackage' = do-  exists <- liftIO (doesFileExist "bower.json")-  unless exists (userError BowerJSONNotFound)--  pkgMeta <- liftIO (Bower.decodeFile "bower.json")-                    >>= flip catchLeft (userError . CouldntParseBowerJSON)-  (pkgVersionTag, pkgVersion) <- getVersionFromGitTag-  pkgGithub                   <- getBowerInfo pkgMeta-  (pkgBookmarks, pkgModules)  <- getModulesAndBookmarks--  let declaredDeps = map fst (bowerDependencies pkgMeta ++-                              bowerDevDependencies pkgMeta)-  pkgResolvedDependencies     <- getResolvedDependencies declaredDeps--  let pkgUploader = D.NotYetKnown-  let pkgCompilerVersion = P.version--  return D.Package{..}--getModulesAndBookmarks :: PrepareM ([D.Bookmark], [D.Module])-getModulesAndBookmarks = do-  (inputFiles, depsFiles) <- liftIO getInputAndDepsFiles-  liftIO (D.parseAndDesugar inputFiles depsFiles renderModules)-    >>= either (userError . ParseAndDesugarError) return-  where-  renderModules bookmarks modules =-    return (bookmarks, map D.convertModule modules)--getVersionFromGitTag :: PrepareM (String, Version)-getVersionFromGitTag = do-  out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""-  let vs = map trimWhitespace (lines out)-  case mapMaybe parseMay vs of-    []  -> userError TagMustBeCheckedOut-    [x] -> return x-    xs  -> userError (AmbiguousVersions (map snd xs))-  where-  trimWhitespace =-    dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse-  parseMay str =-    (str,) <$> D.parseVersion' (dropPrefix "v" str)-  dropPrefix prefix str =-    fromMaybe str (stripPrefix prefix str)--getBowerInfo :: PackageMeta -> PrepareM (D.GithubUser, D.GithubRepo)-getBowerInfo = either (userError . BadRepositoryField) return . tryExtract-  where-  tryExtract pkgMeta =-    case bowerRepository pkgMeta of-      Nothing -> Left RepositoryFieldMissing-      Just Repository{..} -> do-        unless (repositoryType == "git")-          (Left (BadRepositoryType repositoryType))-        maybe (Left NotOnGithub) Right (extractGithub repositoryUrl)--extractGithub :: String -> Maybe (D.GithubUser, D.GithubRepo)-extractGithub =-  stripPrefix "git://github.com/"-   >>> fmap (splitOn "/")-   >=> takeTwo-   >>> fmap (D.GithubUser *** (D.GithubRepo . dropDotGit))--  where-  takeTwo :: [a] -> Maybe (a, a)-  takeTwo [x, y] = Just (x, y)-  takeTwo _ = Nothing--  dropDotGit :: String -> String-  dropDotGit str-    | ".git" `isSuffixOf` str = take (length str - 4) str-    | otherwise = str--readProcess' :: String -> [String] -> String -> PrepareM String-readProcess' prog args stdin = do-  out <- liftIO (catch (Right <$> readProcess prog args stdin)-                       (return . Left))-  either (otherError . ProcessFailed prog args) return out--data DependencyStatus-  = Missing-    -- ^ Listed in bower.json, but not installed.-  | NoResolution-    -- ^ In the output of `bower list --json --offline`, there was no-    -- _resolution key. This can be caused by adding the dependency using-    -- `bower link`, or simply copying it into bower_components instead of-    -- installing it normally.-  | ResolvedOther String-    -- ^ Resolved, but to something other than a version. The String argument-    -- is the resolution type. The values it can take that I'm aware of are-    -- "commit" and "branch".-  | ResolvedVersion String-    -- ^ Resolved to a version. The String argument is the resolution tag (eg,-    -- "v0.1.0").-  deriving (Show, Eq)---- Go through all bower dependencies which contain purescript code, and--- extract their versions.------ In the case where a bower dependency is taken from a particular version,--- that's easy; take that version. In any other case (eg, a branch, or a commit--- sha) we print a warning that documentation links will not work, and avoid--- linking to documentation for any types from that package.------ The rationale for this is: people will prefer to use a released version--- where possible. If they are not using a released version, then this is--- probably for a reason. However, docs are only ever available for released--- versions. Therefore there will probably be no version of the docs which is--- appropriate to link to, and we should omit links.-getResolvedDependencies :: [PackageName] -> PrepareM [(PackageName, Version)]-getResolvedDependencies declaredDeps = do-  depsBS <- fromString <$> readProcess' "bower" ["list", "--json", "--offline"] ""--  -- Check for undeclared dependencies-  toplevels <- catchJSON (parse asToplevelDependencies depsBS)-  warnUndeclared declaredDeps toplevels--  deps <- catchJSON (parse asResolvedDependencies depsBS)-  handleDeps deps--  where-  catchJSON = flip catchLeft (internalError . JSONError FromBowerList)---- | Extracts all dependencies and their versions from---   `bower list --json --offline`-asResolvedDependencies :: Parse BowerError [(PackageName, DependencyStatus)]-asResolvedDependencies = nubBy ((==) `on` fst) <$> go-  where-  go =-    fmap (fromMaybe []) $-      keyMay "dependencies" $-        (++) <$> eachInObjectWithKey (parsePackageName . T.unpack)-                                     asDependencyStatus-             <*> (concatMap snd <$> eachInObject asResolvedDependencies)---- | Extracts only the top level dependency names from the output of---   `bower list --json --offline`-asToplevelDependencies :: Parse BowerError [PackageName]-asToplevelDependencies =-  fmap (map fst) $-    key "dependencies" $-      eachInObjectWithKey (parsePackageName . T.unpack) (return ())--asDependencyStatus :: Parse e DependencyStatus-asDependencyStatus = do-  isMissing <- keyOrDefault "missing" False asBool-  if isMissing-    then-      return Missing-    else-      key "pkgMeta" $-        keyOrDefault "_resolution" NoResolution $ do-          type_ <- key "type" asString-          case type_ of-            "version" -> ResolvedVersion <$> key "tag" asString-            other -> return (ResolvedOther other)--warnUndeclared :: [PackageName] -> [PackageName] -> PrepareM ()-warnUndeclared declared actual =-  mapM_ (warn . UndeclaredDependency) (actual \\ declared)--handleDeps ::-  [(PackageName, DependencyStatus)] -> PrepareM [(PackageName, Version)]-handleDeps deps = do-  let (missing, noVersion, installed) = partitionDeps deps-  case missing of-    (x:xs) ->-      userError (MissingDependencies (x :| xs))-    [] -> do-      mapM_ (warn . NoResolvedVersion) noVersion-      withVersions <- catMaybes <$> mapM tryExtractVersion' installed-      filterM (liftIO . isPureScript . bowerDir . fst) withVersions-+main = execParser opts >>= publish   where-  partitionDeps = foldr go ([], [], [])-  go (pkgName, d) (ms, os, is) =-    case d of-      Missing           -> (pkgName : ms, os, is)-      NoResolution      -> (ms, pkgName : os, is)-      ResolvedOther _   -> (ms, pkgName : os, is)-      ResolvedVersion v -> (ms, os, (pkgName, v) : is)--  bowerDir pkgName = "bower_components/" ++ runPackageName pkgName--  -- Try to extract a version, and warn if unsuccessful.-  tryExtractVersion' pair =-    maybe (warn (UnacceptableVersion pair) >> return Nothing)-          (return . Just)-          (tryExtractVersion pair)--tryExtractVersion :: (PackageName, String) -> Maybe (PackageName, Version)-tryExtractVersion (pkgName, tag) =-  let tag' = fromMaybe tag (stripPrefix "v" tag)-  in  (pkgName,) <$> D.parseVersion' tag'---- | Returns whether it looks like there is a purescript package checked out--- in the given directory.-isPureScript :: FilePath -> IO Bool-isPureScript dir = do-  files <- Glob.globDir1 purescriptSourceFiles dir-  return (not (null files))--getInputAndDepsFiles :: IO ([FilePath], [(PackageName, FilePath)])-getInputAndDepsFiles = do-  inputFiles <- globRelative purescriptSourceFiles-  depsFiles' <- globRelative purescriptDepsFiles-  return (inputFiles, mapMaybe withPackageName depsFiles')+  opts        = info (version <*> helper <*> dryRun) infoModList+  infoModList = fullDesc <> headerInfo <> footerInfo+  headerInfo  = header "psc-publish - Generates documentation packages for upload to http://pursuit.purescript.org"+  footerInfo  = footer $ "psc-publish " ++ showVersion Paths.version -withPackageName :: FilePath -> Maybe (PackageName, FilePath)-withPackageName fp = (,fp) <$> getPackageName fp+  version :: Parser (a -> a)+  version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden -getPackageName :: FilePath -> Maybe PackageName-getPackageName fp = do-  let xs = splitOn "/" fp-  ys <- stripPrefix ["bower_components"] xs-  y <- headMay ys-  case Bower.mkPackageName y of-    Right name -> Just name-    Left _ -> Nothing+publish :: Bool -> IO ()+publish isDryRun =+  if isDryRun+    then do+      let dummyVersion = ("0.0.0", Version [0,0,0] [])+      _ <- preparePackage $ defaultPublishOptions { publishGetVersion = return dummyVersion }+      putStrLn "Dry run completed, no errors."+    else do+      pkg <- preparePackage defaultPublishOptions+      BL.putStrLn (A.encode pkg)
− psc-publish/Utils.hs 
@@ -1,22 +0,0 @@--module Utils where--import Data.List-import Data.Maybe-import System.Directory-import qualified System.FilePath.Glob as Glob---- | Glob relative to the current directory, and produce relative pathnames.-globRelative :: Glob.Pattern -> IO [FilePath]-globRelative pat = do-  currentDir <- getCurrentDirectory-  filesAbsolute <- Glob.globDir1 pat currentDir-  return (mapMaybe (stripPrefix (currentDir ++ "/")) filesAbsolute)---- | Glob pattern for PureScript source files.-purescriptSourceFiles :: Glob.Pattern-purescriptSourceFiles = Glob.compile "src/**/*.purs"---- | Glob pattern for PureScript dependency files.-purescriptDepsFiles :: Glob.Pattern-purescriptDepsFiles = Glob.compile "bower_components/*/src/**/*.purs"
psc/Main.hs view
@@ -68,14 +68,14 @@         hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)       let filePathMap = M.fromList $ map (\(fp, P.Module _ mn _ _) -> (mn, fp)) ms           makeActions = buildMakeActions outputDir filePathMap foreigns usePrefix-      e <- runMake opts $ P.make makeActions ms+      e <- runMake opts $ P.make makeActions (map snd ms)       case e of         Left errs -> do           hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)           exitFailure         Right (_, warnings') -> do           when (P.nonEmpty warnings') $-            putStrLn (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')+            hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')           exitSuccess  readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
psci/Completion.hs view
@@ -6,6 +6,7 @@ import Data.Function (on) import Data.Traversable (traverse) +import Control.Arrow (second) import Control.Applicative ((<$>), (<*>)) import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT) import Control.Monad.Trans.State.Strict@@ -196,13 +197,15 @@   getTypeName _ = Nothing  identNames :: P.Module -> [(N.Ident, P.Declaration)]-identNames = nubOnFst . mapMaybe getDeclName . P.exportedDeclarations+identNames = nubOnFst . concatMap getDeclNames . P.exportedDeclarations   where-  getDeclName :: P.Declaration -> Maybe (P.Ident, P.Declaration)-  getDeclName d@(P.ValueDeclaration ident _ _ _)  = Just (ident, d)-  getDeclName d@(P.ExternDeclaration ident _) = Just (ident, d)-  getDeclName (P.PositionedDeclaration _ _ d) = getDeclName d-  getDeclName _ = Nothing+  getDeclNames :: P.Declaration -> [(P.Ident, P.Declaration)]+  getDeclNames d@(P.ValueDeclaration ident _ _ _)  = [(ident, d)]+  getDeclNames d@(P.TypeDeclaration ident _ ) = [(ident, d)]+  getDeclNames d@(P.ExternDeclaration ident _) = [(ident, d)]+  getDeclNames d@(P.TypeClassDeclaration _ _ _ ds) = map (second (const d)) $ concatMap getDeclNames ds+  getDeclNames (P.PositionedDeclaration _ _ d) = getDeclNames d+  getDeclNames _ = []  dctorNames :: P.Module -> [(N.ProperName, P.Declaration)] dctorNames = nubOnFst . concatMap go . P.exportedDeclarations
psci/PSCi.hs view
@@ -21,7 +21,7 @@ module PSCi where  import Data.Foldable (traverse_)-import Data.List (intercalate, nub, sort, isPrefixOf)+import Data.List (intercalate, nub, sort) import Data.Traversable (traverse) import Data.Tuple (swap) import Data.Version (showVersion)@@ -91,12 +91,15 @@  -- File helpers +onFirstFileMatching :: Monad m => (b -> m (Maybe a)) -> [b] -> m (Maybe a)+onFirstFileMatching f pathVariants = runMaybeT . msum $ map (MaybeT . f) pathVariants+ -- | -- Locates the node executable. -- Checks for either @nodejs@ or @node@. -- findNodeProcess :: IO (Maybe String)-findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names+findNodeProcess = onFirstFileMatching findExecutable names   where names = ["nodejs", "node"]  -- |@@ -219,12 +222,12 @@ -- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration. -- createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module-createTemporaryModuleForKind PSCiState{psciImportedModules = imports} typ =+createTemporaryModuleForKind PSCiState{psciImportedModules = imports, psciLetBindings = lets} typ =   let     moduleName = P.ModuleName [P.ProperName "$PSCI"]     itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ   in-    P.Module [] moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing+    P.Module [] moduleName ((importDecl `map` imports) ++ lets ++ [itDecl]) Nothing  -- | -- Makes a volatile module to execute the current imports.@@ -256,11 +259,11 @@   either (throwError . P.singleError . f) return e  make :: PSCiState -> [(Either P.RebuildPolicy FilePath, P.Module)] -> P.Make P.Environment-make PSCiState{..} ms = P.make actions' (psciLoadedModules ++ ms)+make PSCiState{..} ms = P.make actions' (map snd (psciLoadedModules ++ ms))     where     filePathMap = M.fromList $ (first P.getModuleName . swap) `map` (psciLoadedModules ++ ms)     actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False-    actions' = actions { P.progress = \s -> unless ("Compiling $PSCI" `isPrefixOf` s) $ liftIO . putStrLn $ s }+    actions' = actions { P.progress = const (return ()) }  -- | -- Takes a value declaration and evaluates it with the current state.@@ -486,18 +489,27 @@     then f absPath     else PSCI . outputStrLn $ "Couldn't locate: " ++ filePath +-- |+-- Attempts to read initial commands from '.psci' in the present working+-- directory then the user's home+-- loadUserConfig :: IO (Maybe [Command])-loadUserConfig = do-  configFile <- (</> ".psci") <$> getCurrentDirectory-  exists <- doesFileExist configFile-  if exists-  then do-    ls <- lines <$> readFile configFile-    case mapM parseCommand ls of-      Left err -> print err >> exitFailure-      Right cs -> return $ Just cs-  else-    return Nothing+loadUserConfig = onFirstFileMatching readCommands pathGetters+  where+  pathGetters = [getCurrentDirectory, getHomeDirectory]+  readCommands :: IO FilePath -> IO (Maybe [Command])+  readCommands path = do+    configFile <- (</> ".psci") <$> path+    exists <- doesFileExist configFile+    if exists+    then do+      ls <- lines <$> readFile configFile+      case mapM parseCommand ls of+        Left err -> print err >> exitFailure+        Right cs -> return $ Just cs+    else+      return Nothing+  -- | Checks if the Console module is defined consoleIsDefined :: [P.Module] -> Bool
psci/tests/Main.hs view
@@ -8,12 +8,13 @@ import Control.Monad.Writer (runWriterT) import Control.Monad.Trans.Except (runExceptT) -import Data.List (isSuffixOf, sort)+import Data.List (sort)  import System.Exit (exitFailure) import System.Console.Haskeline import System.FilePath ((</>))-import System.Directory (getCurrentDirectory, getDirectoryContents)+import System.Directory (getCurrentDirectory)+import qualified System.FilePath.Glob as Glob  import Test.HUnit @@ -48,10 +49,15 @@   , (":mo", [":module"])   , (":b", [":browse"]) -  -- :browse should complete modules-  , (":b Prel", [":b Prelude", ":b Prelude.Unsafe"])-  , (":b Prelude.", [":b Prelude.Unsafe"])+  -- :browse should complete module names+  , (":b Control.Monad.E",    map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])+  , (":b Control.Monad.Eff.", map (":b Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"]) +  -- import should complete module names+  , ("import Control.Monad.E",    map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])+  , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])+  , ("import qualified Control.Monad.Eff.", map ("import qualified Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])+   -- :load, :module should complete file paths   , (":l psci/tests/data/", [":l psci/tests/data/Sample.purs"])   , (":module psci/tests/data/", [":module psci/tests/data/Sample.purs"])@@ -66,8 +72,8 @@   , (":show a", [])    -- :type should complete values and data constructors in scope-  , (":type Prelude.Unsafe.un", [":type Prelude.Unsafe.unsafeIndex"])-  , (":type un", [":type unit"])+  , (":type Control.Monad.Eff.Console.lo", [":type Control.Monad.Eff.Console.log"])+  , (":type uni", [":type unit"])   , (":type E", [":type EQ"])    -- :kind should complete types in scope@@ -79,25 +85,19 @@   , (":type EQ ", [])   , (":kind Ordering ", []) -  -- import should complete module names-  , ("import Control.Monad.S", ["import Control.Monad.ST"])-  , ("import qualified Control.Monad.S", ["import qualified Control.Monad.ST"])-  , ("import Control.Monad.", map ("import Control.Monad." ++)-                                  ["Eff", "ST"])-   -- a few other import tests   , ("impor", ["import"])   , ("import q", ["import qualified"])-  , ("import ", map ("import " ++) allModuleNames ++ ["import qualified"])-  , ("import Prelude.Unsafe ", [])+  , ("import ", map ("import " ++) supportModules ++ ["import qualified"])+  , ("import Prelude ", [])    -- String and number literals should not be completed   , ("\"hi", [])   , ("34", [])    -- Identifiers and data constructors should be completed-  , ("un", ["unit"])-  , ("Debug.Trace.", map ("Debug.Trace." ++) ["print", "trace"])+  , ("uni", ["unit"])+  , ("Control.Monad.Eff.Class.", ["Control.Monad.Eff.Class.liftEff"])   , ("G", ["GT"])   , ("Prelude.L", ["Prelude.LT"]) @@ -107,14 +107,6 @@   , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])   ]   where-  allModuleNames = [ "Assert"-                   , "Control.Monad.Eff"-                   , "Control.Monad.ST"-                   , "Data.Function"-                   , "Debug.Trace"-                   , "Prelude"-                   , "Prelude.Unsafe"-                   ]  assertCompletedOk :: (String, [String]) -> Assertion assertCompletedOk (line, expecteds) = do@@ -131,10 +123,12 @@ getPSCiState :: IO PSCiState getPSCiState = do   cwd <- getCurrentDirectory-  let preludeDir = cwd </> "tests" </> "prelude"-      jsDir = preludeDir </> "js"-  modulesOrFirstError <- loadAllModules [ preludeDir </> "Prelude.purs" ]-  jsFiles <- map (jsDir </>) . filter (".js" `isSuffixOf`) <$> getDirectoryContents jsDir+  let supportDir = cwd </> "tests" </> "support" </> "flattened"+  let supportFiles ext = Glob.globDir1 (Glob.compile ("*." ++ ext)) supportDir+  pursFiles <- supportFiles "purs"+  jsFiles   <- supportFiles "js"++  modulesOrFirstError <- loadAllModules pursFiles   foreignFiles <- forM jsFiles (\f -> (f,) <$> readFile f)   Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles   case modulesOrFirstError of@@ -148,3 +142,15 @@ controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))   where   s = P.moduleNameFromString++supportModules :: [String]+supportModules =+  [ "Control.Monad.Eff.Class"+  , "Control.Monad.Eff.Console"+  , "Control.Monad.Eff"+  , "Control.Monad.Eff.Unsafe"+  , "Control.Monad.ST"+  , "Data.Function"+  , "Prelude"+  , "Test.Assert"+  ]
purescript.cabal view
@@ -1,5 +1,5 @@ name: purescript-version: 0.7.1.0+version: 0.7.2.0 cabal-version: >=1.8 build-type: Simple license: MIT@@ -20,6 +20,8 @@  extra-source-files: examples/passing/*.purs                   , examples/failing/*.purs+                  , tests/support/flattened/*.purs+                  , tests/support/flattened/*.js  source-repository head     type: git@@ -48,7 +50,11 @@                    text -any,                    split -any,                    language-javascript == 0.5.*,-                   syb -any+                   syb -any,+                   Glob >= 0.7 && < 0.8,+                   process >= 1.2.0 && < 1.3,+                   safe >= 0.3.9 && < 0.4,+                   semigroups >= 0.16.2 && < 0.17      exposed-modules: Language.PureScript                      Language.PureScript.AST@@ -140,6 +146,11 @@                      Language.PureScript.Docs.ParseAndDesugar                      Language.PureScript.Docs.Utils.MonoidExtras +                     Language.PureScript.Publish+                     Language.PureScript.Publish.Utils+                     Language.PureScript.Publish.ErrorsWarnings+                     Language.PureScript.Publish.BoxesHelpers+                      Control.Monad.Unify                      Control.Monad.Supply                      Control.Monad.Supply.Class@@ -179,7 +190,7 @@ executable psc-docs     build-depends: base >=4 && <5, purescript -any,                    optparse-applicative >= 0.10.0, process -any, mtl -any,-                   split -any, ansi-wl-pprint -any, directory -any, +                   split -any, ansi-wl-pprint -any, directory -any,                    filepath -any, Glob -any     main-is: Main.hs     buildable: True@@ -190,24 +201,15 @@     ghc-options: -Wall -O2  executable psc-publish-    build-depends: base >=4 && <5, purescript -any,-                   optparse-applicative >= 0.10.0, process -any, mtl -any,-                   pattern-arrows -any, aeson -any, bytestring -any,-                   directory -any, transformers -any, text -any, containers-                   -any, boxes -any, split -any, Glob -any, aeson-better-errors-                   -any, transformers-compat -any, bower-json -any, semigroups-                   -any, safe -any+    build-depends: base >=4 && <5, purescript -any, bytestring -any, aeson -any, optparse-applicative -any     main-is: Main.hs     buildable: True     hs-source-dirs: psc-publish-    other-modules: Utils-                   ErrorsWarnings-                   BoxesHelpers     ghc-options: -Wall -O2  executable psc-hierarchy     build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,-                   process -any, mtl -any, parsec -any, filepath -any, directory -any, +                   process -any, mtl -any, parsec -any, filepath -any, directory -any,                    Glob -any     main-is: Main.hs     buildable: True@@ -225,7 +227,7 @@                        directory -any,                        mtl -any,                        transformers -any,-                       transformers-compat -any, +                       transformers-compat -any,                        optparse-applicative >= 0.10.0,                        Glob -any   ghc-options:         -Wall -O2@@ -234,7 +236,8 @@ test-suite tests     build-depends: base >=4 && <5, containers -any, directory -any,                    filepath -any, mtl -any, parsec -any, purescript -any,-                   transformers -any, process -any, transformers-compat -any, time -any+                   transformers -any, process -any, transformers-compat -any, time -any,+                   Glob -any     type: exitcode-stdio-1.0     main-is: Main.hs     buildable: True@@ -244,7 +247,7 @@     build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,                    mtl -any, optparse-applicative >= 0.10.0, parsec -any,                    haskeline >= 0.7.0.0, purescript -any, transformers -any,-                   transformers-compat -any, process -any, HUnit -any, time -any, +                   transformers-compat -any, process -any, HUnit -any, time -any,                    Glob -any     type: exitcode-stdio-1.0     main-is: Main.hs
src/Language/PureScript/AST/SourcePos.hs view
@@ -57,11 +57,15 @@   , spanEnd :: SourcePos   } deriving (Eq, Ord, Show, D.Data, D.Typeable) +displayStartEndPos :: SourceSpan -> String+displayStartEndPos sp =+  displaySourcePos (spanStart sp) ++ " - " +++  displaySourcePos (spanEnd sp)+ displaySourceSpan :: SourceSpan -> String displaySourceSpan sp =   spanName sp ++ " " ++-    displaySourcePos (spanStart sp) ++ " - " ++-    displaySourcePos (spanEnd sp)+    displayStartEndPos sp   instance A.ToJSON SourceSpan where   toJSON SourceSpan{..} =
src/Language/PureScript/Bundle.hs view
@@ -10,6 +10,9 @@ -- -- | Bundles compiled PureScript modules for the browser. --+-- This module takes as input the individual generated modules from 'Language.PureScript.Make' and+-- performs dead code elimination, filters empty modules,+-- and generates the final Javascript bundle. -----------------------------------------------------------------------------  {-# LANGUAGE PatternGuards #-}@@ -18,11 +21,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE RecordWildCards #-} --- | Bundle javascript for use in the browser.------ This module takes as input the individual generated modules from 'Language.PureScript.Make' and--- performs dead code elimination, filters empty modules,--- and generates the final Javascript bundle. module Language.PureScript.Bundle (      bundle    , ModuleIdentifier(..)@@ -52,17 +50,17 @@ data ErrorMessage   = UnsupportedModulePath String   | InvalidTopLevel-  | UnableToParseModule+  | UnableToParseModule String   | UnsupportedExport-  | ErrorInFile FilePath ErrorMessage+  | ErrorInModule ModuleIdentifier ErrorMessage   deriving Show --- | Modules are either "regular modules" (i.e. those generated by psc-make) or foreign modules.-data ModuleType -  = Regular -  | Foreign +-- | Modules are either "regular modules" (i.e. those generated by psc) or foreign modules.+data ModuleType+  = Regular+  | Foreign   deriving (Show, Eq, Ord)-  + -- | A module is identified by its module name and its type. data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Eq, Ord) @@ -75,11 +73,11 @@  -- | An export is either a "regular export", which exports a name from the regular module we are in, -- or a reexport of a declaration in the corresponding foreign module.--- --- Regular exports are labelled, since they might re-export an operator with another name. -data ExportType -  = RegularExport String -  | ForeignReexport +--+-- Regular exports are labelled, since they might re-export an operator with another name.+data ExportType+  = RegularExport String+  | ForeignReexport   deriving (Show, Eq, Ord)  -- | There are four types of module element we are interested in:@@ -91,37 +89,42 @@ -- -- Each is labelled with the original AST node which generated it, so that we can dump it back -- into the output during codegen.-data ModuleElement +data ModuleElement   = Require JSNode String ModuleIdentifier   | Member JSNode Bool String [JSNode] [Key]   | ExportsList [(ExportType, String, JSNode, [Key])]   | Other JSNode   deriving Show --- | A module is just a list of elements of the types listed above. +-- | A module is just a list of elements of the types listed above. data Module = Module ModuleIdentifier [ModuleElement] deriving Show-  + -- | Prepare an error message for consumption by humans. printErrorMessage :: ErrorMessage -> [String] printErrorMessage (UnsupportedModulePath s) =   [ "A CommonJS module has an unsupported name (" ++ show s ++ ")."   , "The following file names are supported:"-  , "  1) index.js (psc-make native modules)"-  , "  2) foreign.js (psc-make foreign modules)"+  , "  1) index.js (psc native modules)"+  , "  2) foreign.js (psc foreign modules)"   ] printErrorMessage InvalidTopLevel =-  [ "Expected a list of source elements at the top level." ] -printErrorMessage UnableToParseModule =-  [ "The module could not be parsed." ]+  [ "Expected a list of source elements at the top level." ]+printErrorMessage (UnableToParseModule err) =+  [ "The module could not be parsed:"+  , err+  ] printErrorMessage UnsupportedExport =   [ "An export was unsupported. Exports can be defined in one of two ways: "   , "  1) exports.name = ..."   , "  2) exports = { ... }"   ]-printErrorMessage (ErrorInFile filename e) =-  ("Error in file " ++ show filename ++ ":")+printErrorMessage (ErrorInModule mid e) =+  ("Error in module " ++ displayIdentifier mid ++ ":")   : ""   : map ("  " ++) (printErrorMessage e)+  where+  displayIdentifier (ModuleIdentifier name ty) =+    name ++ " (" ++ show ty ++ ")"  -- | Unpack the node inside a JSNode. This is useful when pattern matching. node :: JSNode -> Node@@ -130,18 +133,18 @@  -- | Calculate the ModuleIdentifier which a require(...) statement imports. checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Maybe ModuleIdentifier-checkImportPath "./foreign" m _     = +checkImportPath "./foreign" m _     =   Just (ModuleIdentifier (moduleName m) Foreign)-checkImportPath name        _ names +checkImportPath name        _ names   | name `S.member` names = Just (ModuleIdentifier name Regular) checkImportPath _           _ _     = Nothing  -- | Compute the dependencies of all elements in a module, and add them to the tree.--- +-- -- Members and exports can have dependencies. A dependency is of one of the following forms: -- -- 1) module.name or member["name"]---    +-- --    where module was imported using -- --    var module = require("Module.Name");@@ -151,7 +154,7 @@ --    where name is the name of a member defined in the current module. withDeps :: Module -> Module withDeps (Module modulePath es) = Module modulePath (map expandDeps es)-  where    +  where   -- | Collects all modules which are imported, so that we can identify dependencies of the first type.   imports :: [(String, ModuleIdentifier)]   imports = mapMaybe toImport es@@ -159,7 +162,7 @@     toImport :: ModuleElement -> Maybe (String, ModuleIdentifier)     toImport (Require _ nm mid) = Just (nm, mid)     toImport _ = Nothing-    +   -- | Collects all member names in scope, so that we can identify dependencies of the second type.   boundNames :: [String]   boundNames = mapMaybe toBoundName es@@ -175,7 +178,7 @@       where       expand (ty, nm, n1, _) = (ty, nm, n1, nub (dependencies modulePath n1))   expandDeps other = other-  +   dependencies :: ModuleIdentifier -> JSNode -> [(ModuleIdentifier, String)]   dependencies m = everything (++) (mkQ [] toReference)     where@@ -197,29 +200,31 @@     toReference _ = []  -- | Attempt to create a Module from a Javascript AST.--- --- Each type of module element is matched using pattern guards, and everything else is bundled into the +--+-- Each type of module element is matched using pattern guards, and everything else is bundled into the -- Other constructor. toModule :: forall m. (Applicative m, MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSNode -> m Module-toModule mids mid top +toModule mids mid top   | JSSourceElementsTop ns <- node top = Module mid <$> mapM toModuleElement ns-  | otherwise = throwError InvalidTopLevel-  where      +  | otherwise = err InvalidTopLevel+  where+  err = throwError . ErrorInModule mid+   toModuleElement :: JSNode -> m ModuleElement   toModuleElement n     | JSVariables var [ varIntro ] _ <- node n-    , JSLiteral "var" <- node var +    , JSLiteral "var" <- node var     , JSVarDecl impN [ eq, req, impP ] <- node varIntro     , JSIdentifier importName <- node impN     , JSLiteral "=" <- node eq     , JSIdentifier "require" <- node req-    , JSArguments _ [ impS ] _ <- node impP +    , JSArguments _ [ impS ] _ <- node impP     , JSStringLiteral _ importPath <- node impS     , Just importPath' <- checkImportPath importPath mid mids     = pure (Require n importName importPath')   toModuleElement n     | JSVariables var [ varIntro ] _ <- node n-    , JSLiteral "var" <- node var +    , JSLiteral "var" <- node var     , JSVarDecl declN (eq : decl) <- node varIntro     , JSIdentifier name <- node declN     , JSLiteral "=" <- node eq@@ -253,11 +258,11 @@     = ExportsList <$> mapM toExport (filter (not . isSeparator) (map node props))     where     toExport :: Node -> m (ExportType, String, JSNode, [Key])-    toExport (JSPropertyNameandValue name _ [val] ) = -      (,,val,[]) <$> exportType (node val) +    toExport (JSPropertyNameandValue name _ [val] ) =+      (,,val,[]) <$> exportType (node val)                  <*> extractLabel (node name)-    toExport _ = throwError UnsupportedExport-  +    toExport _ = err UnsupportedExport+     exportType :: Node -> m ExportType     exportType (JSMemberDot [f] _ _)       | JSIdentifier "$foreign" <- node f@@ -266,13 +271,13 @@       | JSIdentifier "$foreign" <- node f       = pure ForeignReexport     exportType (JSIdentifier s) = pure (RegularExport s)-    exportType _ = throwError UnsupportedExport-  +    exportType _ = err UnsupportedExport+     extractLabel :: Node -> m String     extractLabel (JSStringLiteral _ nm) = pure nm     extractLabel (JSIdentifier nm) = pure nm-    extractLabel _ = throwError UnsupportedExport-    +    extractLabel _ = err UnsupportedExport+     isSeparator :: Node -> Bool     isSeparator (JSLiteral ",") = True     isSeparator _ = False@@ -282,9 +287,9 @@ compile :: [Module] -> [ModuleIdentifier] -> [Module] compile modules [] = modules compile modules entryPoints = filteredModules-  where    +  where   (graph, _, vertexFor) = graphFromEdges verts-  +   -- | The vertex set   verts :: [(ModuleElement, Key, [Key])]   verts = do@@ -292,12 +297,12 @@     concatMap (toVertices mid) els     where     -- | Create a set of vertices for a module element.-    -- +    --     -- Some special cases worth commenting on:     --     -- 1) Regular exports which simply export their own name do not count as dependencies.     --    Regular exports which rename and reexport an operator do count, however.-    -- +    --     -- 2) Require statements don't contribute towards dependencies, since they effectively get     --    inlined wherever they are used inside other module elements.     toVertices :: ModuleIdentifier -> ModuleElement -> [(ModuleElement, Key, [Key])]@@ -308,18 +313,18 @@       toVertex (RegularExport nm, nm1, _, ks) | nm /= nm1 = Just (m, (p, nm1), ks)       toVertex _ = Nothing     toVertices _ _ = []-  +   -- | The set of vertices whose connected components we are interested in keeping.   entryPointVertices :: [Vertex]   entryPointVertices = catMaybes $ do     (_, k@(mid, _), _) <- verts     guard $ mid `elem` entryPoints     return (vertexFor k)-  +   -- | The set of vertices reachable from an entry point   reachableSet :: S.Set Vertex   reachableSet = S.fromList (concatMap (reachable graph) entryPointVertices)-  +   filteredModules :: [Module]   filteredModules = map filterUsed modules     where@@ -328,29 +333,29 @@       where       go :: [ModuleElement] -> [ModuleElement]       go [] = []-      go (d : Other semi : rest) +      go (d : Other semi : rest)         | JSLiteral ";" <- node semi         , not (isDeclUsed d)         = go rest-      go (d : rest) +      go (d : rest)         | not (isDeclUsed d) = go rest         | otherwise = d : go rest-        +       -- | Filter out the exports for members which aren't used.       filterExports :: ModuleElement -> ModuleElement       filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)       filterExports me = me-    +       isDeclUsed :: ModuleElement -> Bool       isDeclUsed (Member _ _ nm _ _) = isKeyUsed (mid, nm)       isDeclUsed _ = True-      +       isKeyUsed :: Key -> Bool-      isKeyUsed k +      isKeyUsed k         | Just me <- vertexFor k = me `S.member` reachableSet         | otherwise = False-  --- | Topologically sort the module dependency graph, so that when we generate code, modules can be ++-- | Topologically sort the module dependency graph, so that when we generate code, modules can be -- defined in the right order. sortModules :: [Module] -> [Module] sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))@@ -358,11 +363,11 @@   (graph, nodeFor, _) = graphFromEdges $ do     m@(Module mid els) <- modules     return (m, mid, mapMaybe getKey els)-    +   getKey :: ModuleElement -> Maybe ModuleIdentifier-  getKey (Require _ _ mi) = Just mi +  getKey (Require _ _ mi) = Just mi   getKey _ = Nothing-  + -- | A module is empty if it contains no exported members (in other words, -- if the only things left after dead code elimination are module imports and -- "other" foreign code).@@ -376,7 +381,7 @@   isElementEmpty (Require _ _ _) = True   isElementEmpty (Other _) = True   isElementEmpty _ = False-  + -- | Generate code for a set of modules, including a call to main(). -- -- Modules get defined on the global PS object, as follows:@@ -386,10 +391,10 @@ --       ... --     })(PS["Module.Name"] = PS["Module.Name"] || {}); ----- In particular, a module and its foreign imports share the same namespace inside PS. +-- In particular, a module and its foreign imports share the same namespace inside PS. -- This saves us from having to generate unique names for a module and its foreign imports, -- and is safe since a module shares a namespace with its foreign imports in PureScript as well--- (so there is no way to have overlaps in code generated by psc-make).+-- (so there is no way to have overlaps in code generated by psc). codeGen :: Maybe String -- ^ main module         -> String -- ^ namespace         -> [Module] -- ^ input modules@@ -401,85 +406,85 @@     where     declToJS :: ModuleElement -> [JSNode]     declToJS (Member n _ _ _ _) = [n]-    declToJS (Other n) = [n]       -    declToJS (Require _ nm req) = -      [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n  " ]) -                        [ NN (JSVarDecl (sp (JSIdentifier nm)) +    declToJS (Other n) = [n]+    declToJS (Require _ nm req) =+      [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n  " ])+                        [ NN (JSVarDecl (sp (JSIdentifier nm))                                         [ sp (JSLiteral "=")                                         , moduleReference sp (moduleName req)                                         ])                         ]                         (nt (JSLiteral ";"))) ]     declToJS (ExportsList exps) = map toExport exps-      -      where ++      where       toExport :: (ExportType, String, JSNode, [Key]) -> JSNode       toExport (_, nm, val, _) =-        NN (JSExpression [ NN (JSMemberSquare [ NT (JSIdentifier "exports") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n  " ] ] -                                              (nt (JSLiteral "[")) +        NN (JSExpression [ NN (JSMemberSquare [ NT (JSIdentifier "exports") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n  " ] ]+                                              (nt (JSLiteral "["))                                               (NN (JSExpression [ nt (JSStringLiteral '"' nm) ]))                                               (nt (JSLiteral "]")))                          , NN (JSOperator (sp (JSLiteral "=")))                          , reindent val                          , nt (JSLiteral ";")                          ])-      +       reindent :: JSNode -> JSNode       reindent (NT n _ _) = sp n       reindent nn = nn-  +   indent :: [JSNode] -> [JSNode]   indent = everywhere (mkT squash)     where     squash (NT n pos ann) = NT n (keepCol pos) (map splat ann)     squash nn = nn-    +     splat (CommentA pos s) = CommentA (keepCol pos) s     splat (WhiteSpace pos w) = WhiteSpace (keepCol pos) w     splat ann = ann-    +     keepCol (TokenPn _ _ c) = TokenPn 0 0 (c + 2)-    +   prelude :: [JSNode]-  prelude = +  prelude =     [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ CommentA tokenPosnEmpty ("// Generated by psc-bundle " ++ showVersion Paths.version)                                                            , WhiteSpace tokenPosnEmpty "\n"-                                                           ]) -                                                           [ NN (JSVarDecl (sp (JSIdentifier optionsNamespace)) +                                                           ])+                                                           [ NN (JSVarDecl (sp (JSIdentifier optionsNamespace))                                                                            [ sp (JSLiteral "=")-                                                                           , NN (JSObjectLiteral (sp (JSLiteral "{")) +                                                                           , NN (JSObjectLiteral (sp (JSLiteral "{"))                                                                                                  []                                                                                                  (sp (JSLiteral "}")))                                                                            ])-                                                           ] +                                                           ]                                                            (nt (JSLiteral ";")))     , lf     ]-    +   moduleReference :: (Node -> JSNode) -> String -> JSNode-  moduleReference f mn = -    NN (JSMemberSquare [ f (JSIdentifier optionsNamespace) ] -                       (nt (JSLiteral "[")) +  moduleReference f mn =+    NN (JSMemberSquare [ f (JSIdentifier optionsNamespace) ]+                       (nt (JSLiteral "["))                        (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))                        (nt (JSLiteral "]")))-    +   wrap :: String -> [JSNode] -> [JSNode]-  wrap mn ds = -    [ NN (JSExpression [ NN (JSExpressionParen (nt (JSLiteral "(")) -                                               (NN (JSExpression [ NN (JSFunctionExpression (nt (JSLiteral "function")) -                                                                                            [] -                                                                                            (nt (JSLiteral "(") ) [nt (JSIdentifier "exports")] (nt (JSLiteral ")")) -                                                                                            (NN (JSBlock [sp (JSLiteral "{")] +  wrap mn ds =+    [ NN (JSExpression [ NN (JSExpressionParen (nt (JSLiteral "("))+                                               (NN (JSExpression [ NN (JSFunctionExpression (nt (JSLiteral "function"))+                                                                                            []+                                                                                            (nt (JSLiteral "(") ) [nt (JSIdentifier "exports")] (nt (JSLiteral ")"))+                                                                                            (NN (JSBlock [sp (JSLiteral "{")]                                                                                                          (lf : ds)                                                                                                          [nl (JSLiteral "}")])))]))                                                (nt (JSLiteral ")")))-                       , NN (JSArguments (nt (JSLiteral "(")) +                       , NN (JSArguments (nt (JSLiteral "("))                                          [ NN (JSExpression [ moduleReference nt mn                                                             , NN (JSOperator (sp (JSLiteral "=")))                                                             , NN (JSExpressionBinary "||"-                                                                                     [ moduleReference sp mn ] -                                                                                     (sp (JSLiteral "||")) -                                                                                     [ emptyObj ]) +                                                                                     [ moduleReference sp mn ]+                                                                                     (sp (JSLiteral "||"))+                                                                                     [ emptyObj ])                                                             ])                                          ]                                          (nt (JSLiteral ")")))@@ -489,30 +494,30 @@     ]     where     emptyObj = NN (JSObjectLiteral (sp (JSLiteral "{")) [] (nt (JSLiteral "}")))-    +   runMain :: String -> [JSNode]-  runMain mn = -    [ NN (JSExpression [ NN (JSMemberDot [ NN (JSMemberSquare [ nl (JSIdentifier optionsNamespace) ] -                                                              (nt (JSLiteral "[")) -                                                              (NN (JSExpression [ nt (JSStringLiteral '"' mn) ])) +  runMain mn =+    [ NN (JSExpression [ NN (JSMemberDot [ NN (JSMemberSquare [ nl (JSIdentifier optionsNamespace) ]+                                                              (nt (JSLiteral "["))+                                                              (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))                                                               (nt (JSLiteral "]")))-                                         ] -                                         (nt (JSLiteral ".")) +                                         ]+                                         (nt (JSLiteral "."))                                          (nt (JSIdentifier "main")))                        , NN (JSArguments (nt (JSLiteral "(")) [] (nt (JSLiteral ")")))                        ])     , nt (JSLiteral ";")     ]-  +   nt :: Node -> JSNode   nt n = NT n tokenPosnEmpty []-  +   lf :: JSNode   lf = NT (JSLiteral "") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]-  +   sp :: Node -> JSNode   sp n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ]-  +   nl :: Node -> JSNode   nl n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ] @@ -520,21 +525,21 @@ -- This function performs dead code elimination, filters empty modules -- and generates and prints the final Javascript bundle. bundle :: forall m. (Applicative m, MonadError ErrorMessage m)-       => [(ModuleIdentifier, String)] -- ^ The input modules.  Each module should be javascript rendered from 'Language.PureScript.Make' or @psc-make@.+       => [(ModuleIdentifier, String)] -- ^ The input modules.  Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.        -> [ModuleIdentifier] -- ^ Entry points.  These module identifiers are used as the roots for dead-code elimination        -> Maybe String -- ^ An optional main module.        -> String -- ^ The namespace (e.g. PS).        -> m String bundle inputStrs entryPoints mainModule namespace = do   input <- forM inputStrs $ \(ident, js) -> do-                ast <- either (const $ throwError UnableToParseModule) pure $ parse js (moduleName ident)+                ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident)                 return (ident, ast)    let mids = S.fromList (map (moduleName . fst) input)-    +   modules <- mapM (fmap withDeps . uncurry (toModule mids)) input-  +   let compiled = compile modules entryPoints       sorted   = sortModules (filter (not . isModuleEmpty) compiled)-  +   return (codeGen mainModule namespace sorted)
src/Language/PureScript/CodeGen/JS.hs view
@@ -274,7 +274,7 @@       failedPatternError names = JSUnary JSNew $ JSApp (JSVar "Error") [JSBinary Add (JSStringLiteral errorMessage) (JSArrayLiteral $ zipWith valueError names vals)]        errorMessage :: String-      errorMessage = "Failed pattern match" ++ maybe "" ((" at " ++) . displaySourceSpan) maybeSpan ++ ": "+      errorMessage = "Failed pattern match" ++ maybe "" (((" at " ++ runModuleName mn ++ " ") ++) . displayStartEndPos) maybeSpan ++ ": "        valueError :: String -> JS -> JS       valueError _ l@(JSNumericLiteral _) = l
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs view
@@ -156,11 +156,11 @@   , binary semigroupString (C.<>) Add   , binary semigroupString (C.++) Add -  , binary latticeBoolean (C.&&) And-  , binary latticeBoolean (C.||) Or-  , binaryFunction latticeBoolean C.inf And-  , binaryFunction latticeBoolean C.sup Or-  , unary complementedLatticeBoolean C.not Not+  , binary booleanAlgebraBoolean (C.&&) And+  , binary booleanAlgebraBoolean (C.||) Or+  , binaryFunction booleanAlgebraBoolean C.conj And+  , binaryFunction booleanAlgebraBoolean C.disj Or+  , unary booleanAlgebraBoolean C.not Not    , binary' C.dataIntBits (C..|.) BitwiseOr   , binary' C.dataIntBits (C..&.) BitwiseAnd@@ -269,25 +269,25 @@ semiringNumber = (C.prelude, C.semiringNumber)  semiringInt :: (String, String)-semiringInt = (C.dataInt, C.semiringInt)+semiringInt = (C.prelude, C.semiringInt)  ringNumber :: (String, String) ringNumber = (C.prelude, C.ringNumber)  ringInt :: (String, String)-ringInt = (C.dataInt, C.ringInt)+ringInt = (C.prelude, C.ringInt)  moduloSemiringNumber :: (String, String) moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)  moduloSemiringInt :: (String, String)-moduloSemiringInt = (C.dataInt, C.moduloSemiringInt)+moduloSemiringInt = (C.prelude, C.moduloSemiringInt)  eqNumber :: (String, String) eqNumber = (C.prelude, C.eqNumber)  eqInt :: (String, String)-eqInt = (C.dataInt, C.eqInt)+eqInt = (C.prelude, C.eqInt)  eqString :: (String, String) eqString = (C.prelude, C.eqNumber)@@ -299,7 +299,7 @@ ordNumber = (C.prelude, C.ordNumber)  ordInt :: (String, String)-ordInt = (C.dataInt, C.ordInt)+ordInt = (C.prelude, C.ordInt)  semigroupString :: (String, String) semigroupString = (C.prelude, C.semigroupString)@@ -307,11 +307,8 @@ boundedBoolean :: (String, String) boundedBoolean = (C.prelude, C.boundedBoolean) -latticeBoolean :: (String, String)-latticeBoolean = (C.prelude, C.latticeBoolean)--complementedLatticeBoolean :: (String, String)-complementedLatticeBoolean = (C.prelude, C.complementedLatticeBoolean)+booleanAlgebraBoolean :: (String, String)+booleanAlgebraBoolean = (C.prelude, C.booleanAlgebraBoolean)  semigroupoidArr :: (String, String) semigroupoidArr = (C.prelude, C.semigroupoidArr)
src/Language/PureScript/Constants.hs view
@@ -97,11 +97,11 @@ not :: String not = "not" -sup :: String-sup = "sup"+conj :: String+conj = "conj" -inf :: String-inf = "inf"+disj :: String+disj = "disj"  mod :: String mod = "mod"@@ -229,11 +229,8 @@ boundedBoolean :: String boundedBoolean = "boundedBoolean" -latticeBoolean :: String-latticeBoolean = "latticeBoolean"--complementedLatticeBoolean :: String-complementedLatticeBoolean = "complementedLatticeBoolean"+booleanAlgebraBoolean :: String+booleanAlgebraBoolean = "booleanAlgebraBoolean"  semigroupString :: String semigroupString = "semigroupString"@@ -273,9 +270,6 @@  dataFunction :: String dataFunction = "Data_Function"--dataInt :: String-dataInt = "Data_Int"  dataIntBits :: String dataIntBits = "Data_Int_Bits"
src/Language/PureScript/Environment.hs view
@@ -214,9 +214,17 @@ -- Check whether a type is an object -- isObject :: Type -> Bool-isObject = (==) tyObject . extract-  where extract (TypeApp t _) = t-        extract t = t+isObject = isTypeOrApplied tyObject++-- |+-- Check whether a type is a function+--+isFunction :: Type -> Bool+isFunction = isTypeOrApplied tyFunction++isTypeOrApplied :: Type -> Type -> Bool+isTypeOrApplied t1 (TypeApp t2 _) = t1 == t2+isTypeOrApplied t1 t2 = t1 == t2  -- | -- Smart constructor for function types
src/Language/PureScript/Errors.hs view
@@ -35,7 +35,7 @@ import Control.Arrow(first)  import Language.PureScript.AST-import Language.PureScript.Environment (isObject)+import Language.PureScript.Environment (isObject, isFunction) import Language.PureScript.Pretty import Language.PureScript.Types import Language.PureScript.Names@@ -120,7 +120,8 @@   | TransitiveExportError DeclarationRef [DeclarationRef]   | ShadowedName Ident   | WildcardInferredType Type-  | NotExhaustivePattern [[Binder]]+  | NotExhaustivePattern [[Binder]] Bool+  | OverlappingPattern [[Binder]] Bool   | ClassOperator ProperName Ident   deriving (Show) @@ -230,7 +231,8 @@   (TransitiveExportError _ _)   -> "TransitiveExportError"   (ShadowedName _)              -> "ShadowedName"   (WildcardInferredType _)      -> "WildcardInferredType"-  (NotExhaustivePattern _)      -> "NotExhaustivePattern"+  (NotExhaustivePattern _ _)    -> "NotExhaustivePattern"+  (OverlappingPattern _ _)      -> "OverlappingPattern"   (ClassOperator _ _)           -> "ClassOperator"  -- |@@ -561,11 +563,16 @@             ]     goSimple (WildcardInferredType ty) =       line $ "The wildcard type definition has the inferred type " ++ prettyPrintType ty-    goSimple (NotExhaustivePattern bs) =-      paras $ [ line "Pattern could not be determined to cover all cases."+    goSimple (NotExhaustivePattern bs b) =+      indent $ paras $ [ line "Pattern could not be determined to cover all cases."               , line $ "The definition has the following uncovered cases:\n"-              , indent $ Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))-              ]+              , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))+              ] ++ if not b then [line "..."] else []+    goSimple (OverlappingPattern bs b) =+      indent $ paras $ [ line "Redundant cases have been detected."+              , line $ "The definition has the following redundant cases:\n"+              , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))+              ] ++ if not b then [line "..."] else []     go (NotYetDefined names err) =       paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"             , indent $ go err@@ -670,7 +677,7 @@                                              , indent . line $ "import " ++ show im ++ " hiding (" ++ nm ++ ")"                                              ]     suggestions' (TypesDoNotUnify t1 t2)-      | any isObject [t1, t2] = [line "Note that function composition in PureScript is defined using (<<<)"]+      | isObject t1 && isFunction t2 = [line "Note that function composition in PureScript is defined using (<<<)"]       | otherwise             = []     suggestions' _ = [] @@ -740,13 +747,13 @@ -- Pretty print multiple errors -- prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String-prettyPrintMultipleErrors full = flip evalState M.empty . prettyPrintMultipleErrorsWith Error "Error:" "Multiple errors:" full+prettyPrintMultipleErrors full = flip evalState M.empty . prettyPrintMultipleErrorsWith Error "Error found:" "Multiple errors found:" full  -- | -- Pretty print multiple warnings -- prettyPrintMultipleWarnings :: Bool -> MultipleErrors ->  String-prettyPrintMultipleWarnings full = flip evalState M.empty . prettyPrintMultipleErrorsWith Warning "Warning:" "Multiple warnings:" full+prettyPrintMultipleWarnings full = flip evalState M.empty . prettyPrintMultipleErrorsWith Warning "Warning found:" "Multiple warnings found:" full  prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> State UnknownMap String prettyPrintMultipleErrorsWith level intro _ full  (MultipleErrors [e]) = do
src/Language/PureScript/Linter.hs view
@@ -53,7 +53,12 @@   lintDeclaration :: Declaration -> m ()   lintDeclaration d =     let (f, _, _, _, _) = everythingWithContextOnValues moduleNames mempty mappend stepD stepE stepB def def-    in tell (f d)++        f' :: Declaration -> MultipleErrors+        f' (PositionedDeclaration pos _ dec) = onErrorMessages (PositionedError pos) (f' dec)+        f' dec = f dec++    in tell (f' d)     where     def s _ = (s, mempty)
src/Language/PureScript/Linter/Exhaustive.hs view
@@ -31,6 +31,7 @@  import Control.Monad (unless) import Control.Applicative+import Control.Arrow (first, second) import Control.Monad.Writer.Class  import Language.PureScript.AST.Binders@@ -107,31 +108,30 @@  -- | -- Find the uncovered set between two binders:--- the first binder is the case we are trying to cover the second one is the matching binder+-- the first binder is the case we are trying to cover, the second one is the matching binder ---missingCasesSingle :: Environment -> ModuleName -> Binder -> Binder -> [Binder]-missingCasesSingle _ _ _ NullBinder = []-missingCasesSingle _ _ _ (VarBinder _) = []+missingCasesSingle :: Environment -> ModuleName -> Binder -> Binder -> ([Binder], Maybe Bool)+missingCasesSingle _ _ _ NullBinder = ([], Just True)+missingCasesSingle _ _ _ (VarBinder _) = ([], Just True) missingCasesSingle env mn (VarBinder _) b = missingCasesSingle env mn NullBinder b missingCasesSingle env mn br (NamedBinder _ bl) = missingCasesSingle env mn br bl missingCasesSingle env mn NullBinder cb@(ConstructorBinder con _) =-  concatMap (\cp -> missingCasesSingle env mn cp cb) allPatterns+  (concatMap (\cp -> fst $ missingCasesSingle env mn cp cb) allPatterns, Just True)   where   allPatterns = map (\(p, t) -> ConstructorBinder (qualifyName p mn con) (initialize $ length t))                   $ getConstructors env mn con missingCasesSingle env mn cb@(ConstructorBinder con bs) (ConstructorBinder con' bs')-  | con == con' = map (ConstructorBinder con) (missingCasesMultiple env mn bs bs')-  | otherwise = [cb]-missingCasesSingle _ _ NullBinder (ArrayBinder bs)-  | null bs = [] -  | otherwise = []+  | con == con' = let (bs'', pr) = missingCasesMultiple env mn bs bs' in (map (ConstructorBinder con) bs'', pr)+  | otherwise = ([cb], Just False) missingCasesSingle env mn NullBinder (ObjectBinder bs) =-  map (ObjectBinder . zip (map fst bs)) allMisses+  (map (ObjectBinder . zip (map fst bs)) allMisses, pr)   where-  allMisses = missingCasesMultiple env mn (initialize $ length bs) (map snd bs)+  (allMisses, pr) = missingCasesMultiple env mn (initialize $ length bs) (map snd bs) missingCasesSingle env mn (ObjectBinder bs) (ObjectBinder bs') =-  map (ObjectBinder . zip sortedNames) $ uncurry (missingCasesMultiple env mn) (unzip binders)+  (map (ObjectBinder . zip sortedNames) allMisses, pr)   where+  (allMisses, pr) = uncurry (missingCasesMultiple env mn) (unzip binders)+   sortNames = sortBy (compare `on` fst)    (sbs, sbs') = (sortNames bs, sortNames bs')@@ -145,12 +145,12 @@   compBS e s b b' = (s, compB e b b')    (sortedNames, binders) = unzip $ genericMerge (compBS NullBinder) sbs sbs'-missingCasesSingle _ _ NullBinder (BooleanBinder b) = [BooleanBinder $ not b]+missingCasesSingle _ _ NullBinder (BooleanBinder b) = ([BooleanBinder $ not b], Just True) missingCasesSingle _ _ (BooleanBinder bl) (BooleanBinder br)-  | bl == br = []-  | otherwise = [BooleanBinder bl]+  | bl == br = ([], Just True)+  | otherwise = ([BooleanBinder bl], Just False) missingCasesSingle env mn b (PositionedBinder _ _ cb) = missingCasesSingle env mn b cb-missingCasesSingle _ _ b _ = [b]+missingCasesSingle _ _ b _ = ([b], Nothing)  -- | -- Returns the uncovered set of binders@@ -178,15 +178,14 @@ --       redundant or not, but uncovered at least. If we use `y` instead, we'll need to have a redundancy checker --       (which ought to be available soon), or increase the complexity of the algorithm. ---missingCasesMultiple :: Environment -> ModuleName -> [Binder] -> [Binder] -> [[Binder]]+missingCasesMultiple :: Environment -> ModuleName -> [Binder] -> [Binder] -> ([[Binder]], Maybe Bool) missingCasesMultiple env mn = go   where-  go [] _ = []-  go (x:xs) (y:ys)-    | null miss = map (x :) (go xs ys)-    | otherwise = map (: xs) miss ++ map (x :) (go xs ys)+  go [] [] = ([], pure True)+  go (x:xs) (y:ys) = (map (: xs) miss1 ++ map (x :) miss2, liftA2 (&&) pr1 pr2)     where-    miss = missingCasesSingle env mn x y+    (miss1, pr1) = missingCasesSingle env mn x y+    (miss2, pr2) = go xs ys   go _ _ = error "Argument lengths did not match in missingCasesMultiple."  -- |@@ -213,13 +212,15 @@ -- | -- Returns the uncovered set of case alternatives ---missingCases :: Environment -> ModuleName -> [Binder] -> CaseAlternative -> [[Binder]]+missingCases :: Environment -> ModuleName -> [Binder] -> CaseAlternative -> ([[Binder]], Maybe Bool) missingCases env mn uncovered ca = missingCasesMultiple env mn uncovered (caseAlternativeBinders ca) -missingAlternative :: Environment -> ModuleName -> CaseAlternative -> [Binder] -> [[Binder]]+missingAlternative :: Environment -> ModuleName -> CaseAlternative -> [Binder] -> ([[Binder]], Maybe Bool) missingAlternative env mn ca uncovered-  | isExhaustiveGuard (caseAlternativeResult ca) = missingCases env mn uncovered ca-  | otherwise = [uncovered]+  | isExhaustiveGuard (caseAlternativeResult ca) = mcases +  | otherwise = ([uncovered], snd mcases)+  where+  mcases = missingCases env mn uncovered ca  -- | -- Main exhaustivity checking function@@ -228,20 +229,29 @@ -- Then, returns the uncovered set of case alternatives. --  checkExhaustive :: forall m. (MonadWriter MultipleErrors m) => Environment -> ModuleName -> [CaseAlternative] -> m ()-checkExhaustive env mn cas = makeResult . nub $ foldl' step [initial] cas+checkExhaustive env mn cas = makeResult . first nub $ foldl' step ([initial], (pure True, [])) cas   where-  step :: [[Binder]] -> CaseAlternative -> [[Binder]]-  step uncovered ca = concatMap (missingAlternative env mn ca) uncovered+  step :: ([[Binder]], (Maybe Bool, [[Binder]])) -> CaseAlternative -> ([[Binder]], (Maybe Bool, [[Binder]]))+  step (uncovered, (nec, redundant)) ca =+    let (missed, pr) = unzip (map (missingAlternative env mn ca) uncovered)+        cond = or <$> sequenceA pr+    in (concat missed, (liftA2 (&&) cond nec,+                         if fromMaybe True cond then redundant else caseAlternativeBinders ca : redundant))+    where+    sequenceA = foldr (liftA2 (:)) (pure [])    initial :: [Binder]   initial = initialize numArgs     where     numArgs = length . caseAlternativeBinders . head $ cas  -  makeResult :: [[Binder]] -> m ()-  makeResult bss = unless (null bss) tellWarning +  makeResult :: ([[Binder]], (Maybe Bool, [[Binder]])) -> m ()+  makeResult (bss, (_, bss')) =+    do unless (null bss) tellExhaustive+       unless (null bss') tellRedundant     where-    tellWarning = tell . errorMessage $ NotExhaustivePattern bss+    tellExhaustive = tell . errorMessage . uncurry NotExhaustivePattern . second null . splitAt 5 $ bss+    tellRedundant = tell . errorMessage . uncurry OverlappingPattern . second null . splitAt 5 $ bss'  -- | -- Exhaustivity checking over a list of declarations
src/Language/PureScript/Make.hs view
@@ -136,10 +136,10 @@ -- make :: forall m. (Functor m, Applicative m, Monad m, MonadReader Options m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)      => MakeActions m-     -> [(Either RebuildPolicy FilePath, Module)]+     -> [Module]      -> m Environment make MakeActions{..} ms = do-  (sorted, graph) <- sortModules $ map (importPrim . snd) ms+  (sorted, graph) <- sortModules $ map importPrim ms   mapM_ lint sorted   toRebuild <- foldM (\s (Module _ moduleName' _ _) -> do     inputTimestamp <- getInputTimestamp moduleName'@@ -282,6 +282,8 @@         foreignFile = outputDir </> filePath </> "foreign.js"         prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]         js = unlines $ map ("// " ++) prefix ++ [pjs]+    verboseErrorsEnabled <- asks optionsVerboseErrors+    when verboseErrorsEnabled $ progress $ "Writing " ++ jsFile     writeTextFile jsFile js     maybe (return ()) (writeTextFile foreignFile . snd) $ mn `M.lookup` foreigns     writeTextFile externsFile exts@@ -295,16 +297,11 @@     traverse (const $ getModificationTime path) $ guard exists    readTextFile :: FilePath -> Make String-  readTextFile path = do-    verboseErrorsEnabled <- asks optionsVerboseErrors-    makeIO (const (SimpleErrorWrapper $ CannotReadFile path)) $ do-      when verboseErrorsEnabled $ putStrLn $ "Reading " ++ path-      readFile path+  readTextFile path = makeIO (const (SimpleErrorWrapper $ CannotReadFile path)) $ readFile path    writeTextFile :: FilePath -> String -> Make ()   writeTextFile path text = makeIO (const (SimpleErrorWrapper $ CannotWriteFile path)) $ do     mkdirp path-    putStrLn $ "Writing " ++ path     writeFile path text     where     mkdirp :: FilePath -> IO ()
+ src/Language/PureScript/Publish.hs view
@@ -0,0 +1,361 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Language.PureScript.Publish+  ( preparePackage+  , preparePackage'+  , PrepareM()+  , runPrepareM+  , PublishOptions(..)+  , defaultPublishOptions+  , getGitWorkingTreeStatus+  , requireCleanWorkingTree+  , getVersionFromGitTag+  , getBowerInfo+  , getModulesAndBookmarks+  , getResolvedDependencies+  ) where++import Prelude hiding (userError)++import Data.Maybe+import Data.Char (isSpace)+import Data.String (fromString)+import Data.List (stripPrefix, isSuffixOf, (\\), nubBy)+import Data.List.Split (splitOn)+import Data.List.NonEmpty (NonEmpty(..))+import Data.Version+import Data.Function (on)+import Safe (headMay)+import Data.Aeson.BetterErrors+import qualified Data.Text as T++import Control.Applicative+import Control.Category ((>>>))+import Control.Arrow ((***))+import Control.Exception (catch, try)+import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)+import Control.Monad.Trans.Except+import Control.Monad.Error.Class (MonadError(..))+import Control.Monad.Writer++import System.Directory (doesFileExist, findExecutable)+import System.Process (readProcess)+import System.Exit (exitFailure)+import System.FilePath (pathSeparator)+import qualified System.FilePath.Glob as Glob+import qualified System.Info++import Web.Bower.PackageMeta (PackageMeta(..), BowerError(..), PackageName,+                              runPackageName, parsePackageName, Repository(..))+import qualified Web.Bower.PackageMeta as Bower++import qualified Language.PureScript as P (version)+import qualified Language.PureScript.Docs as D+import Language.PureScript.Publish.Utils+import Language.PureScript.Publish.ErrorsWarnings++data PublishOptions = PublishOptions+  { -- | How to obtain the version tag and version that the data being+    -- generated will refer to.+    publishGetVersion :: PrepareM (String, Version)+  }++defaultPublishOptions :: PublishOptions+defaultPublishOptions = PublishOptions+  { publishGetVersion = getVersionFromGitTag+  }++-- | Attempt to retrieve package metadata from the current directory.+-- Calls exitFailure if no package metadata could be retrieved.+preparePackage :: PublishOptions -> IO D.UploadedPackage+preparePackage opts =+  runPrepareM (preparePackage' opts)+    >>= either (\e -> printError e >> exitFailure)+               handleWarnings+  where+  handleWarnings (result, warns) = do+    printWarnings warns+    return result++newtype PrepareM a =+  PrepareM { unPrepareM :: WriterT [PackageWarning] (ExceptT PackageError IO) a }+  deriving (Functor, Applicative, Monad,+            MonadWriter [PackageWarning],+            MonadError PackageError)++-- This MonadIO instance ensures that IO errors don't crash the program.+instance MonadIO PrepareM where+  liftIO act =+    lift' (try act) >>= either (otherError . IOExceptionThrown) return+    where+    lift' :: IO a -> PrepareM a+    lift' = PrepareM . lift . lift++runPrepareM :: PrepareM a -> IO (Either PackageError (a, [PackageWarning]))+runPrepareM = runExceptT . runWriterT . unPrepareM++warn :: PackageWarning -> PrepareM ()+warn w = tell [w]++userError :: UserError -> PrepareM a+userError = throwError . UserError++internalError :: InternalError -> PrepareM a+internalError = throwError . InternalError++otherError :: OtherError -> PrepareM a+otherError = throwError . OtherError++catchLeft :: Applicative f => Either a b -> (a -> f b) -> f b+catchLeft a f = either f pure a++preparePackage' :: PublishOptions -> PrepareM D.UploadedPackage+preparePackage' opts = do+  exists <- liftIO (doesFileExist "bower.json")+  unless exists (userError BowerJSONNotFound)++  requireCleanWorkingTree++  pkgMeta <- liftIO (Bower.decodeFile "bower.json")+                    >>= flip catchLeft (userError . CouldntParseBowerJSON)+  (pkgVersionTag, pkgVersion) <- publishGetVersion opts+  pkgGithub                   <- getBowerInfo pkgMeta+  (pkgBookmarks, pkgModules)  <- getModulesAndBookmarks++  let declaredDeps = map fst (bowerDependencies pkgMeta +++                              bowerDevDependencies pkgMeta)+  pkgResolvedDependencies     <- getResolvedDependencies declaredDeps++  let pkgUploader = D.NotYetKnown+  let pkgCompilerVersion = P.version++  return D.Package{..}++getModulesAndBookmarks :: PrepareM ([D.Bookmark], [D.Module])+getModulesAndBookmarks = do+  (inputFiles, depsFiles) <- liftIO getInputAndDepsFiles+  liftIO (D.parseAndDesugar inputFiles depsFiles renderModules)+    >>= either (userError . ParseAndDesugarError) return+  where+  renderModules bookmarks modules =+    return (bookmarks, map D.convertModule modules)++data TreeStatus = Clean | Dirty deriving (Show, Eq, Ord, Enum)++getGitWorkingTreeStatus :: PrepareM TreeStatus+getGitWorkingTreeStatus = do+  out <- readProcess' "git" ["status", "--porcelain"] ""+  return $+    if null . filter (not . null) . lines $ out+      then Clean+      else Dirty++requireCleanWorkingTree :: PrepareM ()+requireCleanWorkingTree = do+  status <- getGitWorkingTreeStatus+  unless (status == Clean) $+    userError DirtyWorkingTree++getVersionFromGitTag :: PrepareM (String, Version)+getVersionFromGitTag = do+  out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""+  let vs = map trimWhitespace (lines out)+  case mapMaybe parseMay vs of+    []  -> userError TagMustBeCheckedOut+    [x] -> return x+    xs  -> userError (AmbiguousVersions (map snd xs))+  where+  trimWhitespace =+    dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse+  parseMay str =+    (str,) <$> D.parseVersion' (dropPrefix "v" str)+  dropPrefix prefix str =+    fromMaybe str (stripPrefix prefix str)++getBowerInfo :: PackageMeta -> PrepareM (D.GithubUser, D.GithubRepo)+getBowerInfo = either (userError . BadRepositoryField) return . tryExtract+  where+  tryExtract pkgMeta =+    case bowerRepository pkgMeta of+      Nothing -> Left RepositoryFieldMissing+      Just Repository{..} -> do+        unless (repositoryType == "git")+          (Left (BadRepositoryType repositoryType))+        maybe (Left NotOnGithub) Right (extractGithub repositoryUrl)++extractGithub :: String -> Maybe (D.GithubUser, D.GithubRepo)+extractGithub =+  stripPrefix "git://github.com/"+   >>> fmap (splitOn "/")+   >=> takeTwo+   >>> fmap (D.GithubUser *** (D.GithubRepo . dropDotGit))++  where+  takeTwo :: [a] -> Maybe (a, a)+  takeTwo [x, y] = Just (x, y)+  takeTwo _ = Nothing++  dropDotGit :: String -> String+  dropDotGit str+    | ".git" `isSuffixOf` str = take (length str - 4) str+    | otherwise = str++readProcess' :: String -> [String] -> String -> PrepareM String+readProcess' prog args stdin = do+  out <- liftIO (catch (Right <$> readProcess prog args stdin)+                       (return . Left))+  either (otherError . ProcessFailed prog args) return out++data DependencyStatus+  = Missing+    -- ^ Listed in bower.json, but not installed.+  | NoResolution+    -- ^ In the output of `bower list --json --offline`, there was no+    -- _resolution key. This can be caused by adding the dependency using+    -- `bower link`, or simply copying it into bower_components instead of+    -- installing it normally.+  | ResolvedOther String+    -- ^ Resolved, but to something other than a version. The String argument+    -- is the resolution type. The values it can take that I'm aware of are+    -- "commit" and "branch".+  | ResolvedVersion String+    -- ^ Resolved to a version. The String argument is the resolution tag (eg,+    -- "v0.1.0").+  deriving (Show, Eq)++-- Go through all bower dependencies which contain purescript code, and+-- extract their versions.+--+-- In the case where a bower dependency is taken from a particular version,+-- that's easy; take that version. In any other case (eg, a branch, or a commit+-- sha) we print a warning that documentation links will not work, and avoid+-- linking to documentation for any types from that package.+--+-- The rationale for this is: people will prefer to use a released version+-- where possible. If they are not using a released version, then this is+-- probably for a reason. However, docs are only ever available for released+-- versions. Therefore there will probably be no version of the docs which is+-- appropriate to link to, and we should omit links.+getResolvedDependencies :: [PackageName] -> PrepareM [(PackageName, Version)]+getResolvedDependencies declaredDeps = do+  bower <- findBowerExecutable+  depsBS <- fromString <$> readProcess' bower ["list", "--json", "--offline"] ""++  -- Check for undeclared dependencies+  toplevels <- catchJSON (parse asToplevelDependencies depsBS)+  warnUndeclared declaredDeps toplevels++  deps <- catchJSON (parse asResolvedDependencies depsBS)+  handleDeps deps++  where+  catchJSON = flip catchLeft (internalError . JSONError FromBowerList)++findBowerExecutable :: PrepareM String+findBowerExecutable = do+  mname <- liftIO . runMaybeT . msum . map (MaybeT . findExecutable) $ names+  maybe (userError (BowerExecutableNotFound names)) return mname+  where+  names = case System.Info.os of+    "mingw32" -> ["bower", "bower.cmd"]+    _         -> ["bower"]++-- | Extracts all dependencies and their versions from+--   `bower list --json --offline`+asResolvedDependencies :: Parse BowerError [(PackageName, DependencyStatus)]+asResolvedDependencies = nubBy ((==) `on` fst) <$> go+  where+  go =+    fmap (fromMaybe []) $+      keyMay "dependencies" $+        (++) <$> eachInObjectWithKey (parsePackageName . T.unpack)+                                     asDependencyStatus+             <*> (concatMap snd <$> eachInObject asResolvedDependencies)++-- | Extracts only the top level dependency names from the output of+--   `bower list --json --offline`+asToplevelDependencies :: Parse BowerError [PackageName]+asToplevelDependencies =+  fmap (map fst) $+    key "dependencies" $+      eachInObjectWithKey (parsePackageName . T.unpack) (return ())++asDependencyStatus :: Parse e DependencyStatus+asDependencyStatus = do+  isMissing <- keyOrDefault "missing" False asBool+  if isMissing+    then+      return Missing+    else+      key "pkgMeta" $+        keyOrDefault "_resolution" NoResolution $ do+          type_ <- key "type" asString+          case type_ of+            "version" -> ResolvedVersion <$> key "tag" asString+            other -> return (ResolvedOther other)++warnUndeclared :: [PackageName] -> [PackageName] -> PrepareM ()+warnUndeclared declared actual =+  mapM_ (warn . UndeclaredDependency) (actual \\ declared)++handleDeps ::+  [(PackageName, DependencyStatus)] -> PrepareM [(PackageName, Version)]+handleDeps deps = do+  let (missing, noVersion, installed) = partitionDeps deps+  case missing of+    (x:xs) ->+      userError (MissingDependencies (x :| xs))+    [] -> do+      mapM_ (warn . NoResolvedVersion) noVersion+      withVersions <- catMaybes <$> mapM tryExtractVersion' installed+      filterM (liftIO . isPureScript . bowerDir . fst) withVersions++  where+  partitionDeps = foldr go ([], [], [])+  go (pkgName, d) (ms, os, is) =+    case d of+      Missing           -> (pkgName : ms, os, is)+      NoResolution      -> (ms, pkgName : os, is)+      ResolvedOther _   -> (ms, pkgName : os, is)+      ResolvedVersion v -> (ms, os, (pkgName, v) : is)++  bowerDir pkgName = "bower_components/" ++ runPackageName pkgName++  -- Try to extract a version, and warn if unsuccessful.+  tryExtractVersion' pair =+    maybe (warn (UnacceptableVersion pair) >> return Nothing)+          (return . Just)+          (tryExtractVersion pair)++tryExtractVersion :: (PackageName, String) -> Maybe (PackageName, Version)+tryExtractVersion (pkgName, tag) =+  let tag' = fromMaybe tag (stripPrefix "v" tag)+  in  (pkgName,) <$> D.parseVersion' tag'++-- | Returns whether it looks like there is a purescript package checked out+-- in the given directory.+isPureScript :: FilePath -> IO Bool+isPureScript dir = do+  files <- Glob.globDir1 purescriptSourceFiles dir+  return (not (null files))++getInputAndDepsFiles :: IO ([FilePath], [(PackageName, FilePath)])+getInputAndDepsFiles = do+  inputFiles <- globRelative purescriptSourceFiles+  depsFiles' <- globRelative purescriptDepsFiles+  return (inputFiles, mapMaybe withPackageName depsFiles')++withPackageName :: FilePath -> Maybe (PackageName, FilePath)+withPackageName fp = (,fp) <$> getPackageName fp++getPackageName :: FilePath -> Maybe PackageName+getPackageName fp = do+  let xs = splitOn [pathSeparator] fp+  ys <- stripPrefix ["bower_components"] xs+  y <- headMay ys+  case Bower.mkPackageName y of+    Right name -> Just name+    Left _ -> Nothing
+ src/Language/PureScript/Publish/BoxesHelpers.hs view
@@ -0,0 +1,38 @@+module Language.PureScript.Publish.BoxesHelpers+  ( Boxes.Box+  , Boxes.nullBox+  , module Language.PureScript.Publish.BoxesHelpers+  ) where++import System.IO (hPutStr, stderr)+import qualified Text.PrettyPrint.Boxes as Boxes++width :: Int+width = 79++indentWidth :: Int+indentWidth = 2++para :: String -> Boxes.Box+para = Boxes.para Boxes.left width++indented :: Boxes.Box -> Boxes.Box+indented b = Boxes.hcat Boxes.left [Boxes.emptyBox 1 indentWidth, b]++successivelyIndented :: [String] -> Boxes.Box+successivelyIndented [] =+  Boxes.nullBox+successivelyIndented (x:xs) =+  Boxes.vcat Boxes.left [para x, indented (successivelyIndented xs)]++vcat :: [Boxes.Box] -> Boxes.Box+vcat = Boxes.vcat Boxes.left++spacer :: Boxes.Box+spacer = Boxes.emptyBox 1 1++bulletedList :: (a -> String) -> [a] -> [Boxes.Box]+bulletedList f = map (indented . para . ("* " ++) . f)++printToStderr :: Boxes.Box -> IO ()+printToStderr = hPutStr stderr . Boxes.render
+ src/Language/PureScript/Publish/ErrorsWarnings.hs view
@@ -0,0 +1,385 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Language.PureScript.Publish.ErrorsWarnings+  ( PackageError(..)+  , PackageWarning(..)+  , UserError(..)+  , InternalError(..)+  , OtherError(..)+  , RepositoryFieldError(..)+  , JSONSource(..)+  , printError+  , renderError+  , printWarnings+  , renderWarnings+  ) where++import Control.Applicative ((<$>))+import Data.Aeson.BetterErrors+import Data.Version+import Data.Maybe+import Data.Monoid+import Data.Foldable (foldMap)+import Data.List (intersperse, intercalate)+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty++import qualified Data.Text as T++import Control.Exception (IOException)+import Web.Bower.PackageMeta (BowerError, PackageName, runPackageName)+import qualified Web.Bower.PackageMeta as Bower++import qualified Language.PureScript as P+import qualified Language.PureScript.Docs as D++import Language.PureScript.Publish.BoxesHelpers++-- | An error which meant that it was not possible to retrieve metadata for a+-- package.+data PackageError+  = UserError UserError+  | InternalError InternalError+  | OtherError OtherError+  deriving (Show)++data PackageWarning+  = NoResolvedVersion PackageName+  | UndeclaredDependency PackageName+  | UnacceptableVersion (PackageName, String)+  deriving (Show)++-- | An error that should be fixed by the user.+data UserError+  = BowerJSONNotFound+  | BowerExecutableNotFound [String] -- list of executable names tried+  | CouldntParseBowerJSON (ParseError BowerError)+  | BowerJSONNameMissing+  | TagMustBeCheckedOut+  | AmbiguousVersions [Version] -- Invariant: should contain at least two elements+  | BadRepositoryField RepositoryFieldError+  | MissingDependencies (NonEmpty PackageName)+  | ParseAndDesugarError D.ParseDesugarError+  | DirtyWorkingTree+  deriving (Show)++data RepositoryFieldError+  = RepositoryFieldMissing+  | BadRepositoryType String+  | NotOnGithub+  deriving (Show)++-- | An error that probably indicates a bug in this module.+data InternalError+  = JSONError JSONSource (ParseError BowerError)+  deriving (Show)++data JSONSource+  = FromFile FilePath+  | FromBowerList+  deriving (Show)++data OtherError+  = ProcessFailed String [String] IOException+  | IOExceptionThrown IOException+  deriving (Show)++printError :: PackageError -> IO ()+printError = printToStderr . renderError++renderError :: PackageError -> Box+renderError err =+  case err of+    UserError e ->+      vcat+        [ para (concat+          [ "There is a problem with your package, which meant that "+          , "it could not be published."+          ])+        , para "Details:"+        , indented (displayUserError e)+        ]+    InternalError e ->+      vcat+        [ para "Internal error: this is probably a bug. Please report it:"+        , indented (para "https://github.com/purescript/purescript/issues/new")+        , spacer+        , para "Details:"+        , successivelyIndented (displayInternalError e)+        ]+    OtherError e ->+      vcat+        [ para "An error occurred, and your package could not be published."+        , para "Details:"+        , indented (displayOtherError e)+        ]++displayUserError :: UserError -> Box+displayUserError e = case e of+  BowerJSONNotFound ->+    para (concat+      [ "The bower.json file was not found. Please create one, or run "+      , "`pulp init`."+      ])+  BowerExecutableNotFound names ->+    para (concat+      [ "The Bower executable was not found (tried: ", format names, "). Please"+      , " ensure that bower is installed and on your PATH."+      ])+    where+    format = intercalate ", " . map show+  CouldntParseBowerJSON err ->+    vcat+      [ successivelyIndented+        [ "The bower.json file could not be parsed as JSON:"+        , "aeson reported: " ++ show err+        ]+      , para "Please ensure that your bower.json file is valid JSON."+      ]+  BowerJSONNameMissing ->+    vcat+      [ successivelyIndented+        [ "In bower.json:"+        , "the \"name\" key was not found."+        ]+      , para "Please give your package a name first."+      ]+  TagMustBeCheckedOut ->+      vcat+        [ para (concat+            [ "psc-publish requires a tagged version to be checked out in "+            , "order to build documentation, and no suitable tag was found. "+            , "Please check out a previously tagged version, or tag a new "+            , "version."+            ])+        , spacer+        , para "Note: tagged versions must be in one of the following forms:"+        , indented (para "* v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")+        , indented (para "* {MAJOR}.{MINOR}.{PATCH} (example: \"1.6.2\")")+        ]+  AmbiguousVersions vs ->+    vcat $+      [ para (concat+          [ "The currently checked out commit seems to have been tagged with "+          , "more than 1 version, and I don't know which one should be used. "+          , "Please either delete some of the tags, or create a new commit "+          , "to tag the desired verson with."+          ])+      , spacer+      , para "Tags for the currently checked out commit:"+      ] ++ bulletedList showVersion vs+  BadRepositoryField err ->+    displayRepositoryError err+  MissingDependencies pkgs ->+    let singular = NonEmpty.length pkgs == 1+        pl a b = if singular then b else a+        do_          = pl "do" "does"+        dependencies = pl "dependencies" "dependency"+        them         = pl "them" "it"+    in vcat $+      [ para (concat+        [ "The following Bower ", dependencies, " ", do_, " not appear to be "+        , "installed:"+        ])+      ] +++        bulletedList runPackageName (NonEmpty.toList pkgs)+        +++      [ spacer+      , para (concat+        [ "Please install ", them, " first, by running `bower install`."+        ])+      ]+  ParseAndDesugarError (D.ParseError err) ->+    vcat+      [ para "Parse error:"+      , indented (para (show err))+      ]+  ParseAndDesugarError (D.SortModulesError err) ->+    vcat+      [ para "Error in sortModules:"+      , indented (para (P.prettyPrintMultipleErrors False err))+      ]+  ParseAndDesugarError (D.DesugarError err) ->+    vcat+      [ para "Error while desugaring:"+      , indented (para (P.prettyPrintMultipleErrors False err))+      ]+  DirtyWorkingTree ->+    para (concat+        [ "Your git working tree is dirty. Please commit, discard, or stash "+        , "your changes first."+        ])++displayRepositoryError :: RepositoryFieldError -> Box+displayRepositoryError err = case err of+  RepositoryFieldMissing ->+    vcat+      [ para (concat+         [ "The 'repository' field is not present in your bower.json file. "+         , "Without this information, Pursuit would not be able to generate "+         , "source links in your package's documentation. Please add one - like "+         , "this, for example:"+         ])+      , spacer+      , indented (vcat+          [ para "\"repository\": {"+          , indented (para "\"type\": \"git\",")+          , indented (para "\"url\": \"git://github.com/purescript/purescript-prelude.git\"")+          , para "}"+          ]+        )+      ]+  BadRepositoryType ty ->+    para (concat+      [ "In your bower.json file, the repository type is currently listed as "+      , "\"" ++ ty ++ "\". Currently, only git repositories are supported. "+      , "Please publish your code in a git repository, and then update the "+      , "repository type in your bower.json file to \"git\"."+      ])+  NotOnGithub ->+    vcat+      [ para (concat+        [ "The repository url in your bower.json file does not point to a "+        , "GitHub repository. Currently, Pursuit does not support packages "+        , "which are not hosted on GitHub."+        ])+      , spacer+      , para (concat+        [ "Please update your bower.json file to point to a GitHub repository. "+        , "Alternatively, if you would prefer not to host your package on "+        , "GitHub, please open an issue:"+        ])+      , indented (para "https://github.com/purescript/purescript/issues/new")+      ]++displayInternalError :: InternalError -> [String]+displayInternalError e = case e of+  JSONError src r ->+    [ "Error in JSON " ++ displayJSONSource src ++ ":"+    , T.unpack (Bower.displayError r)+    ]++displayJSONSource :: JSONSource -> String+displayJSONSource s = case s of+  FromFile fp ->+    "in file " ++ show fp+  FromBowerList ->+    "in the output of `bower list --json --offline`"++displayOtherError :: OtherError -> Box+displayOtherError e = case e of+  ProcessFailed prog args exc ->+    successivelyIndented+      [ "While running `" ++ prog ++ " " ++ unwords args ++ "`:"+      , show exc+      ]+  IOExceptionThrown exc ->+    successivelyIndented+      [ "An IO exception occurred:", show exc ]++data CollectedWarnings = CollectedWarnings+  { noResolvedVersions     :: [PackageName]+  , undeclaredDependencies :: [PackageName]+  , unacceptableVersions   :: [(PackageName, String)]+  }+  deriving (Show, Eq, Ord)++instance Monoid CollectedWarnings where+  mempty = CollectedWarnings mempty mempty mempty+  mappend (CollectedWarnings as bs cs) (CollectedWarnings as' bs' cs') =+    CollectedWarnings (as <> as') (bs <> bs') (cs <> cs')++collectWarnings :: [PackageWarning] -> CollectedWarnings+collectWarnings = foldMap singular+  where+  singular w = case w of+    NoResolvedVersion    pn -> CollectedWarnings [pn] [] []+    UndeclaredDependency pn -> CollectedWarnings [] [pn] []+    UnacceptableVersion t   -> CollectedWarnings [] [] [t]++renderWarnings :: [PackageWarning] -> Box+renderWarnings warns =+  let CollectedWarnings{..} = collectWarnings warns+      go toBox warns' = toBox <$> NonEmpty.nonEmpty warns'+      mboxes = [ go warnNoResolvedVersions     noResolvedVersions+               , go warnUndeclaredDependencies undeclaredDependencies+               , go warnUnacceptableVersions   unacceptableVersions+               ]+  in case catMaybes mboxes of+       []    -> nullBox+       boxes -> vcat [ para "Warnings:"+                     , indented (vcat (intersperse spacer boxes))+                     ]++warnNoResolvedVersions :: NonEmpty PackageName -> Box+warnNoResolvedVersions pkgNames =+  let singular = NonEmpty.length pkgNames == 1+      pl a b = if singular then b else a++      packages   = pl "packages" "package"+      anyOfThese = pl "any of these" "this"+      these      = pl "these" "this"+  in vcat $+    [ para (concat+      ["The following ", packages, " did not appear to have a resolved "+      , "version:"])+    ] +++      bulletedList runPackageName (NonEmpty.toList pkgNames)+      +++    [ spacer+    , para (concat+      ["Links to types in ", anyOfThese, " ", packages, " will not work. In "+      , "order to make links work, edit your bower.json to specify a version"+      , " or a version range for ", these, " ", packages, ", and rerun "+      , "`bower install`."+      ])+    ]++warnUndeclaredDependencies :: NonEmpty PackageName -> Box+warnUndeclaredDependencies pkgNames =+  let singular = NonEmpty.length pkgNames == 1+      pl a b = if singular then b else a++      packages     = pl "packages" "package"+      are          = pl "are" "is"+      dependencies = pl "dependencies" "a dependency"+  in vcat $+    [ para (concat+      [ "The following Bower ", packages, " ", are, " installed, but not "+      , "declared as ", dependencies, " in your bower.json file:"+      ])+    ] +++      bulletedList runPackageName (NonEmpty.toList pkgNames)++warnUnacceptableVersions :: NonEmpty (PackageName, String) -> Box+warnUnacceptableVersions pkgs =+  let singular = NonEmpty.length pkgs == 1+      pl a b = if singular then b else a++      packages'  = pl "packages'" "package's"+      packages   = pl "packages" "package"+      anyOfThese = pl "any of these" "this"+      these      = pl "these" "this"+      versions   = pl "versions" "version"+  in vcat $+    [ para (concat+      [ "The following installed Bower ", packages', " ", versions, " could "+      , "not be parsed:"+      ])+    ] +++      bulletedList showTuple (NonEmpty.toList pkgs)+      +++    [ spacer+    , para (concat+      ["Links to types in ", anyOfThese, " ", packages, " will not work. In "+      , "order to make links work, edit your bower.json to specify an "+      , "acceptable version or version range for ", these, " ", packages, ", "+      , "and rerun `bower install`."+      ])+    ]+  where+  showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ tag++printWarnings :: [PackageWarning] -> IO ()+printWarnings = printToStderr . renderWarnings
+ src/Language/PureScript/Publish/Utils.hs view
@@ -0,0 +1,38 @@++module Language.PureScript.Publish.Utils where++import Data.List+import Data.Either (partitionEithers)+import System.Directory+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)+import System.FilePath (pathSeparator)+import qualified System.FilePath.Glob as Glob++-- | Glob relative to the current directory, and produce relative pathnames.+globRelative :: Glob.Pattern -> IO [FilePath]+globRelative pat = do+  currentDir <- getCurrentDirectory+  filesAbsolute <- Glob.globDir1 pat currentDir+  let prefix = currentDir ++ [pathSeparator]+  let (fails, paths) = partitionEithers . map (stripPrefix' prefix) $ filesAbsolute+  if null fails+    then return paths+    else do+      let p = hPutStrLn stderr+      p "Internal error in Language.PureScript.Publish.Utils.globRelative"+      p "Unmatched files:"+      mapM_ p fails+      exitFailure++  where+  stripPrefix' prefix dir =+    maybe (Left dir) Right $ stripPrefix prefix dir++-- | Glob pattern for PureScript source files.+purescriptSourceFiles :: Glob.Pattern+purescriptSourceFiles = Glob.compile "src/**/*.purs"++-- | Glob pattern for PureScript dependency files.+purescriptDepsFiles :: Glob.Pattern+purescriptDepsFiles = Glob.compile "bower_components/*/src/**/*.purs"
src/Language/PureScript/TypeChecker.hs view
@@ -31,6 +31,7 @@  import qualified Data.Map as M +import Control.Applicative ((<$>), (<*)) import Control.Monad.State import Control.Monad.Error.Class (MonadError(..)) @@ -129,25 +130,23 @@ --  * Process module imports -- typeCheckAll :: Maybe ModuleName -> ModuleName -> [DeclarationRef] -> [Declaration] -> Check [Declaration]-typeCheckAll mainModuleName moduleName exps = go+typeCheckAll mainModuleName moduleName exps ds = mapM go ds <* mapM_ checkOrphanFixities ds   where-  go :: [Declaration] -> Check [Declaration]-  go [] = return []-  go (DataDeclaration dtype name args dctors : rest) = do+  go :: Declaration -> Check Declaration+  go (DataDeclaration dtype name args dctors) = do     rethrow (onErrorMessages (ErrorInTypeConstructor name)) $ do       when (dtype == Newtype) $ checkNewtype dctors       checkDuplicateTypeArguments $ map fst args       ctorKind <- kindsOf True moduleName name args (concatMap snd dctors)       let args' = args `withKinds` ctorKind       addDataType moduleName dtype name args' dctors ctorKind-    ds <- go rest-    return $ DataDeclaration dtype name args dctors : ds+    return $ DataDeclaration dtype name args dctors     where     checkNewtype :: [(ProperName, [Type])] -> Check ()     checkNewtype [(_, [_])] = return ()     checkNewtype [(_, _)] = throwError . errorMessage $ InvalidNewtype     checkNewtype _ = throwError . errorMessage $ InvalidNewtype-  go (d@(DataBindingGroupDeclaration tys) : rest) = do+  go (d@(DataBindingGroupDeclaration tys)) = do     rethrow (onErrorMessages ErrorInDataBindingGroup) $ do       let syns = mapMaybe toTypeSynonym tys       let dataDecls = mapMaybe toDataDecl tys@@ -160,8 +159,7 @@         checkDuplicateTypeArguments $ map fst args         let args' = args `withKinds` kind         addTypeSynonym moduleName name args' ty kind-    ds <- go rest-    return $ d : ds+    return d     where     toTypeSynonym (TypeSynonymDeclaration nm args ty) = Just (nm, args, ty)     toTypeSynonym (PositionedDeclaration _ _ d') = toTypeSynonym d'@@ -169,26 +167,23 @@     toDataDecl (DataDeclaration dtype nm args dctors) = Just (dtype, nm, args, dctors)     toDataDecl (PositionedDeclaration _ _ d') = toDataDecl d'     toDataDecl _ = Nothing-  go (TypeSynonymDeclaration name args ty : rest) = do+  go (TypeSynonymDeclaration name args ty) = do     rethrow (onErrorMessages (ErrorInTypeSynonym name)) $ do       checkDuplicateTypeArguments $ map fst args       kind <- kindsOf False moduleName name args [ty]       let args' = args `withKinds` kind       addTypeSynonym moduleName name args' ty kind-    ds <- go rest-    return $ TypeSynonymDeclaration name args ty : ds-  go (TypeDeclaration _ _ : _) = error "Type declarations should have been removed"-  go (ValueDeclaration name nameKind [] (Right val) : rest) = do-    d <- rethrow (onErrorMessages (ErrorInValueDeclaration name)) $ do+    return $ TypeSynonymDeclaration name args ty+  go (TypeDeclaration{}) = error "Type declarations should have been removed"+  go (ValueDeclaration name nameKind [] (Right val)) =+    rethrow (onErrorMessages (ErrorInValueDeclaration name)) $ do       valueIsNotDefined moduleName name       [(_, (val', ty))] <- typesOf mainModuleName moduleName [(name, val)]       addValue moduleName name ty nameKind       return $ ValueDeclaration name nameKind [] $ Right val'-    ds <- go rest-    return $ d : ds-  go (ValueDeclaration{} : _) = error "Binders were not desugared"-  go (BindingGroupDeclaration vals : rest) = do-    d <- rethrow (onErrorMessages (ErrorInBindingGroup (map (\(ident, _, _) -> ident) vals))) $ do+  go (ValueDeclaration{}) = error "Binders were not desugared"+  go (BindingGroupDeclaration vals) =+    rethrow (onErrorMessages (ErrorInBindingGroup (map (\(ident, _, _) -> ident) vals))) $ do       forM_ (map (\(ident, _, _) -> ident) vals) $ \name ->         valueIsNotDefined moduleName name       tys <- typesOf mainModuleName moduleName $ map (\(ident, _, ty) -> (ident, ty)) vals@@ -200,14 +195,11 @@         addValue moduleName name ty nameKind         return (name, nameKind, val)       return $ BindingGroupDeclaration vals'-    ds <- go rest-    return $ d : ds-  go (d@(ExternDataDeclaration name kind) : rest) = do+  go (d@(ExternDataDeclaration name kind)) = do     env <- getEnv     putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, ExternData) (types env) }-    ds <- go rest-    return $ d : ds-  go (d@(ExternDeclaration name ty) : rest) = do+    return d+  go (d@(ExternDeclaration name ty)) = do     rethrow (onErrorMessages (ErrorInForeignImport name)) $ do       env <- getEnv       kind <- kindOf moduleName ty@@ -215,38 +207,37 @@       case M.lookup (moduleName, name) (names env) of         Just _ -> throwError . errorMessage $ RedefinedIdent name         Nothing -> putEnv (env { names = M.insert (moduleName, name) (ty, External, Defined) (names env) })-    ds <- go rest-    return $ d : ds-  go (d@(FixityDeclaration _ name) : rest) = do-    ds <- go rest-    env <- getEnv-    guardWith (errorMessage (OrphanFixityDeclaration name)) $ M.member (moduleName, Op name) $ names env-    return $ d : ds-  go (d@(ImportDeclaration importedModule _ _) : rest) = do+    return d+  go (d@(FixityDeclaration{})) = return d+  go (d@(ImportDeclaration importedModule _ _)) = do     instances <- lookupTypeClassDictionaries $ Just importedModule     addTypeClassDictionaries (Just moduleName) instances-    ds <- go rest-    return $ d : ds-  go (d@(TypeClassDeclaration pn args implies tys) : rest) = do+    return d+  go (d@(TypeClassDeclaration pn args implies tys)) = do     addTypeClass moduleName pn args implies tys-    ds <- go rest-    return $ d : ds-  go (d@(TypeInstanceDeclaration dictName deps className tys _) : rest) = do-    goInstance d dictName deps className tys rest-  go (d@(ExternInstanceDeclaration dictName deps className tys) : rest) = do-    goInstance d dictName deps className tys rest-  go (PositionedDeclaration pos com d : rest) =-    rethrowWithPosition pos $ do-      (d' : rest') <- go (d : rest)-      return (PositionedDeclaration pos com d' : rest')-  goInstance :: Declaration -> Ident -> [Constraint] -> Qualified ProperName -> [Type] -> [Declaration] -> Check [Declaration]-  goInstance d dictName deps className tys rest = do+    return d+  go (d@(TypeInstanceDeclaration dictName deps className tys _)) =+    goInstance d dictName deps className tys+  go (d@(ExternInstanceDeclaration dictName deps className tys)) =+    goInstance d dictName deps className tys+  go (PositionedDeclaration pos com d) =+    rethrowWithPosition pos $ PositionedDeclaration pos com <$> go d++  checkOrphanFixities :: Declaration -> Check ()+  checkOrphanFixities (FixityDeclaration _ name) = do+    env <- getEnv+    guardWith (errorMessage (OrphanFixityDeclaration name)) $ M.member (moduleName, Op name) $ names env+  checkOrphanFixities (PositionedDeclaration pos _ d) =+    rethrowWithPosition pos $ checkOrphanFixities d+  checkOrphanFixities _ = return ()++  goInstance :: Declaration -> Ident -> [Constraint] -> Qualified ProperName -> [Type] -> Check Declaration+  goInstance d dictName deps className tys = do     mapM_ (checkTypeClassInstance moduleName) tys     forM_ deps $ mapM_ (checkTypeClassInstance moduleName) . snd     let dict = TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className tys (Just deps) TCDRegular isInstanceExported     addTypeClassDictionaries (Just moduleName) . M.singleton className $ M.singleton (canonicalizeDictionary dict) dict-    ds <- go rest-    return $ d : ds+    return d      where
tests/Main.hs view
@@ -13,18 +13,35 @@ -----------------------------------------------------------------------------  {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} +-- Failing tests can specify the kind of error that should be thrown with a+-- @shouldFailWith declaration. For example:+--+--   "-- @shouldFailWith TypesDoNotUnify"+--+-- will cause the test to fail unless that module fails to compile with exactly+-- one TypesDoNotUnify error.+--+-- If a module is expected to produce multiple type errors, then use multiple+-- @shouldFailWith lines; for example:+--+--   -- @shouldFailWith TypesDoNotUnify+--   -- @shouldFailWith TypesDoNotUnify+--   -- @shouldFailWith TransitiveExportError+ module Main (main) where  import qualified Language.PureScript as P import qualified Language.PureScript.CodeGen.JS as J import qualified Language.PureScript.CoreFn as CF -import Data.List (isSuffixOf)+import Data.Char (isSpace)+import Data.Maybe (mapMaybe, fromMaybe)+import Data.List (isSuffixOf, sort, stripPrefix) import Data.Traversable (traverse) import Data.Time.Clock (UTCTime()) @@ -33,6 +50,7 @@ import Control.Monad import Control.Monad.IO.Class (liftIO) import Control.Applicative+import Control.Arrow ((>>>))  import Control.Monad.Reader import Control.Monad.Writer@@ -44,6 +62,7 @@ import System.Process import System.FilePath import System.Directory+import qualified System.FilePath.Glob as Glob  import Text.Parsec (ParseError) @@ -60,31 +79,23 @@ makeActions foreigns = P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress   where   getInputTimestamp :: P.ModuleName -> Test (Either P.RebuildPolicy (Maybe UTCTime))-  getInputTimestamp mn -    | isPreludeModule (P.runModuleName mn) = return (Left P.RebuildNever)+  getInputTimestamp mn+    | isSupportModule (P.runModuleName mn) = return (Left P.RebuildNever)     | otherwise = return (Left P.RebuildAlways)     where-    isPreludeModule = flip elem-      [ "Prelude.Unsafe"-      , "Prelude"-      , "Data.Function"-      , "Control.Monad.Eff"-      , "Control.Monad.ST"-      , "Debug.Trace"-      , "Assert"-      ]-  +    isSupportModule = flip elem supportModules+   getOutputTimestamp :: P.ModuleName -> Test (Maybe UTCTime)   getOutputTimestamp mn = do     let filePath = modulesDir </> P.runModuleName mn     exists <- liftIO $ doesDirectoryExist filePath     return (if exists then Just (error "getOutputTimestamp: read timestamp") else Nothing)-  +   readExterns :: P.ModuleName -> Test (FilePath, String)   readExterns mn = do     let filePath = modulesDir </> P.runModuleName mn </> "externs.purs"     (filePath, ) <$> readTextFile filePath-  +   codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Test ()   codegen m _ nextVar exts = do     let mn = CF.moduleName m@@ -101,15 +112,15 @@     writeTextFile jsFile pjs     maybe (return ()) (writeTextFile foreignFile . snd) $ CF.moduleName m `M.lookup` foreigns     writeTextFile externsFile exts-    +   readTextFile :: FilePath -> Test String   readTextFile path = liftIO $ readFile path-  +   writeTextFile :: FilePath -> String -> Test ()   writeTextFile path text = liftIO $ do     createDirectoryIfMissing True (takeDirectory path)     writeFile path text-  +   progress :: String -> Test ()   progress = liftIO . putStrLn @@ -118,28 +129,30 @@   text <- readFile inputFile   return (inputFile, text) +type TestM = WriterT [(FilePath, String)] IO+ compile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO (Either P.MultipleErrors P.Environment) compile inputFiles foreigns = runTest $ do   fs <- liftIO $ readInput inputFiles   ms <- P.parseModulesFromFiles id fs-  P.make (makeActions foreigns) (map (\(k, v) -> (Right k, v)) ms)+  P.make (makeActions foreigns) (map snd ms) -assert :: [FilePath] -> -          M.Map P.ModuleName (FilePath, P.ForeignJS) -> -          (Either P.MultipleErrors P.Environment -> IO (Maybe String)) -> -          IO ()+assert :: [FilePath] ->+          M.Map P.ModuleName (FilePath, P.ForeignJS) ->+          (Either P.MultipleErrors P.Environment -> IO (Maybe String)) ->+          TestM () assert inputFiles foreigns f = do-  e <- compile inputFiles foreigns-  maybeErr <- f e+  e <- liftIO $ compile inputFiles foreigns+  maybeErr <- liftIO $ f e   case maybeErr of-    Just err -> putStrLn err >> exitFailure+    Just err -> tell [(last inputFiles, err)]     Nothing -> return () -assertCompiles :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO ()+assertCompiles :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> TestM () assertCompiles inputFiles foreigns = do-  putStrLn $ "Assert " ++ last inputFiles ++ " compiles successfully"+  liftIO . putStrLn $ "Assert " ++ last inputFiles ++ " compiles successfully"   assert inputFiles foreigns $ \e ->-    case e of +    case e of       Left errs -> return . Just . P.prettyPrintMultipleErrors False $ errs       Right _ -> do         process <- findNodeProcess@@ -151,36 +164,96 @@           Just (ExitFailure _, _, err) -> return $ Just err           Nothing -> return $ Just "Couldn't find node.js executable" -assertDoesNotCompile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO ()+assertDoesNotCompile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> TestM () assertDoesNotCompile inputFiles foreigns = do-  putStrLn $ "Assert " ++ last inputFiles ++ " does not compile"+  let testFile = last inputFiles+  liftIO . putStrLn $ "Assert " ++ testFile ++ " does not compile"+  shouldFailWith <- getShouldFailWith testFile   assert inputFiles foreigns $ \e ->     case e of-      Left errs -> putStrLn  (P.prettyPrintMultipleErrors False errs) >> return Nothing-      Right _ -> return $ Just "Should not have compiled"+      Left errs -> do+        putStrLn (P.prettyPrintMultipleErrors False errs)+        return $ if null shouldFailWith+          then Just $ "shouldFailWith declaration is missing (errors were: "+                      ++ show (map P.errorCode (P.runMultipleErrors errs))+                      ++ ")"+          else checkShouldFailWith shouldFailWith errs+      Right _ ->+        return $ Just "Should not have compiled" +  where+  getShouldFailWith =+    readFile+    >>> liftIO+    >>> fmap (   lines+             >>> mapMaybe (stripPrefix "-- @shouldFailWith ")+             >>> map trim+             )++  checkShouldFailWith expected errs =+    let actual = map P.errorCode $ P.runMultipleErrors errs+    in if sort expected == sort actual+      then Nothing+      else Just $ "Expected these errors: " ++ show expected ++ ", but got these: " ++ show actual++  trim =+    dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse+ findNodeProcess :: IO (Maybe String) findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names-  where +  where   names = ["nodejs", "node"]  main :: IO () main = do+  fetchSupportCode   cwd <- getCurrentDirectory-  -  let preludeDir  = cwd </> "tests" </> "prelude"-      preludePurs = preludeDir </> "Prelude.purs"-      jsDir       = preludeDir </> "js"-  jsFiles <- map (jsDir </>) . filter (".js" `isSuffixOf`) <$> getDirectoryContents jsDir-  foreignFiles <- forM jsFiles (\f -> (f,) <$> readFile f)++  let supportDir  = cwd </> "tests" </> "support" </> "flattened"+  let supportFiles ext = Glob.globDir1 (Glob.compile ("*." ++ ext)) supportDir++  supportPurs <- supportFiles "purs"+  supportJS   <- supportFiles "js"++  foreignFiles <- forM supportJS (\f -> (f,) <$> readFile f)   Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles-  +   let passing = cwd </> "examples" </> "passing"-  passingTestCases <- getDirectoryContents passing-  forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $-    assertCompiles [preludePurs, passing </> inputFile] foreigns+  passingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents passing   let failing = cwd </> "examples" </> "failing"-  failingTestCases <- getDirectoryContents failing-  forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $-    assertDoesNotCompile [preludePurs, failing </> inputFile] foreigns-  exitSuccess+  failingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents failing++  failures <- execWriterT $ do+    forM_ passingTestCases $ \inputFile ->+      assertCompiles (supportPurs ++ [passing </> inputFile]) foreigns+    forM_ failingTestCases $ \inputFile ->+      assertDoesNotCompile (supportPurs ++ [failing </> inputFile]) foreigns++  if null failures+    then exitSuccess+    else do+      putStrLn "Failures:"+      forM_ failures $ \(fp, err) ->+        let fp' = fromMaybe fp $ stripPrefix (failing ++ [pathSeparator]) fp+        in putStrLn $ fp' ++ ": " ++ err+      exitFailure++fetchSupportCode :: IO ()+fetchSupportCode = do+  setCurrentDirectory "tests/support"+  callProcess "npm" ["install"]+  callProcess "bower" ["install"]+  callProcess "node" ["setup.js"]+  setCurrentDirectory "../.."++supportModules :: [String]+supportModules =+  [ "Control.Monad.Eff.Class"+  , "Control.Monad.Eff.Console"+  , "Control.Monad.Eff"+  , "Control.Monad.Eff.Unsafe"+  , "Control.Monad.ST"+  , "Data.Function"+  , "Prelude"+  , "Test.Assert"+  ]
+ tests/support/flattened/Control-Monad-Eff-Class.purs view
@@ -0,0 +1,24 @@+module Control.Monad.Eff.Class +  ( MonadEff+  , liftEff+  ) where++import Prelude++import Control.Monad.Eff++-- | The `MonadEff` class captures those monads which support native effects.+-- |+-- | Instances are provided for `Eff` itself, and the standard monad transformers.+-- |+-- | `liftEff` can be used in any appropriate monad transformer stack to lift an action+-- | of type `Eff eff a` into the monad.+-- |+-- | Note that `MonadEff` is parameterized by the row of effects, so type inference can be+-- | tricky. It is generally recommended to either work with a polymorphic row of effects,+-- | or a concrete, closed row of effects such as `(trace :: Trace)`.+class (Monad m) <= MonadEff eff m where+  liftEff :: forall a. Eff eff a -> m a++instance monadEffEff :: MonadEff eff (Eff eff) where+  liftEff = id
+ tests/support/flattened/Control-Monad-Eff-Console.js view
@@ -0,0 +1,18 @@+/* global exports, console */+"use strict";++// module Control.Monad.Eff.Console++exports.log = function (s) {+  return function () {+    console.log(s);+    return {};+  };+};++exports.error = function (s) {+  return function () {+    console.error(s);+    return {};+  };+};
+ tests/support/flattened/Control-Monad-Eff-Console.purs view
@@ -0,0 +1,18 @@+module Control.Monad.Eff.Console where++import Prelude++import Control.Monad.Eff++-- | The `CONSOLE` effect represents those computations which write to the console.+foreign import data CONSOLE :: !++-- | Write a message to the console.+foreign import log :: forall eff. String -> Eff (console :: CONSOLE | eff) Unit++-- | Write an error to the console.+foreign import error :: forall eff. String -> Eff (console :: CONSOLE | eff) Unit++-- | Write a value to the console, using its `Show` instance to produce a `String`.+print :: forall a eff. (Show a) => a -> Eff (console :: CONSOLE | eff) Unit+print = log <<< show
+ tests/support/flattened/Control-Monad-Eff-Unsafe.js view
@@ -0,0 +1,8 @@+/* global exports */+"use strict";++// module Control.Monad.Eff.Unsafe++exports.unsafeInterleaveEff = function (f) {+  return f;+};
+ tests/support/flattened/Control-Monad-Eff-Unsafe.purs view
@@ -0,0 +1,10 @@+module Control.Monad.Eff.Unsafe where++import Prelude++import Control.Monad.Eff++-- | Change the type of an effectful computation, allowing it to be run in another context.+-- |+-- | Note: use of this function can result in arbitrary side-effects.+foreign import unsafeInterleaveEff :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a
+ tests/support/flattened/Control-Monad-Eff.js view
@@ -0,0 +1,62 @@+/* global exports */+"use strict";++// module Control.Monad.Eff++exports.returnE = function (a) {+  return function () {+    return a;+  };+};++exports.bindE = function (a) {+  return function (f) {+    return function () {+      return f(a())();+    };+  };+};++exports.runPure = function (f) {+  return f();+};++exports.untilE = function (f) {+  return function () {+    while (!f());+    return {};+  };+};++exports.whileE = function (f) {+  return function (a) {+    return function () {+      while (f()) {+        a();+      }+      return {};+    };+  };+};++exports.forE = function (lo) {+  return function (hi) {+    return function (f) {+      return function () {+        for (var i = lo; i < hi; i++) {+          f(i)();+        }+      };+    };+  };+};++exports.foreachE = function (as) {+  return function (f) {+    return function () {+      for (var i = 0, l = as.length; i < l; i++) {+        f(as[i])();+      }+    };+  };+};
+ tests/support/flattened/Control-Monad-Eff.purs view
@@ -0,0 +1,67 @@+module Control.Monad.Eff+  ( Eff()+  , Pure()+  , runPure+  , untilE, whileE, forE, foreachE+  ) where++import Prelude++-- | The `Eff` type constructor is used to represent _native_ effects.+-- |+-- | See [Handling Native Effects with the Eff Monad](https://github.com/purescript/purescript/wiki/Handling-Native-Effects-with-the-Eff-Monad) for more details.+-- |+-- | The first type parameter is a row of effects which represents the contexts in which a computation can be run, and the second type parameter is the return type.+foreign import data Eff :: # ! -> * -> *++foreign import returnE :: forall e a. a -> Eff e a++foreign import bindE :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b++-- | The `Pure` type synonym represents _pure_ computations, i.e. ones in which all effects have been handled.+-- |+-- | The `runPure` function can be used to run pure computations and obtain their result.+type Pure a = forall e. Eff e a++-- | Run a pure computation and return its result.+-- |+-- | Note: since this function has a rank-2 type, it may cause problems to apply this function using the `$` operator. The recommended approach+-- | is to use parentheses instead.+foreign import runPure :: forall a. Pure a -> a++instance functorEff :: Functor (Eff e) where+  map = liftA1++instance applyEff :: Apply (Eff e) where+  apply = ap++instance applicativeEff :: Applicative (Eff e) where+  pure = returnE++instance bindEff :: Bind (Eff e) where+  bind = bindE++instance monadEff :: Monad (Eff e)++-- | Loop until a condition becomes `true`.+-- |+-- | `untilE b` is an effectful computation which repeatedly runs the effectful computation `b`,+-- | until its return value is `true`.+foreign import untilE :: forall e. Eff e Boolean -> Eff e Unit++-- | Loop while a condition is `true`.+-- |+-- | `whileE b m` is effectful computation which runs the effectful computation `b`. If its result is+-- | `true`, it runs the effectful computation `m` and loops. If not, the computation ends.+foreign import whileE :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit++-- | Loop over a consecutive collection of numbers.+-- |+-- | `forE lo hi f` runs the computation returned by the function `f` for each of the inputs+-- | between `lo` (inclusive) and `hi` (exclusive).+foreign import forE :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit++-- | Loop over an array of values.+-- |+-- | `foreach xs f` runs the computation returned by the function `f` for each of the inputs `xs`.+foreign import foreachE :: forall e a. Array a -> (a -> Eff e Unit) -> Eff e Unit
+ tests/support/flattened/Control-Monad-ST.js view
@@ -0,0 +1,38 @@+/* global exports */+"use strict";++// module Control.Monad.ST++exports.newSTRef = function (val) {+  return function () {+    return { value: val };+  };+};++exports.readSTRef = function (ref) {+  return function () {+    return ref.value;+  };+};++exports.modifySTRef = function (ref) {+  return function (f) {+    return function () {+      /* jshint boss: true */+      return ref.value = f(ref.value);+    };+  };+};++exports.writeSTRef = function (ref) {+  return function (a) {+    return function () {+      /* jshint boss: true */+      return ref.value = a;+    };+  };+};++exports.runST = function (f) {+  return f;+};
+ tests/support/flattened/Control-Monad-ST.purs view
@@ -0,0 +1,42 @@+module Control.Monad.ST where++import Prelude++import Control.Monad.Eff (Eff(), runPure)++-- | The `ST` effect represents _local mutation_, i.e. mutation which does not "escape" into the surrounding computation.+-- |+-- | An `ST` computation is parameterized by a phantom type which is used to restrict the set of reference cells it is allowed to access.+-- |+-- | The `runST` function can be used to handle the `ST` effect.+foreign import data ST :: * -> !++-- | The type `STRef s a` represents a mutable reference holding a value of type `a`, which can be used with the `ST s` effect.+foreign import data STRef :: * -> * -> *++-- | Create a new mutable reference.+foreign import newSTRef :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)++-- | Read the current value of a mutable reference.+foreign import readSTRef :: forall a h r. STRef h a -> Eff (st :: ST h | r) a++-- | Modify the value of a mutable reference by applying a function to the current value.+foreign import modifySTRef :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a++-- | Set the value of a mutable reference.+foreign import writeSTRef :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a++-- | Run an `ST` computation.+-- |+-- | Note: the type of `runST` uses a rank-2 type to constrain the phantom type `s`, such that the computation must not leak any mutable references+-- | to the surrounding computation.+-- |+-- | It may cause problems to apply this function using the `$` operator. The recommended approach is to use parentheses instead.+foreign import runST :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a++-- | A convenience function which combines `runST` with `runPure`, which can be used when the only required effect is `ST`.+-- |+-- | Note: since this function has a rank-2 type, it may cause problems to apply this function using the `$` operator. The recommended approach+-- | is to use parentheses instead.+pureST :: forall a. (forall h r. Eff (st :: ST h | r) a) -> a+pureST st = runPure (runST st)
+ tests/support/flattened/Data-Function.js view
@@ -0,0 +1,233 @@+/* global exports */+"use strict";++// module Data.Function++exports.mkFn0 = function (fn) {+  return function () {+    return fn({});+  };+};++exports.mkFn1 = function (fn) {+  return function (a) {+    return fn(a);+  };+};++exports.mkFn2 = function (fn) {+  /* jshint maxparams: 2 */+  return function (a, b) {+    return fn(a)(b);+  };+};++exports.mkFn3 = function (fn) {+  /* jshint maxparams: 3 */+  return function (a, b, c) {+    return fn(a)(b)(c);+  };+};++exports.mkFn4 = function (fn) {+  /* jshint maxparams: 4 */+  return function (a, b, c, d) {+    return fn(a)(b)(c)(d);+  };+};++exports.mkFn5 = function (fn) {+  /* jshint maxparams: 5 */+  return function (a, b, c, d, e) {+    return fn(a)(b)(c)(d)(e);+  };+};++exports.mkFn6 = function (fn) {+  /* jshint maxparams: 6 */+  return function (a, b, c, d, e, f) {+    return fn(a)(b)(c)(d)(e)(f);+  };+};++exports.mkFn7 = function (fn) {+  /* jshint maxparams: 7 */+  return function (a, b, c, d, e, f, g) {+    return fn(a)(b)(c)(d)(e)(f)(g);+  };+};++exports.mkFn8 = function (fn) {+  /* jshint maxparams: 8 */+  return function (a, b, c, d, e, f, g, h) {+    return fn(a)(b)(c)(d)(e)(f)(g)(h);+  };+};++exports.mkFn9 = function (fn) {+  /* jshint maxparams: 9 */+  return function (a, b, c, d, e, f, g, h, i) {+    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);+  };+};++exports.mkFn10 = function (fn) {+  /* jshint maxparams: 10 */+  return function (a, b, c, d, e, f, g, h, i, j) {+    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);+  };+};++exports.runFn0 = function (fn) {+  return fn();+};++exports.runFn1 = function (fn) {+  return function (a) {+    return fn(a);+  };+};++exports.runFn2 = function (fn) {+  return function (a) {+    return function (b) {+      return fn(a, b);+    };+  };+};++exports.runFn3 = function (fn) {+  return function (a) {+    return function (b) {+      return function (c) {+        return fn(a, b, c);+      };+    };+  };+};++exports.runFn4 = function (fn) {+  return function (a) {+    return function (b) {+      return function (c) {+        return function (d) {+          return fn(a, b, c, d);+        };+      };+    };+  };+};++exports.runFn5 = function (fn) {+  return function (a) {+    return function (b) {+      return function (c) {+        return function (d) {+          return function (e) {+            return fn(a, b, c, d, e);+          };+        };+      };+    };+  };+};++exports.runFn6 = function (fn) {+  return function (a) {+    return function (b) {+      return function (c) {+        return function (d) {+          return function (e) {+            return function (f) {+              return fn(a, b, c, d, e, f);+            };+          };+        };+      };+    };+  };+};++exports.runFn7 = function (fn) {+  return function (a) {+    return function (b) {+      return function (c) {+        return function (d) {+          return function (e) {+            return function (f) {+              return function (g) {+                return fn(a, b, c, d, e, f, g);+              };+            };+          };+        };+      };+    };+  };+};++exports.runFn8 = function (fn) {+  return function (a) {+    return function (b) {+      return function (c) {+        return function (d) {+          return function (e) {+            return function (f) {+              return function (g) {+                return function (h) {+                  return fn(a, b, c, d, e, f, g, h);+                };+              };+            };+          };+        };+      };+    };+  };+};++exports.runFn9 = function (fn) {+  return function (a) {+    return function (b) {+      return function (c) {+        return function (d) {+          return function (e) {+            return function (f) {+              return function (g) {+                return function (h) {+                  return function (i) {+                    return fn(a, b, c, d, e, f, g, h, i);+                  };+                };+              };+            };+          };+        };+      };+    };+  };+};++exports.runFn10 = function (fn) {+  return function (a) {+    return function (b) {+      return function (c) {+        return function (d) {+          return function (e) {+            return function (f) {+              return function (g) {+                return function (h) {+                  return function (i) {+                    return function (j) {+                      return fn(a, b, c, d, e, f, g, h, i, j);+                    };+                  };+                };+              };+            };+          };+        };+      };+    };+  };+};
+ tests/support/flattened/Data-Function.purs view
@@ -0,0 +1,113 @@+module Data.Function where++import Prelude++-- | The `on` function is used to change the domain of a binary operator.+-- |+-- | For example, we can create a function which compares two records based on the values of their `x` properties:+-- |+-- | ```purescript+-- | compareX :: forall r. { x :: Number | r } -> { x :: Number | r } -> Ordering+-- | compareX = compare `on` _.x+-- | ```+on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c+on f g x y = g x `f` g y++-- | A function of zero arguments+foreign import data Fn0 :: * -> *++-- | A function of one argument+foreign import data Fn1 :: * -> * -> *++-- | A function of two arguments+foreign import data Fn2 :: * -> * -> * -> *++-- | A function of three arguments+foreign import data Fn3 :: * -> * -> * -> * -> *++-- | A function of four arguments+foreign import data Fn4 :: * -> * -> * -> * -> * -> *++-- | A function of five arguments+foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *++-- | A function of six arguments+foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *++-- | A function of seven arguments+foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *++-- | A function of eight arguments+foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *++-- | A function of nine arguments+foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *++-- | A function of ten arguments+foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *++-- | Create a function of no arguments+foreign import mkFn0 :: forall a. (Unit -> a) -> Fn0 a++-- | Create a function of one argument+foreign import mkFn1 :: forall a b. (a -> b) -> Fn1 a b++-- | Create a function of two arguments from a curried function+foreign import mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c++-- | Create a function of three arguments from a curried function+foreign import mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d++-- | Create a function of four arguments from a curried function+foreign import mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e++-- | Create a function of five arguments from a curried function+foreign import mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f++-- | Create a function of six arguments from a curried function+foreign import mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g++-- | Create a function of seven arguments from a curried function+foreign import mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h++-- | Create a function of eight arguments from a curried function+foreign import mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i++-- | Create a function of nine arguments from a curried function+foreign import mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j++-- | Create a function of ten arguments from a curried function+foreign import mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k++-- | Apply a function of no arguments+foreign import runFn0 :: forall a. Fn0 a -> a++-- | Apply a function of one argument+foreign import runFn1 :: forall a b. Fn1 a b -> a -> b++-- | Apply a function of two arguments+foreign import runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c++-- | Apply a function of three arguments+foreign import runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d++-- | Apply a function of four arguments+foreign import runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e++-- | Apply a function of five arguments+foreign import runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f++-- | Apply a function of six arguments+foreign import runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g++-- | Apply a function of seven arguments+foreign import runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h++-- | Apply a function of eight arguments+foreign import runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i++-- | Apply a function of nine arguments+foreign import runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j++-- | Apply a function of ten arguments+foreign import runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
+ tests/support/flattened/Prelude.js view
@@ -0,0 +1,222 @@+/* global exports */+"use strict";++// module Prelude++//- Functor --------------------------------------------------------------------++exports.arrayMap = function (f) {+  return function (arr) {+    var l = arr.length;+    var result = new Array(l);+    for (var i = 0; i < l; i++) {+      result[i] = f(arr[i]);+    }+    return result;+  };+};++//- Bind -----------------------------------------------------------------------++exports.arrayBind = function (arr) {+  return function (f) {+    var result = [];+    for (var i = 0, l = arr.length; i < l; i++) {+      Array.prototype.push.apply(result, f(arr[i]));+    }+    return result;+  };+};++//- Monoid ---------------------------------------------------------------------++exports.concatString = function (s1) {+  return function (s2) {+    return s1 + s2;+  };+};++exports.concatArray = function (xs) {+  return function (ys) {+    return xs.concat(ys);+  };+};++//- Semiring -------------------------------------------------------------------++exports.intAdd = function (x) {+  return function (y) {+    /* jshint bitwise: false */+    return x + y | 0;+  };+};++exports.intMul = function (x) {+  return function (y) {+    /* jshint bitwise: false */+    return x * y | 0;+  };+};++exports.numAdd = function (n1) {+  return function (n2) {+    return n1 + n2;+  };+};++exports.numMul = function (n1) {+  return function (n2) {+    return n1 * n2;+  };+};++//- ModuloSemiring -------------------------------------------------------------++exports.intDiv = function (x) {+  return function (y) {+    /* jshint bitwise: false */+    return x / y | 0;+  };+};++exports.intMod = function (x) {+  return function (y) {+    return x % y;+  };+};++exports.numDiv = function (n1) {+  return function (n2) {+    return n1 / n2;+  };+};++//- Ring -----------------------------------------------------------------------++exports.intSub = function (x) {+  return function (y) {+    /* jshint bitwise: false */+    return x - y | 0;+  };+};++exports.numSub = function (n1) {+  return function (n2) {+    return n1 - n2;+  };+};++//- Eq -------------------------------------------------------------------------++exports.refEq = function (r1) {+  return function (r2) {+    return r1 === r2;+  };+};++exports.refIneq = function (r1) {+  return function (r2) {+    return r1 !== r2;+  };+};++exports.eqArrayImpl = function (f) {+  return function (xs) {+    return function (ys) {+      if (xs.length !== ys.length) return false;+      for (var i = 0; i < xs.length; i++) {+        if (!f(xs[i])(ys[i])) return false;+      }+      return true;+    };+  };+};++exports.ordArrayImpl = function (f) {+  return function (xs) {+    return function (ys) {+      var i = 0;+      var xlen = xs.length;+      var ylen = ys.length;+      while (i < xlen && i < ylen) {+        var x = xs[i];+        var y = ys[i];+        var o = f(x)(y);+        if (o !== 0) {+          return o;+        }+        i++;+      }+      if (xlen === ylen) {+        return 0;+      } else if (xlen > ylen) {+        return -1;+      } else {+        return 1;+      }+    };+  };+};++//- Ord ------------------------------------------------------------------------++exports.unsafeCompareImpl = function (lt) {+  return function (eq) {+    return function (gt) {+      return function (x) {+        return function (y) {+          return x < y ? lt : x > y ? gt : eq;+        };+      };+    };+  };+};++//- Lattice --------------------------------------------------------------------++exports.boolOr = function (b1) {+  return function (b2) {+    return b1 || b2;+  };+};++exports.boolAnd = function (b1) {+  return function (b2) {+    return b1 && b2;+  };+};++//- ComplementedLattice --------------------------------------------------------++exports.boolNot = function (b) {+  return !b;+};++//- Show -----------------------------------------------------------------------++exports.showIntImpl = function (n) {+  return n.toString();+};++exports.showNumberImpl = function (n) {+  /* jshint bitwise: false */+  return n === (n | 0) ? n + ".0" : n.toString();+};++exports.showCharImpl = function (c) {+  return c === "'" ? "'\\''" : "'" + c + "'";+};++exports.showStringImpl = function (s) {+  return JSON.stringify(s);+};++exports.showArrayImpl = function (f) {+  return function (xs) {+    var ss = [];+    for (var i = 0, l = xs.length; i < l; i++) {+      ss[i] = f(xs[i]);+    }+    return "[" + ss.join(",") + "]";+  };+};
+ tests/support/flattened/Prelude.purs view
@@ -0,0 +1,860 @@+module Prelude+  ( Unit(), unit+  , ($), (#)+  , flip+  , const+  , asTypeOf+  , otherwise+  , Semigroupoid, compose, (<<<), (>>>)+  , Category, id+  , Functor, map, (<$>), (<#>), void+  , Apply, apply, (<*>)+  , Applicative, pure, liftA1+  , Bind, bind, (>>=)+  , Monad, return, liftM1, ap+  , Semigroup, append, (<>), (++)+  , Semiring, add, zero, mul, one, (+), (*)+  , ModuloSemiring, div, mod, (/)+  , Ring, sub, negate, (-)+  , Num+  , DivisionRing+  , Eq, eq, (==), (/=)+  , Ordering(..), Ord, compare, (<), (>), (<=), (>=)+  , unsafeCompare+  , Bounded, top, bottom+  , BoundedOrd+  , BooleanAlgebra, conj, disj, not, (&&), (||)+  , Show, show+  ) where++-- | The `Unit` type has a single inhabitant, called `unit`. It represents+-- | values with no computational content.+-- |+-- | `Unit` is often used, wrapped in a monadic type constructor, as the+-- | return type of a computation where only+-- | the _effects_ are important.+newtype Unit = Unit {}++-- | `unit` is the sole inhabitant of the `Unit` type.+unit :: Unit+unit = Unit {}++infixr 0 $+infixl 1 #++-- | Applies a function to its argument.+-- |+-- | ```purescript+-- | length $ groupBy productCategory $ filter isInStock $ products+-- | ```+-- |+-- | is equivalent to:+-- |+-- | ```purescript+-- | length (groupBy productCategory (filter isInStock products))+-- | ```+-- |+-- | `($)` is different from [`(#)`](#-2) because it is right-infix instead of+-- | left: `a $ b $ c $ d x = a $ (b $ (c $ (d $ x))) = a (b (c (d x)))`+($) :: forall a b. (a -> b) -> a -> b+($) f x = f x++-- | Applies an argument to a function.+-- |+-- | ```purescript+-- | products # filter isInStock # groupBy productCategory # length+-- | ```+-- |+-- | is equivalent to:+-- |+-- | ```purescript+-- | length (groupBy productCategory (filter isInStock products))+-- | ```+-- |+-- | `(#)` is different from [`($)`](#-1) because it is left-infix instead of+-- | right: `x # a # b # c # d = (((x # a) # b) # c) # d = d (c (b (a x)))`+(#) :: forall a b. a -> (a -> b) -> b+(#) x f = f x++-- | Flips the order of the arguments to a function of two arguments.+-- |+-- | ```purescript+-- | flip const 1 2 = const 2 1 = 2+-- | ```+flip :: forall a b c. (a -> b -> c) -> b -> a -> c+flip f b a = f a b++-- | Returns its first argument and ignores its second.+-- |+-- | ```purescript+-- | const 1 "hello" = 1+-- | ```+const :: forall a b. a -> b -> a+const a _ = a++-- | This function returns its first argument, and can be used to assert type+-- | equalities. This can be useful when types are otherwise ambiguous.+-- |+-- | ```purescript+-- | main = print $ [] `asTypeOf` [0]+-- | ```+-- |+-- | If instead, we had written `main = print []`, the type of the argument+-- | `[]` would have been ambiguous, resulting in a compile-time error.+asTypeOf :: forall a. a -> a -> a+asTypeOf x _ = x++-- | An alias for `true`, which can be useful in guard clauses:+-- |+-- | ```purescript+-- | max x y | x >= y    = x+-- |         | otherwise = y+-- | ```+otherwise :: Boolean+otherwise = true++-- | A `Semigroupoid` is similar to a [`Category`](#category) but does not+-- | require an identity element `id`, just composable morphisms.+-- |+-- | `Semigroupoid`s must satisfy the following law:+-- |+-- | - Associativity: `p <<< (q <<< r) = (p <<< q) <<< r`+-- |+-- | One example of a `Semigroupoid` is the function type constructor `(->)`,+-- | with `(<<<)` defined as function composition.+class Semigroupoid a where+  compose :: forall b c d. a c d -> a b c -> a b d++instance semigroupoidFn :: Semigroupoid (->) where+  compose f g x = f (g x)++infixr 9 >>>+infixr 9 <<<++-- | `(<<<)` is an alias for `compose`.+(<<<) :: forall a b c d. (Semigroupoid a) => a c d -> a b c -> a b d+(<<<) = compose++-- | Forwards composition, or `(<<<)` with its arguments reversed.+(>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d+(>>>) = flip compose++-- | `Category`s consist of objects and composable morphisms between them, and+-- | as such are [`Semigroupoids`](#semigroupoid), but unlike `semigroupoids`+-- | must have an identity element.+-- |+-- | Instances must satisfy the following law in addition to the+-- | `Semigroupoid` law:+-- |+-- | - Identity: `id <<< p = p <<< id = p`+class (Semigroupoid a) <= Category a where+  id :: forall t. a t t++instance categoryFn :: Category (->) where+  id x = x++-- | A `Functor` is a type constructor which supports a mapping operation+-- | `(<$>)`.+-- |+-- | `(<$>)` can be used to turn functions `a -> b` into functions+-- | `f a -> f b` whose argument and return types use the type constructor `f`+-- | to represent some computational context.+-- |+-- | Instances must satisfy the following laws:+-- |+-- | - Identity: `(<$>) id = id`+-- | - Composition: `(<$>) (f <<< g) = (f <$>) <<< (g <$>)`+class Functor f where+  map :: forall a b. (a -> b) -> f a -> f b++instance functorFn :: Functor ((->) r) where+  map = compose++instance functorArray :: Functor Array where+  map = arrayMap++foreign import arrayMap :: forall a b. (a -> b) -> Array a -> Array b++infixl 4 <$>+infixl 1 <#>++-- | `(<$>)` is an alias for `map`+(<$>) :: forall f a b. (Functor f) => (a -> b) -> f a -> f b+(<$>) = map++-- | `(<#>)` is `(<$>)` with its arguments reversed. For example:+-- |+-- | ```purescript+-- | [1, 2, 3] <#> \n -> n * n+-- | ```+(<#>) :: forall f a b. (Functor f) => f a -> (a -> b) -> f b+(<#>) fa f = f <$> fa++-- | The `void` function is used to ignore the type wrapped by a+-- | [`Functor`](#functor), replacing it with `Unit` and keeping only the type+-- | information provided by the type constructor itself.+-- |+-- | `void` is often useful when using `do` notation to change the return type+-- | of a monadic computation:+-- |+-- | ```purescript+-- | main = forE 1 10 \n -> void do+-- |   print n+-- |   print (n * n)+-- | ```+void :: forall f a. (Functor f) => f a -> f Unit+void fa = const unit <$> fa++-- | The `Apply` class provides the `(<*>)` which is used to apply a function+-- | to an argument under a type constructor.+-- |+-- | `Apply` can be used to lift functions of two or more arguments to work on+-- | values wrapped with the type constructor `f`. It might also be understood+-- | in terms of the `lift2` function:+-- |+-- | ```purescript+-- | lift2 :: forall f a b c. (Apply f) => (a -> b -> c) -> f a -> f b -> f c+-- | lift2 f a b = f <$> a <*> b+-- | ```+-- |+-- | `(<*>)` is recovered from `lift2` as `lift2 ($)`. That is, `(<*>)` lifts+-- | the function application operator `($)` to arguments wrapped with the+-- | type constructor `f`.+-- |+-- | Instances must satisfy the following law in addition to the `Functor`+-- | laws:+-- |+-- | - Associative composition: `(<<<) <$> f <*> g <*> h = f <*> (g <*> h)`+-- |+-- | Formally, `Apply` represents a strong lax semi-monoidal endofunctor.+class (Functor f) <= Apply f where+  apply :: forall a b. f (a -> b) -> f a -> f b++instance applyFn :: Apply ((->) r) where+  apply f g x = f x (g x)++instance applyArray :: Apply Array where+  apply = ap++infixl 4 <*>++-- | `(<*>)` is an alias for `apply`.+(<*>) :: forall f a b. (Apply f) => f (a -> b) -> f a -> f b+(<*>) = apply++-- | The `Applicative` type class extends the [`Apply`](#apply) type class+-- | with a `pure` function, which can be used to create values of type `f a`+-- | from values of type `a`.+-- |+-- | Where [`Apply`](#apply) provides the ability to lift functions of two or+-- | more arguments to functions whose arguments are wrapped using `f`, and+-- | [`Functor`](#functor) provides the ability to lift functions of one+-- | argument, `pure` can be seen as the function which lifts functions of+-- | _zero_ arguments. That is, `Applicative` functors support a lifting+-- | operation for any number of function arguments.+-- |+-- | Instances must satisfy the following laws in addition to the `Apply`+-- | laws:+-- |+-- | - Identity: `(pure id) <*> v = v`+-- | - Composition: `(pure <<<) <*> f <*> g <*> h = f <*> (g <*> h)`+-- | - Homomorphism: `(pure f) <*> (pure x) = pure (f x)`+-- | - Interchange: `u <*> (pure y) = (pure ($ y)) <*> u`+class (Apply f) <= Applicative f where+  pure :: forall a. a -> f a++instance applicativeFn :: Applicative ((->) r) where+  pure = const++instance applicativeArray :: Applicative Array where+  pure x = [x]++-- | `return` is an alias for `pure`.+return :: forall m a. (Applicative m) => a -> m a+return = pure++-- | `liftA1` provides a default implementation of `(<$>)` for any+-- | [`Applicative`](#applicative) functor, without using `(<$>)` as provided+-- | by the [`Functor`](#functor)-[`Applicative`](#applicative) superclass+-- | relationship.+-- |+-- | `liftA1` can therefore be used to write [`Functor`](#functor) instances+-- | as follows:+-- |+-- | ```purescript+-- | instance functorF :: Functor F where+-- |   map = liftA1+-- | ```+liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b+liftA1 f a = pure f <*> a++-- | The `Bind` type class extends the [`Apply`](#apply) type class with a+-- | "bind" operation `(>>=)` which composes computations in sequence, using+-- | the return value of one computation to determine the next computation.+-- |+-- | The `>>=` operator can also be expressed using `do` notation, as follows:+-- |+-- | ```purescript+-- | x >>= f = do y <- x+-- |              f y+-- | ```+-- |+-- | where the function argument of `f` is given the name `y`.+-- |+-- | Instances must satisfy the following law in addition to the `Apply`+-- | laws:+-- |+-- | - Associativity: `(x >>= f) >>= g = x >>= (\k => f k >>= g)`+-- |+-- | Associativity tells us that we can regroup operations which use `do`+-- | notation so that we can unambiguously write, for example:+-- |+-- | ```purescript+-- | do x <- m1+-- |    y <- m2 x+-- |    m3 x y+-- | ```+class (Apply m) <= Bind m where+  bind :: forall a b. m a -> (a -> m b) -> m b++instance bindFn :: Bind ((->) r) where+  bind m f x = f (m x) x++instance bindArray :: Bind Array where+  bind = arrayBind++foreign import arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b++infixl 1 >>=++-- | `(>>=)` is an alias for `bind`.+(>>=) :: forall m a b. (Bind m) => m a -> (a -> m b) -> m b+(>>=) = bind++-- | The `Monad` type class combines the operations of the `Bind` and+-- | `Applicative` type classes. Therefore, `Monad` instances represent type+-- | constructors which support sequential composition, and also lifting of+-- | functions of arbitrary arity.+-- |+-- | Instances must satisfy the following laws in addition to the+-- | `Applicative` and `Bind` laws:+-- |+-- | - Left Identity: `pure x >>= f = f x`+-- | - Right Identity: `x >>= pure = x`+class (Applicative m, Bind m) <= Monad m++instance monadFn :: Monad ((->) r)+instance monadArray :: Monad Array++-- | `liftM1` provides a default implementation of `(<$>)` for any+-- | [`Monad`](#monad), without using `(<$>)` as provided by the+-- | [`Functor`](#functor)-[`Monad`](#monad) superclass relationship.+-- |+-- | `liftM1` can therefore be used to write [`Functor`](#functor) instances+-- | as follows:+-- |+-- | ```purescript+-- | instance functorF :: Functor F where+-- |   map = liftM1+-- | ```+liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b+liftM1 f a = do+  a' <- a+  return (f a')++-- | `ap` provides a default implementation of `(<*>)` for any+-- | [`Monad`](#monad), without using `(<*>)` as provided by the+-- | [`Apply`](#apply)-[`Monad`](#monad) superclass relationship.+-- |+-- | `ap` can therefore be used to write [`Apply`](#apply) instances as+-- | follows:+-- |+-- | ```purescript+-- | instance applyF :: Apply F where+-- |   apply = ap+-- | ```+ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b+ap f a = do+  f' <- f+  a' <- a+  return (f' a')++-- | The `Semigroup` type class identifies an associative operation on a type.+-- |+-- | Instances are required to satisfy the following law:+-- |+-- | - Associativity: `(x <> y) <> z = x <> (y <> z)`+-- |+-- | One example of a `Semigroup` is `String`, with `(<>)` defined as string+-- | concatenation.+class Semigroup a where+  append :: a -> a -> a++infixr 5 <>+infixr 5 ++++-- | `(<>)` is an alias for `append`.+(<>) :: forall s. (Semigroup s) => s -> s -> s+(<>) = append++-- | `(++)` is an alternative alias for `append`.+(++) :: forall s. (Semigroup s) => s -> s -> s+(++) = append++instance semigroupString :: Semigroup String where+  append = concatString++instance semigroupUnit :: Semigroup Unit where+  append _ _ = unit++instance semigroupFn :: (Semigroup s') => Semigroup (s -> s') where+  append f g = \x -> f x <> g x++instance semigroupOrdering :: Semigroup Ordering where+  append LT _ = LT+  append GT _ = GT+  append EQ y = y++instance semigroupArray :: Semigroup (Array a) where+  append = concatArray++foreign import concatString :: String -> String -> String+foreign import concatArray :: forall a. Array a -> Array a -> Array a++-- | The `Semiring` class is for types that support an addition and+-- | multiplication operation.+-- |+-- | Instances must satisfy the following laws:+-- |+-- | - Commutative monoid under addition:+-- |   - Associativity: `(a + b) + c = a + (b + c)`+-- |   - Identity: `zero + a = a + zero = a`+-- |   - Commutative: `a + b = b + a`+-- | - Monoid under multiplication:+-- |   - Associativity: `(a * b) * c = a * (b * c)`+-- |   - Identity: `one * a = a * one = a`+-- | - Multiplication distributes over addition:+-- |   - Left distributivity: `a * (b + c) = (a * b) + (a * c)`+-- |   - Right distributivity: `(a + b) * c = (a * c) + (b * c)`+-- | - Annihiliation: `zero * a = a * zero = zero`+class Semiring a where+  add  :: a -> a -> a+  zero :: a+  mul  :: a -> a -> a+  one  :: a++instance semiringInt :: Semiring Int where+  add = intAdd+  zero = 0+  mul = intMul+  one = 1++instance semiringNumber :: Semiring Number where+  add = numAdd+  zero = 0.0+  mul = numMul+  one = 1.0++instance semiringUnit :: Semiring Unit where+  add _ _ = unit+  zero = unit+  mul _ _ = unit+  one = unit++infixl 6 ++infixl 7 *++-- | `(+)` is an alias for `add`.+(+) :: forall a. (Semiring a) => a -> a -> a+(+) = add++-- | `(*)` is an alias for `mul`.+(*) :: forall a. (Semiring a) => a -> a -> a+(*) = mul++foreign import intAdd :: Int -> Int -> Int+foreign import intMul :: Int -> Int -> Int+foreign import numAdd :: Number -> Number -> Number+foreign import numMul :: Number -> Number -> Number++-- | The `Ring` class is for types that support addition, multiplication,+-- | and subtraction operations.+-- |+-- | Instances must satisfy the following law in addition to the `Semiring`+-- | laws:+-- |+-- | - Additive inverse: `a - a = (zero - a) + a = zero`+class (Semiring a) <= Ring a where+  sub :: a -> a -> a++instance ringInt :: Ring Int where+  sub = intSub++instance ringNumber :: Ring Number where+  sub = numSub++instance ringUnit :: Ring Unit where+  sub _ _ = unit++infixl 6 -++-- | `(-)` is an alias for `sub`.+(-) :: forall a. (Ring a) => a -> a -> a+(-) = sub++-- | `negate x` can be used as a shorthand for `zero - x`.+negate :: forall a. (Ring a) => a -> a+negate a = zero - a++foreign import intSub :: Int -> Int -> Int+foreign import numSub :: Number -> Number -> Number++-- | The `ModuloSemiring` class is for types that support addition,+-- | multiplication, division, and modulo (division remainder) operations.+-- |+-- | Instances must satisfy the following law in addition to the `Semiring`+-- | laws:+-- |+-- | - Remainder: `a / b * b + (a `mod` b) = a`+class (Semiring a) <= ModuloSemiring a where+  div :: a -> a -> a+  mod :: a -> a -> a++instance moduloSemiringInt :: ModuloSemiring Int where+  div = intDiv+  mod = intMod++instance moduloSemiringNumber :: ModuloSemiring Number where+  div = numDiv+  mod _ _ = 0.0++instance moduloSemiringUnit :: ModuloSemiring Unit where+  div _ _ = unit+  mod _ _ = unit++infixl 7 /++-- | `(/)` is an alias for `div`.+(/) :: forall a. (ModuloSemiring a) => a -> a -> a+(/) = div++foreign import intDiv :: Int -> Int -> Int+foreign import numDiv :: Number -> Number -> Number+foreign import intMod :: Int -> Int -> Int++-- | A `Ring` where every nonzero element has a multiplicative inverse.+-- |+-- | Instances must satisfy the following law in addition to the `Ring` and+-- | `ModuloSemiring` laws:+-- |+-- | - Multiplicative inverse: `(one / x) * x = one`+-- |+-- | As a consequence of this ```a `mod` b = zero``` as no divide operation+-- | will have a remainder.+class (Ring a, ModuloSemiring a) <= DivisionRing a++instance divisionRingNumber :: DivisionRing Number+instance divisionRingUnit :: DivisionRing Unit++-- | The `Num` class is for types that are commutative fields.+-- |+-- | Instances must satisfy the following law in addition to the+-- | `DivisionRing` laws:+-- |+-- | - Commutative multiplication: `a * b = b * a`+class (DivisionRing a) <= Num a++instance numNumber :: Num Number+instance numUnit :: Num Unit++-- | The `Eq` type class represents types which support decidable equality.+-- |+-- | `Eq` instances should satisfy the following laws:+-- |+-- | - Reflexivity: `x == x = true`+-- | - Symmetry: `x == y = y == x`+-- | - Transitivity: if `x == y` and `y == z` then `x == z`+class Eq a where+  eq :: a -> a -> Boolean++infix 4 ==+infix 4 /=++-- | `(==)` is an alias for `eq`. Tests whether one value is equal to another.+(==) :: forall a. (Eq a) => a -> a -> Boolean+(==) = eq++-- | `(/=)` tests whether one value is _not equal_ to another. Shorthand for+-- | `not (x == y)`.+(/=) :: forall a. (Eq a) => a -> a -> Boolean+(/=) x y = not (x == y)++instance eqBoolean :: Eq Boolean where+  eq = refEq++instance eqInt :: Eq Int where+  eq = refEq++instance eqNumber :: Eq Number where+  eq = refEq++instance eqChar :: Eq Char where+  eq = refEq++instance eqString :: Eq String where+  eq = refEq++instance eqUnit :: Eq Unit where+  eq _ _ = true++instance eqArray :: (Eq a) => Eq (Array a) where+  eq = eqArrayImpl (==)++instance eqOrdering :: Eq Ordering where+  eq LT LT = true+  eq GT GT = true+  eq EQ EQ = true+  eq _  _  = false++foreign import refEq :: forall a. a -> a -> Boolean+foreign import refIneq :: forall a. a -> a -> Boolean+foreign import eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean++-- | The `Ordering` data type represents the three possible outcomes of+-- | comparing two values:+-- |+-- | `LT` - The first value is _less than_ the second.+-- | `GT` - The first value is _greater than_ the second.+-- | `EQ` - The first value is _equal to_ the second.+data Ordering = LT | GT | EQ++-- | The `Ord` type class represents types which support comparisons with a+-- | _total order_.+-- |+-- | `Ord` instances should satisfy the laws of total orderings:+-- |+-- | - Reflexivity: `a <= a`+-- | - Antisymmetry: if `a <= b` and `b <= a` then `a = b`+-- | - Transitivity: if `a <= b` and `b <= c` then `a <= c`+class (Eq a) <= Ord a where+  compare :: a -> a -> Ordering++instance ordBoolean :: Ord Boolean where+  compare = unsafeCompare++instance ordInt :: Ord Int where+  compare = unsafeCompare++instance ordNumber :: Ord Number where+  compare = unsafeCompare++instance ordString :: Ord String where+  compare = unsafeCompare++instance ordChar :: Ord Char where+  compare = unsafeCompare++instance ordUnit :: Ord Unit where+  compare _ _ = EQ++instance ordArray :: (Ord a) => Ord (Array a) where+  compare xs ys = compare 0 $ ordArrayImpl (\x y -> case compare x y of+                                                EQ -> 0+                                                LT -> 1+                                                GT -> -1) xs ys++foreign import ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int++instance ordOrdering :: Ord Ordering where+  compare LT LT = EQ+  compare EQ EQ = EQ+  compare GT GT = EQ+  compare LT _  = LT+  compare EQ LT = GT+  compare EQ GT = LT+  compare GT _  = GT++infixl 4 <+infixl 4 >+infixl 4 <=+infixl 4 >=++-- | Test whether one value is _strictly less than_ another.+(<) :: forall a. (Ord a) => a -> a -> Boolean+(<) a1 a2 = case a1 `compare` a2 of+  LT -> true+  _ -> false++-- | Test whether one value is _strictly greater than_ another.+(>) :: forall a. (Ord a) => a -> a -> Boolean+(>) a1 a2 = case a1 `compare` a2 of+  GT -> true+  _ -> false++-- | Test whether one value is _non-strictly less than_ another.+(<=) :: forall a. (Ord a) => a -> a -> Boolean+(<=) a1 a2 = case a1 `compare` a2 of+  GT -> false+  _ -> true++-- | Test whether one value is _non-strictly greater than_ another.+(>=) :: forall a. (Ord a) => a -> a -> Boolean+(>=) a1 a2 = case a1 `compare` a2 of+  LT -> false+  _ -> true++unsafeCompare :: forall a. a -> a -> Ordering+unsafeCompare = unsafeCompareImpl LT EQ GT++foreign import unsafeCompareImpl :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering++-- | The `Bounded` type class represents types that are finite.+-- |+-- | Although there are no "internal" laws for `Bounded`, every value of `a`+-- | should be considered less than or equal to `top` by some means, and greater+-- | than or equal to `bottom`.+-- |+-- | The lack of explicit `Ord` constraint allows flexibility in the use of+-- | `Bounded` so it can apply to total and partially ordered sets, boolean+-- | algebras, etc.+class Bounded a where+  top :: a+  bottom :: a++instance boundedBoolean :: Bounded Boolean where+  top = true+  bottom = false++instance boundedUnit :: Bounded Unit where+  top = unit+  bottom = unit++instance boundedOrdering :: Bounded Ordering where+  top = GT+  bottom = LT++instance boundedInt :: Bounded Int where+  top = 2147483647+  bottom = -2147483648++instance boundedFn :: (Bounded b) => Bounded (a -> b) where+  top _ = top+  bottom _ = bottom++-- | The `BoundedOrd` type class represents totally ordered finite data types.+-- |+-- | Instances should satisfy the following law in addition to the `Ord` laws:+-- |+-- | - Ordering: `bottom <= a <= top`+class (Bounded a, Ord a) <= BoundedOrd a++instance boundedOrdBoolean :: BoundedOrd Boolean where+instance boundedOrdUnit :: BoundedOrd Unit where+instance boundedOrdOrdering :: BoundedOrd Ordering where+instance boundedOrdInt :: BoundedOrd Int where++-- | The `BooleanAlgebra` type class represents types that behave like boolean+-- | values.+-- |+-- | Instances should satisfy the following laws in addition to the `Bounded`+-- | laws:+-- |+-- | - Associativity:+-- |   - `a || (b || c) = (a || b) || c`+-- |   - `a && (b && c) = (a && b) && c`+-- | - Commutativity:+-- |   - `a || b = b || a`+-- |   - `a && b = b && a`+-- | - Distributivity:+-- |   - `a && (b || c) = (a && b) || (a && c)`+-- |   - `a || (b && c) = (a || b) && (a || c)`+-- | - Identity:+-- |   - `a || bottom = a`+-- |   - `a && top = a`+-- | - Idempotent:+-- |   - `a || a = a`+-- |   - `a && a = a`+-- | - Absorption:+-- |   - `a || (a && b) = a`+-- |   - `a && (a || b) = a`+-- | - Annhiliation:+-- |   - `a || top = top`+-- | - Complementation:+-- |   - `a && not a = bottom`+-- |   - `a || not a = top`+class (Bounded a) <= BooleanAlgebra a where+  conj :: a -> a -> a+  disj :: a -> a -> a+  not :: a -> a++instance booleanAlgebraBoolean :: BooleanAlgebra Boolean where+  conj = boolAnd+  disj = boolOr+  not = boolNot++instance booleanAlgebraUnit :: BooleanAlgebra Unit where+  conj _ _ = unit+  disj _ _ = unit+  not _ = unit++instance booleanAlgebraFn :: (BooleanAlgebra b) => BooleanAlgebra (a -> b) where+  conj fx fy a = fx a `conj` fy a+  disj fx fy a = fx a `disj` fy a+  not fx a = not (fx a)++infixr 3 &&+infixr 2 ||++-- | `(&&)` is an alias for `conj`.+(&&) :: forall a. (BooleanAlgebra a) => a -> a -> a+(&&) = conj++-- | `(||)` is an alias for `disj`.+(||) :: forall a. (BooleanAlgebra a) => a -> a -> a+(||) = disj++foreign import boolOr :: Boolean -> Boolean -> Boolean+foreign import boolAnd :: Boolean -> Boolean -> Boolean+foreign import boolNot :: Boolean -> Boolean++-- | The `Show` type class represents those types which can be converted into+-- | a human-readable `String` representation.+-- |+-- | While not required, it is recommended that for any expression `x`, the+-- | string `show x` be executable PureScript code which evaluates to the same+-- | value as the expression `x`.+class Show a where+  show :: a -> String++instance showBoolean :: Show Boolean where+  show true = "true"+  show false = "false"++instance showInt :: Show Int where+  show = showIntImpl++instance showNumber :: Show Number where+  show = showNumberImpl++instance showChar :: Show Char where+  show = showCharImpl++instance showString :: Show String where+  show = showStringImpl++instance showUnit :: Show Unit where+  show _ = "unit"++instance showArray :: (Show a) => Show (Array a) where+  show = showArrayImpl show++instance showOrdering :: Show Ordering where+  show LT = "LT"+  show GT = "GT"+  show EQ = "EQ"++foreign import showIntImpl :: Int -> String+foreign import showNumberImpl :: Number -> String+foreign import showCharImpl :: Char -> String+foreign import showStringImpl :: String -> String+foreign import showArrayImpl :: forall a. (a -> String) -> Array a -> String
+ tests/support/flattened/Test-Assert.js view
@@ -0,0 +1,27 @@+/* global exports */+"use strict";++// module Test.Assert++exports["assert'"] = function (message) {+  return function (success) {+    return function () {+      if (!success) throw new Error(message);+      return {};+    };+  };+};++exports.checkThrows = function (fn) {+  return function () {+    try {+      fn();+      return false;+    } catch (e) {+      if (e instanceof Error) return true;+      var err = new Error("Threw something other than an Error");+      err.something = e;+      throw err;+    }+  };+};
+ tests/support/flattened/Test-Assert.purs view
@@ -0,0 +1,46 @@+module Test.Assert+  ( assert'+  , assert+  , assertThrows+  , assertThrows'+  , ASSERT()+  ) where++import Control.Monad.Eff (Eff())+import Prelude++-- | Assertion effect type.+foreign import data ASSERT :: !++-- | Throws a runtime exception with message "Assertion failed" when the boolean+-- | value is false.+assert :: forall e. Boolean -> Eff (assert :: ASSERT | e) Unit+assert = assert' "Assertion failed"++-- | Throws a runtime exception with the specified message when the boolean+-- | value is false.+foreign import assert' :: forall e. String -> Boolean -> Eff (assert :: ASSERT | e) Unit++-- | Throws a runtime exception with message "Assertion failed: An error should+-- | have been thrown", unless the argument throws an exception when evaluated.+-- |+-- | This function is specifically for testing unsafe pure code; for example,+-- | to make sure that an exception is thrown if a precondition is not+-- | satisfied. Functions which use `Eff (err :: EXCEPTION | eff) a` can be+-- | tested with `catchException` instead.+assertThrows :: forall e a. (Unit -> a) -> Eff (assert :: ASSERT | e) Unit+assertThrows = assertThrows' "Assertion failed: An error should have been thrown"++-- | Throws a runtime exception with the specified message, unless the argument+-- | throws an exception when evaluated.+-- |+-- | This function is specifically for testing unsafe pure code; for example,+-- | to make sure that an exception is thrown if a precondition is not+-- | satisfied. Functions which use `Eff (err :: EXCEPTION | eff) a` can be+-- | tested with `catchException` instead.+assertThrows' :: forall e a. String -> (Unit -> a) -> Eff (assert :: ASSERT | e) Unit+assertThrows' msg fn =+  checkThrows fn >>= assert' msg+++foreign import checkThrows :: forall e a. (Unit -> a) -> Eff (assert :: ASSERT | e) Boolean