Merge pull request #1358 from elm-lang/dev

Bring in some fixes pointed out by folks using 0.17

LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2012-2015, Evan Czaplicki
+Copyright (c) 2012-2016, Evan Czaplicki
 
 All rights reserved.
 

README.md

@@ -1,13 +1,13 @@
 Learn about the Elm programming language at [elm-lang.org](http://elm-lang.org/).
 
-[![Build Status](https://travis-ci.org/elm-lang/elm-compiler.svg)](https://travis-ci.org/elm-lang/elm-compiler)
+[![Build Status](https://travis-ci.org/elm-lang/elm-compiler.svg?branch=master)](https://travis-ci.org/elm-lang/elm-compiler)
 
 ## Install
 
 Follow [these instructions][installer] to use Elm on your machine. Be sure to use
 the platform specific installers if you are on Mac or Windows. It's way easier!
 
- [installer]: https://github.com/elm-lang/elm-platform/blob/master/README.md#elm-platform 
+ [installer]: https://github.com/elm-lang/elm-platform/blob/master/README.md#elm-platform
 
 ## Build from source / Contribute
 
@@ -22,4 +22,4 @@ how the script works and what your workflow will be like.
 If you are stuck, email
 [the list](https://groups.google.com/forum/?fromgroups#!forum/elm-discuss)
 or ask a question in the
-[#Elm IRC channel](http://webchat.freenode.net/?channels=elm). 
+[#Elm IRC channel](http://webchat.freenode.net/?channels=elm).

src/Canonicalize/Effects.hs

@@ -73,7 +73,7 @@ figureOutKind region name rootType =
             <* checkPortType (makeError region name) incomingType
 
     _ ->
-      Result.throw region (error "TODO - bad overall type")
+      Result.throw region (Error.BadPort name rootType)
 
 
 makeError :: R.Region -> String -> T.Canonical -> Maybe String -> A.Located Error.Error

src/Parse/Pattern.hs

@@ -18,23 +18,21 @@ basic =
   addLocation $
     choice
       [ char '_' >> return P.Anything
-      , stringToPattern <$> var
+      , P.Var <$> lowVar
+      , chunksToPatterns <$> dotSep1 capVar
       , P.Literal <$> Literal.literal
       ]
   where
-    stringToPattern str =
-        case str of
-          "True" ->
-              P.Literal (L.Boolean True)
+    chunksToPatterns chunks =
+      case List.intercalate "." chunks of
+        "True" ->
+          P.Literal (L.Boolean True)
 
-          "False" ->
-              P.Literal (L.Boolean False)
+        "False" ->
+          P.Literal (L.Boolean False)
 
-          c:_ | isUpper c ->
-              P.Data (Var.Raw str) []
-
-          _ ->
-              P.Var str
+        name ->
+          P.Data (Var.Raw name) []
 
 
 asPattern :: IParser P.Raw -> IParser P.Raw
@@ -94,11 +92,16 @@ term =
 patternConstructor :: IParser P.Raw
 patternConstructor =
   addLocation $
-    do  v <- List.intercalate "." <$> dotSep1 capVar
-        case v of
-          "True"  -> return $ P.Literal (L.Boolean True)
-          "False" -> return $ P.Literal (L.Boolean False)
-          _       -> P.Data (Var.Raw v) <$> spacePrefix term
+    do  name <- List.intercalate "." <$> dotSep1 capVar
+        case name of
+          "True" ->
+            return $ P.Literal (L.Boolean True)
+
+          "False" ->
+            return $ P.Literal (L.Boolean False)
+
+          _ ->
+            P.Data (Var.Raw name) <$> spacePrefix term
 
 
 expr :: IParser P.Raw

src/Reporting/Error/Canonicalize.hs

@@ -23,6 +23,7 @@ data Error
     | Export String [String]
     | DuplicateExport String
     | Port PortError
+    | BadPort String Type.Canonical
 
 
 
@@ -242,6 +243,21 @@ toReport localizer err =
               ]
           )
 
+    BadPort name tipe ->
+      Report.report
+        "PORT ERROR"
+        Nothing
+        ("Port `" ++ name ++ "` has an invalid type."
+        )
+        ( Help.stack
+            [ text ("You are saying it should be:")
+            , indent 4 (RenderType.toDoc localizer tipe)
+            , Help.reflowParagraph $
+                "But you need to use the particular format described here:\
+                \ <http://guide.elm-lang.org/effect_managers/>"
+            ]
+        )
+
 
 argMismatchReport :: String -> Var.Canonical -> Int -> Int -> Report.Report
 argMismatchReport kind var expected actual =
@@ -288,6 +304,9 @@ extractSuggestions err =
     Port _ ->
         Nothing
 
+    BadPort _ _ ->
+        Nothing
+
 
 unsafePromote :: Type.Raw -> Type.Canonical
 unsafePromote (A.A _ rawType) =

src/Reporting/Error/Syntax.hs

@@ -28,6 +28,8 @@ data Error
 
     | InfixDuplicate String
     | TypeWithoutDefinition String
+
+    | DuplicateArgument String String
     | DuplicateFieldName String
     | DuplicateValueDeclaration String
     | DuplicateTypeDeclaration String
@@ -135,7 +137,7 @@ toReport _localizer err =
               "If you just wanted a normal module, change the keywords `effect module`\
               \ to `module` and you should be all set. If you want a proper effect module,\
               \ you need to specify your commands and/or subscriptions. Read more about this\
-              \ here: <TODO> (please forgive me if I forgot to fill this in!)"
+              \ here: <http://guide.elm-lang.org/effect_managers/>"
           )
 
     MissingManagerOnEffectModule name ->
@@ -147,7 +149,7 @@ toReport _localizer err =
               "There is a small set of top-level functions and values that must be defined\
               \ in any complete effect module. The best thing is probably to just read more\
               \ about effect modules here:\
-              \ <TODO> (please forgive me if I forgot to fill this in!)"
+              \ <http://guide.elm-lang.org/effect_managers/>"
           )
 
     UnexpectedPort name ->
@@ -184,6 +186,20 @@ toReport _localizer err =
               ++ "    " ++ valueName ++ " = 42"
           )
 
+    DuplicateArgument funcName argName ->
+        Report.report
+          "DUPLICATE ARGUMENT"
+          Nothing
+          ( "The name `" ++ argName
+            ++ "` is used more than once in the arguments of `"
+            ++ funcName ++ "`."
+          )
+          ( Help.reflowParagraph $
+              "Rename things until `" ++ argName ++ "` is used only once.\
+              \ Otherwise how can we tell which one you want when you\
+              \ say `" ++ argName ++ "` it in the body of your function?"
+          )
+
     DuplicateFieldName name ->
         Report.report
           "DUPLICATE FIELD"
@@ -282,7 +298,7 @@ unboundTypeVars declKind typeName givenVars unboundVars =
         , Help.reflowParagraph $
             "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ head unboundVars ++
             "` is an Int and another where it is a Bool. When we explicitly list the type\
-            \ variables, type checker can see that they are actually different types."
+            \ variables, the type checker can see that they are actually different types."
         ]
     )
 

src/Reporting/Error/Type.hs

@@ -458,7 +458,8 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =
           ( cmpHint
               ("Your `" ++ name ++ "` function has this type:")
               "But it needs to have a type like this:"
-              [ "TODO - link to overview of effect managers"
+              [ "You can read more about setting up effect managers properly here:\
+                \ <http://guide.elm-lang.org/effect_managers/>"
               ]
           )
 
@@ -471,8 +472,8 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =
           ( cmpHint
               "The state created by `init` has this type:"
               ("But `" ++ name ++ "` expects state of this type:")
-              [ "Make the two state types match and you should be all set!"
-              , "TODO - link to overview of effect managers"
+              [ "Make the two state types match and you should be all set! More info here:\
+                \ <http://guide.elm-lang.org/effect_managers/>"
               ]
           )
 
@@ -483,8 +484,8 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =
           ( cmpHint
               "The `onEffects` function can send this type of message:"
               "But the `onSelfMsg` function receives this type:"
-              [ "Make the two message types match and you should be all set!"
-              , "TODO - link to overview of effect managers"
+              [ "Make the two message types match and you should be all set! More info here:\
+                \ <http://guide.elm-lang.org/effect_managers/>"
               ]
           )
 

src/Type/Unify.hs

@@ -519,8 +519,8 @@ unifyAlias context name args realVar otherContent =
 
     Alias otherName otherArgs otherRealVar ->
         if name == otherName then
-            do  merge context otherContent
-                zipWithM_ (subUnify context) (map snd args) (map snd otherArgs)
+            do  zipWithM_ (subUnify context) (map snd args) (map snd otherArgs)
+                merge context otherContent
 
         else
             subUnify context realVar otherRealVar

src/Validate.hs

@@ -1,8 +1,7 @@
 {-# OPTIONS_GHC -Wall #-}
 module Validate (Result, module') where
 
-import Prelude hiding (init)
-import Control.Monad (foldM, when)
+import Control.Monad (foldM_, when)
 import qualified Data.Map as Map
 import qualified Data.Maybe as Maybe
 import qualified Data.Set as Set
@@ -428,8 +427,8 @@ validateDefPattern pattern body =
 
     args ->
         case pattern of
-          A.A _ (Pattern.Var _) ->
-              return ()
+          A.A _ (Pattern.Var funcName) ->
+              checkArguments funcName args
 
           _ ->
               let
@@ -439,6 +438,22 @@ validateDefPattern pattern body =
                 Result.throw (R.merge start end) (Error.BadFunctionName (length args))
 
 
+checkArguments :: String -> [Pattern.Raw] -> Result wrn ()
+checkArguments funcName args =
+  let
+    vars =
+      concatMap Pattern.boundVars args
+
+    checkDups seenArgs (A.A region arg) =
+      if Set.member arg seenArgs then
+        Result.throw region (Error.DuplicateArgument funcName arg)
+
+      else
+        return (Set.insert arg seenArgs)
+  in
+    foldM_ checkDups Set.empty vars
+
+
 
 -- VALIDATE EXPRESSIONS
 
@@ -509,7 +524,7 @@ expression (A.A ann sourceExpression) =
               else
                   return (Set.insert field seenFields)
         in
-          do  _ <- foldM checkDups Set.empty fields
+          do  foldM_ checkDups Set.empty fields
               Record <$> T.traverse second fields
 
     Let defs body ->

tests/test-files/bad/RepeatedArgument.elm

@@ -0,0 +1,4 @@
+
+foo x x = 42
+
+bar x (x, y) = 42