purescript 0.7.5.2 → 0.7.5.3

raw patch · 8 files changed

+27/−11 lines, 8 files

Files

examples/failing/EmptyClass.purs +7/−0
examples/passing/NakedConstraint.purs +1/−1
purescript.cabal +1/−1
src/Language/PureScript/Errors.hs +9/−4
src/Language/PureScript/Linter/Exhaustive.hs +1/−1
src/Language/PureScript/Parser/Declarations.hs +1/−1
src/Language/PureScript/Sugar/Names.hs +6/−2
src/Language/PureScript/TypeChecker/Types.hs +1/−1

+ examples/failing/EmptyClass.purs view

@@ -0,0 +1,7 @@+-- @shouldFailWith ErrorParsingModule+module Main where++class Foo x where++bar :: String+bar = "hello"

examples/passing/NakedConstraint.purs view

@@ -2,7 +2,7 @@  import Control.Monad.Eff.Console -class Partial where+class Partial   data List a = Nil | Cons a (List a)

purescript.cabal view

@@ -1,5 +1,5 @@ name: purescript-version: 0.7.5.2+version: 0.7.5.3 cabal-version: >=1.8 build-type: Simple license: MIT

src/Language/PureScript/Errors.hs view

@@ -156,6 +156,7 @@   | ErrorCheckingAccessor Expr String   | ErrorCheckingType Expr Type   | ErrorCheckingKind Type+  | ErrorCheckingGuard   | ErrorInferringType Expr   | ErrorInApplication Expr Type Expr   | ErrorInDataConstructor ProperName@@ -530,15 +531,15 @@                                           , indent $ prettyPrintValue expr                                           ]) binding     renderSimpleErrorMessage (TypesDoNotUnify t1 t2)-      = paras [ line "Could not match expected type"+      = paras [ line "Could not match type"               , indent $ typeAsBox t1-              , line "with actual type"+              , line "with type"               , indent $ typeAsBox t2               ]     renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =-      paras [ line "Could not match expected kind"+      paras [ line "Could not match kind"             , indent $ line $ prettyPrintKind k1-            , line "with actual kind"+            , line "with kind"             , indent $ line $ prettyPrintKind k2             ]     renderSimpleErrorMessage (ConstrainedTypeUnified t1 t2) =@@ -729,6 +730,10 @@             , Box.hsep 1 Box.top [ line "while checking the kind of"                                  , typeAsBox ty                                  ]+            ]+    renderHint ErrorCheckingGuard detail =+      paras [ detail+            , line "while checking the type of a guard clause"             ]     renderHint (ErrorInferringType expr) detail =       paras [ detail

src/Language/PureScript/Linter/Exhaustive.hs view

@@ -246,7 +246,7 @@   step :: ([[Binder]], (Either RedudancyError Bool, [[Binder]])) -> CaseAlternative -> ([[Binder]], (Either RedudancyError Bool, [[Binder]]))   step (uncovered, (nec, redundant)) ca =     let (missed, pr) = unzip (map (missingAlternative env mn ca) uncovered)-        (missed', approx) = splitAt 10000 (concat missed)+        (missed', approx) = splitAt 10000 (nub (concat missed))         cond = liftA2 (&&) (or <$> sequenceA pr) nec     in (missed', ( if null approx                      then cond

src/Language/PureScript/Parser/Declarations.hs view

@@ -201,7 +201,7 @@   idents <- P.many (indented *> kindedIdent)   members <- P.option [] . P.try $ do     indented *> reserved "where"-    mark (P.many (same *> positioned parseTypeDeclaration))+    indented *> mark (P.many (same *> positioned parseTypeDeclaration))   return $ TypeClassDeclaration className idents implies members  parseInstanceDeclaration :: TokenParser (TypeInstanceBody -> Declaration)

src/Language/PureScript/Sugar/Names.hs view

@@ -22,11 +22,12 @@ import Data.Maybe (fromMaybe, mapMaybe)  #if __GLASGOW_HASKELL__ < 710+import Data.Monoid (mempty) import Control.Applicative (Applicative(..), (<$>), (<*>)) #endif import Control.Monad import Control.Monad.Error.Class (MonadError(..))-import Control.Monad.Writer (MonadWriter(..))+import Control.Monad.Writer (MonadWriter(..), censor)  import qualified Data.Map as M @@ -47,10 +48,13 @@ -- desugarImports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => [ExternsFile] -> [Module] -> m [Module] desugarImports externs modules = do-  env <- foldM externsEnv primEnv externs+  env <- silence $ foldM externsEnv primEnv externs   env' <- foldM updateEnv env modules   mapM (renameInModule' env') modules   where+  silence :: m a -> m a+  silence = censor (const mempty)+   -- | Create an environment from a collection of externs files   externsEnv :: Env -> ExternsFile -> m Env   externsEnv env ExternsFile{..} = do

src/Language/PureScript/TypeChecker/Types.hs view

@@ -418,7 +418,7 @@       case result of         Left gs -> do           gs' <- forM gs $ \(grd, val) -> do-            grd' <- check grd tyBoolean+            grd' <- rethrow (addHint ErrorCheckingGuard) $ check grd tyBoolean             val' <- TypedValue True <$> check val ret <*> pure ret             return (grd', val')           return $ Left gs'