packages feed

purescript 0.6.5 → 0.6.6

raw patch · 15 files changed

+99/−69 lines, 15 filesnew-component:exe:psc-hierarchyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Language.PureScript.Parser.Common: parseIdentInfix :: TokenParser (Qualified Ident)
- Language.PureScript.AST.Declarations: BinaryNoParens :: (Qualified Ident) -> Expr -> Expr -> Expr
+ Language.PureScript.AST.Declarations: BinaryNoParens :: Expr -> Expr -> Expr -> Expr
- Language.PureScript.AST.Declarations: ObjectUpdater :: Expr -> [(String, Maybe Expr)] -> Expr
+ Language.PureScript.AST.Declarations: ObjectUpdater :: (Maybe Expr) -> [(String, Maybe Expr)] -> Expr
- Language.PureScript.AST.Declarations: OperatorSection :: (Qualified Ident) -> (Either Expr Expr) -> Expr
+ Language.PureScript.AST.Declarations: OperatorSection :: Expr -> (Either Expr Expr) -> Expr

Files

+ examples/passing/ExtendedInfixOperators.purs view
@@ -0,0 +1,20 @@+module Main where++zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]+zipWith _ [] _  = []+zipWith _ _  [] = []+zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys++test1 = [1, 2, 3] `zipWith (+)` [4, 5, 6]++comparing :: forall a b. (Ord b) => (a -> b) -> a -> a -> Ordering+comparing f = compare `Data.Function.on` f++sum [] = 0+sum (x:xs) = x + sum xs++test2 = [1, 2, 3] `comparing sum` [4, 5, 6]++main = do+  Debug.Trace.print test1+  Debug.Trace.print test2
examples/passing/ObjectGetter.purs view
@@ -1,11 +1,11 @@ module Main where -getX = (.x)+getX = _.x  point = { x: 1, y: 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!" }+  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!" }
examples/passing/ObjectUpdater.purs view
@@ -30,3 +30,6 @@    print $ point'.x === 100   print $ point'.y === 10++  let record2 = (_ { x = _ }) { x: 0 } 10+  print $ record2.x === 10
psc-docs/Main.hs view
@@ -28,7 +28,7 @@ import qualified Language.PureScript as P import qualified Paths_purescript as Paths import System.Exit (exitSuccess, exitFailure)-import System.IO (hPutStr, stderr)+import System.IO (hPutStrLn, stderr)   data PSCDocsOptions = PSCDocsOptions@@ -42,7 +42,7 @@   e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)   case e of     Left err -> do-      hPutStr stderr $ show err+      hPutStrLn stderr $ show err       exitFailure     Right ms -> do       putStrLn . runDocs $ (renderModules showHierarchy) (map snd ms)
psc/Main.hs view
@@ -26,7 +26,7 @@ import System.Directory (createDirectoryIfMissing) import System.FilePath (takeDirectory) import System.Exit (exitSuccess, exitFailure)-import System.IO (hPutStr, hPutStrLn, stderr)+import System.IO (hPutStrLn, stderr)  import qualified Language.PureScript as P import qualified Paths_purescript as Paths@@ -58,7 +58,7 @@   modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)   case modules of     Left err -> do-      hPutStr stderr $ show err+      hPutStrLn stderr $ show err       exitFailure     Right ms -> do       case P.compile opts (map snd ms) prefix of
purescript.cabal view
@@ -1,5 +1,5 @@ name: purescript-version: 0.6.5+version: 0.6.6 cabal-version: >=1.8 build-type: Simple license: MIT@@ -159,7 +159,7 @@     other-modules:     ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -executable hierarchy+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     main-is: Main.hs
src/Language/PureScript/AST/Declarations.hs view
@@ -305,7 +305,7 @@   -- Binary operator application. During the rebracketing phase of desugaring, this data constructor   -- will be removed.   ---  | BinaryNoParens (Qualified Ident) Expr Expr+  | BinaryNoParens Expr Expr Expr   -- |   -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor   -- will be removed.@@ -315,7 +315,7 @@   -- Operator section. This will be removed during desugaring and replaced with a partially applied   -- operator or lambda to flip the arguments.   ---  | OperatorSection (Qualified Ident) (Either Expr Expr)+  | OperatorSection Expr (Either Expr Expr)   -- |   -- An array literal   --@@ -346,7 +346,7 @@   -- Partial record updater. This will be removed during desugaring and   -- expanded into a lambda that returns an object update.   ---  | ObjectUpdater Expr [(String, Maybe Expr)]+  | ObjectUpdater (Maybe Expr) [(String, Maybe Expr)]   -- |   -- Function introduction   --
src/Language/PureScript/AST/Traversals.hs view
@@ -43,17 +43,17 @@    g' :: Expr -> Expr   g' (UnaryMinus v) = g (UnaryMinus (g' v))-  g' (BinaryNoParens op v1 v2) = g (BinaryNoParens op (g' v1) (g' v2))+  g' (BinaryNoParens op v1 v2) = g (BinaryNoParens (g' op) (g' v1) (g' v2))   g' (Parens v) = g (Parens (g' v))-  g' (OperatorSection op (Left v)) = g (OperatorSection op (Left $ g' v))-  g' (OperatorSection op (Right v)) = g (OperatorSection op (Right $ g' v))+  g' (OperatorSection op (Left v)) = g (OperatorSection (g' op) (Left $ g' v))+  g' (OperatorSection op (Right v)) = g (OperatorSection (g' op) (Right $ g' v))   g' (ArrayLiteral vs) = g (ArrayLiteral (map g' vs))   g' (ObjectLiteral vs) = g (ObjectLiteral (map (fmap g') vs))   g' (ObjectConstructor vs) = g (ObjectConstructor (map (second (fmap g')) vs))   g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))   g' (Accessor prop v) = g (Accessor prop (g' v))   g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))-  g' (ObjectUpdater obj vs) = g (ObjectUpdater (g' obj) (map (second (fmap g')) vs))+  g' (ObjectUpdater obj vs) = g (ObjectUpdater (fmap g' obj) (map (second (fmap g')) vs))   g' (Abs name v) = g (Abs name (g' v))   g' (App v1 v2) = g (App (g' v1) (g' v2))   g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))@@ -85,7 +85,6 @@   handleDoNotationElement (DoNotationLet ds) = DoNotationLet (map f' ds)   handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com (handleDoNotationElement e) - everywhereOnValuesTopDownM :: (Functor m, Applicative m, Monad m) =>   (Declaration -> m Declaration) ->   (Expr -> m Expr) ->@@ -102,17 +101,17 @@   f' other = f other    g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')-  g' (BinaryNoParens op v1 v2) = BinaryNoParens op <$> (g v1 >>= g') <*> (g v2 >>= g')+  g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')   g' (Parens v) = Parens <$> (g v >>= g')-  g' (OperatorSection op (Left v)) = OperatorSection op . Left <$> (g v >>= g')-  g' (OperatorSection op (Right v)) = OperatorSection op . Right <$> (g v >>= g')+  g' (OperatorSection op (Left v)) = OperatorSection <$> (g op >>= g') <*> (Left <$> (g v >>= g'))+  g' (OperatorSection op (Right v)) = OperatorSection <$> (g op >>= g') <*> (Right <$> (g v >>= g'))   g' (ArrayLiteral vs) = ArrayLiteral <$> mapM (g' <=< g) vs   g' (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g' <=< g)) vs   g' (ObjectConstructor vs) = ObjectConstructor <$> mapM (sndM $ maybeM (g' <=< g)) vs   g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')   g' (Accessor prop v) = Accessor prop <$> (g v >>= g')   g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> mapM (sndM (g' <=< g)) vs-  g' (ObjectUpdater obj vs) = ObjectUpdater <$> (g obj >>= g') <*> mapM (sndM $ maybeM (g' <=< g)) vs+  g' (ObjectUpdater obj vs) = ObjectUpdater <$> (maybeM g obj >>= maybeM g') <*> mapM (sndM $ maybeM (g' <=< g)) vs   g' (Abs name v) = Abs name <$> (g v >>= g')   g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')   g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')@@ -155,17 +154,17 @@   f' other = f other    g' (UnaryMinus v) = (UnaryMinus <$> g' v) >>= g-  g' (BinaryNoParens op v1 v2) = (BinaryNoParens op <$> g' v1 <*> g' v2) >>= g+  g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g   g' (Parens v) = (Parens <$> g' v) >>= g-  g' (OperatorSection op (Left v)) = (OperatorSection op . Left <$> g' v) >>= g-  g' (OperatorSection op (Right v)) = (OperatorSection op . Right <$> g' v) >>= g+  g' (OperatorSection op (Left v)) = (OperatorSection <$> g' op <*> (Left <$> g' v)) >>= g+  g' (OperatorSection op (Right v)) = (OperatorSection <$> g' op <*> (Right <$> g' v)) >>= g   g' (ArrayLiteral vs) = (ArrayLiteral <$> mapM g' vs) >>= g   g' (ObjectLiteral vs) = (ObjectLiteral <$> mapM (sndM g') vs) >>= g   g' (ObjectConstructor vs) = (ObjectConstructor <$> mapM (sndM $ maybeM g') vs) >>= g   g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g   g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g   g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> mapM (sndM g') vs) >>= g-  g' (ObjectUpdater obj vs) = (ObjectUpdater <$> g' obj <*> mapM (sndM $ maybeM g') vs) >>= g+  g' (ObjectUpdater obj vs) = (ObjectUpdater <$> maybeM g' obj <*> mapM (sndM $ maybeM g') vs) >>= g   g' (Abs name v) = (Abs name <$> g' v) >>= g   g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g   g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g@@ -211,17 +210,17 @@   f' d = f d    g' v@(UnaryMinus v1) = g v <> g' v1-  g' v@(BinaryNoParens _ v1 v2) = g v <> g' v1 <> g' v2+  g' v@(BinaryNoParens op v1 v2) = g v <> g op <> g' v1 <> g' v2   g' v@(Parens v1) = g v <> g' v1-  g' v@(OperatorSection _ (Left v1)) = g v <> g' v1-  g' v@(OperatorSection _ (Right v1)) = g v <> g' v1+  g' v@(OperatorSection op (Left v1)) = g v <> g op <> g' v1+  g' v@(OperatorSection op (Right v1)) = g v <> g op <> g' v1   g' v@(ArrayLiteral vs) = foldl (<>) (g v) (map g' vs)   g' v@(ObjectLiteral vs) = foldl (<>) (g v) (map (g' . snd) vs)   g' v@(ObjectConstructor vs) = foldl (<>) (g v) (map g' (mapMaybe snd vs))   g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1   g' v@(Accessor _ v1) = g v <> g' v1   g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)-  g' v@(ObjectUpdater obj vs) = foldl (<>) (g v <> g' obj) (map g' (mapMaybe snd vs))+  g' v@(ObjectUpdater obj vs) = foldl (<>) (maybe (g v) (\x -> g v <> g' x) obj) (map g' (mapMaybe snd vs))   g' v@(Abs _ v1) = g v <> g' v1   g' v@(App v1 v2) = g v <> g' v1 <> g' v2   g' v@(IfThenElse v1 v2 v3) = g v <> g' v1 <> g' v2 <> g' v3@@ -278,17 +277,17 @@   g'' s v = let (s', r) = g s v in r <> g' s' v    g' s (UnaryMinus v1) = g'' s v1-  g' s (BinaryNoParens _ v1 v2) = g'' s v1 <> g'' s v2+  g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2   g' s (Parens v1) = g'' s v1-  g' s (OperatorSection _ (Left v)) = g'' s v-  g' s (OperatorSection _ (Right v)) = g'' s v+  g' s (OperatorSection op (Left v)) = g'' s op <> g'' s v+  g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v   g' s (ArrayLiteral vs) = foldl (<>) r0 (map (g'' s) vs)   g' s (ObjectLiteral vs) = foldl (<>) r0 (map (g'' s . snd) vs)   g' s (ObjectConstructor vs) = foldl (<>) r0 (map (g'' s) (mapMaybe snd vs))   g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1   g' s (Accessor _ v1) = g'' s v1   g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (map (g'' s . snd) vs)-  g' s (ObjectUpdater obj vs) = foldl (<>) (g'' s obj) (map (g'' s) (mapMaybe snd vs))+  g' s (ObjectUpdater obj vs) = foldl (<>) (maybe r0 (g'' s) obj) (map (g'' s) (mapMaybe snd vs))   g' s (Abs _ v1) = g'' s v1   g' s (App v1 v2) = g'' s v1 <> g'' s v2   g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3@@ -348,17 +347,17 @@   g'' s = uncurry g' <=< g s    g' s (UnaryMinus v) = UnaryMinus <$> g'' s v-  g' s (BinaryNoParens op v1 v2) = BinaryNoParens op <$> g'' s v1 <*> g'' s v2+  g' s (BinaryNoParens op v1 v2) = BinaryNoParens <$> g'' s op <*> g'' s v1 <*> g'' s v2   g' s (Parens v) = Parens <$> g'' s v-  g' s (OperatorSection op (Left v)) = OperatorSection op . Left <$> g'' s v-  g' s (OperatorSection op (Right v)) = OperatorSection op . Right <$> g'' s v+  g' s (OperatorSection op (Left v)) = OperatorSection <$> g'' s op <*> (Left <$> g'' s v)+  g' s (OperatorSection op (Right v)) = OperatorSection <$> g'' s op <*> (Right <$> g'' s v)   g' s (ArrayLiteral vs) = ArrayLiteral <$> mapM (g'' s) vs   g' s (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g'' s)) vs   g' s (ObjectConstructor vs) = ObjectConstructor <$> mapM (sndM $ maybeM (g'' s)) vs   g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v   g' s (Accessor prop v) = Accessor prop <$> g'' s v   g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> mapM (sndM (g'' s)) vs-  g' s (ObjectUpdater obj vs) = ObjectUpdater <$> g'' s obj <*> mapM (sndM $ maybeM (g'' s)) vs+  g' s (ObjectUpdater obj vs) = ObjectUpdater <$> maybeM (g'' s) obj <*> mapM (sndM $ maybeM (g'' s)) vs   g' s (Abs name v) = Abs name <$> g'' s v   g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2   g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3
src/Language/PureScript/ModuleDependencies.hs view
@@ -54,7 +54,6 @@    forValues :: Expr -> [ModuleName]   forValues (Var (Qualified (Just mn) _)) = [mn]-  forValues (BinaryNoParens (Qualified (Just mn) _) _ _) = [mn]   forValues (Constructor (Qualified (Just mn) _)) = [mn]   forValues (TypedValue _ _ ty) = forTypes ty   forValues _ = []
src/Language/PureScript/Parser/Common.hs view
@@ -89,12 +89,6 @@       Just a' -> go a'  -- |--- Parse an identifier in backticks or an operator----parseIdentInfix :: TokenParser (Qualified Ident)-parseIdentInfix = P.between tick tick (parseQualified (Ident <$> identifier)) <|> (parseQualified (Op <$> symbol))---- | -- Mark the current indentation level -- mark :: P.Parsec s ParseState a -> P.Parsec s ParseState a
src/Language/PureScript/Parser/Declarations.hs view
@@ -41,6 +41,7 @@ import Language.PureScript.Parser.Types import Language.PureScript.Parser.Kinds import Language.PureScript.Parser.Lexer+import Language.PureScript.Names import Language.PureScript.CodeGen.JS.AST import Language.PureScript.Environment @@ -354,13 +355,21 @@             , parseDo             , parseLet             , P.try $ Parens <$> parens parseValue-            , parseOperatorSection ]+            , parseOperatorSection+            , P.try parseObjectUpdaterWildcard ] +-- |+-- Parse an expression in backticks or an operator+--+parseInfixExpr :: TokenParser Expr+parseInfixExpr = P.between tick tick parseValue+                 <|> Var <$> parseQualified (Op <$> symbol)+ parseOperatorSection :: TokenParser Expr parseOperatorSection = parens $ left <|> right   where-  right = OperatorSection <$> parseIdentInfix <* indented <*> (Right <$> parseValueAtom)-  left = flip OperatorSection <$> (Left <$> parseValueAtom) <* indented <*> parseIdentInfix+  right = OperatorSection <$> parseInfixExpr <* indented <*> (Right <$> parseValueAtom)+  left = flip OperatorSection <$> (Left <$> parseValueAtom) <* indented <*> parseInfixExpr  parsePropertyUpdate :: TokenParser (String, Maybe Expr) parsePropertyUpdate = do@@ -392,7 +401,7 @@             , P.try (DoNotationValue <$> parseValue) ]  parseObjectGetter :: TokenParser Expr-parseObjectGetter = ObjectGetter <$> parens (dot *> C.indented *> (lname <|> stringLiteral))+parseObjectGetter = ObjectGetter <$> (underscore *> C.indented *> dot *> C.indented *> (lname <|> stringLiteral))  -- | -- Parse a value@@ -405,16 +414,22 @@   where   indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom   postfixTable1 = [ parseAccessor-                  , \v -> P.try $ flip ObjectUpdater <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate))) <*> pure v ]+                  , P.try . parseUpdaterBody . Just ]   postfixTable2 = [ \v -> P.try (flip App <$> (C.indented *> indexersAndAccessors)) <*> pure v                   , \v -> flip (TypedValue True) <$> (P.try (C.indented *> doubleColon) *> parsePolyType) <*> pure v                   ]   operators = [ [ P.Prefix (P.try (C.indented *> symbol' "-") >> return UnaryMinus)                 ]-              , [ P.Infix (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident ->+              , [ P.Infix (P.try (C.indented *> parseInfixExpr P.<?> "infix expression") >>= \ident ->                     return (BinaryNoParens ident)) P.AssocRight                 ]               ]++parseUpdaterBody :: Maybe Expr -> TokenParser Expr+parseUpdaterBody v = ObjectUpdater v <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate)))++parseObjectUpdaterWildcard :: TokenParser Expr+parseObjectUpdaterWildcard = underscore *> C.indented *> parseUpdaterBody Nothing  parseStringBinder :: TokenParser Binder parseStringBinder = StringBinder <$> stringLiteral
src/Language/PureScript/Pretty/Values.hs view
@@ -27,6 +27,7 @@ import Control.Applicative  import Language.PureScript.AST+import Language.PureScript.Names import Language.PureScript.Pretty.Common import Language.PureScript.Pretty.Types (prettyPrintType) @@ -73,8 +74,8 @@     , withIndent $ prettyPrintMany prettyPrintDoNotationElement els     , currentIndent     ]-  match (OperatorSection op (Right val)) = return $ "(" ++ show op ++ " " ++ prettyPrintValue val ++ ")"-  match (OperatorSection op (Left val)) = return $ "(" ++ prettyPrintValue val ++ " " ++ show op ++ ")"+  match (OperatorSection op (Right val)) = return $ "(" ++ prettyPrintValue op ++ " " ++ prettyPrintValue val ++ ")"+  match (OperatorSection op (Left val)) = return $ "(" ++ prettyPrintValue val ++ " " ++ prettyPrintValue op ++ ")"   match (TypeClassDictionary name _ _) = return $ "<<dict " ++ show name ++ ">>"   match (SuperClassDictionary name _) = return $ "<<superclass dict " ++ show name ++ ">>"   match (TypedValue _ val _) = prettyPrintValue' val@@ -151,7 +152,7 @@ objectUpdate = mkPattern match   where   match (ObjectUpdate o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ prettyPrintValue val, o)-  match (ObjectUpdater o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ maybe "_" prettyPrintValue val, o)+  match (ObjectUpdater o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ maybe "_" prettyPrintValue val, fromMaybe (Var (Qualified Nothing $ Ident "_")) o)   match _ = Nothing  app :: Pattern PrinterState Expr (String, Expr)
src/Language/PureScript/Sugar/Names.hs view
@@ -240,10 +240,6 @@     (,) (pos, bound) <$> (Var <$> updateValueName name' pos)   updateValue (pos, bound) (Var name'@(Qualified (Just _) _)) =     (,) (pos, bound) <$> (Var <$> updateValueName name' pos)-  updateValue (pos, bound) (BinaryNoParens name'@(Qualified Nothing ident) v1 v2) | ident `notElem` bound =-    (,) (pos, bound) <$> (BinaryNoParens <$> updateValueName name' pos <*> pure v1 <*> pure v2)-  updateValue (pos, bound) (BinaryNoParens name'@(Qualified (Just _) _) v1 v2) =-    (,) (pos, bound) <$> (BinaryNoParens <$> updateValueName name' pos <*> pure v1 <*> pure v2)   updateValue s@(pos, _) (Constructor name) = (,) s <$> (Constructor <$> updateDataConstructorName name pos)   updateValue s@(pos, _) (TypedValue check val ty) = (,) s <$> (TypedValue check val <$> updateTypesEverywhere pos ty)   updateValue s v = return (s, v)
src/Language/PureScript/Sugar/ObjectWildcards.hs view
@@ -36,7 +36,10 @@    desugarExpr :: Expr -> SupplyT (Either ErrorStack) Expr   desugarExpr (ObjectConstructor ps) = wrapLambda ObjectLiteral ps-  desugarExpr (ObjectUpdater obj ps) = wrapLambda (ObjectUpdate obj) ps+  desugarExpr (ObjectUpdater (Just obj) ps) = wrapLambda (ObjectUpdate obj) ps+  desugarExpr (ObjectUpdater Nothing ps) = do+    obj <- Ident <$> freshName+    Abs (Left obj) <$> wrapLambda (ObjectUpdate (Var (Qualified Nothing obj))) ps   desugarExpr (ObjectGetter prop) = do     arg <- Ident <$> freshName     return $ Abs (Left arg) (Accessor prop (Var (Qualified Nothing arg)))
src/Language/PureScript/Sugar/Operators.hs view
@@ -105,7 +105,7 @@   in     map (map (\(name, f, _, a) -> (name, f, a))) groups -type Chain = [Either Expr (Qualified Ident)]+type Chain = [Either Expr Expr]  matchOperators :: [[(Qualified Ident, Expr -> Expr -> Expr, Associativity)]] -> Expr -> Either ErrorStack Expr matchOperators ops = parseChains@@ -114,11 +114,11 @@   parseChains b@BinaryNoParens{} = bracketChain (extendChain b)   parseChains other = return other   extendChain :: Expr -> Chain-  extendChain (BinaryNoParens name l r) = Left l : Right name : extendChain r+  extendChain (BinaryNoParens op l r) = Left l : Right op : extendChain r   extendChain other = [Left other]   bracketChain :: Chain -> Either ErrorStack Expr   bracketChain = either (Left . (`mkErrorStack` Nothing) . show) Right . P.parse (P.buildExpressionParser opTable parseValue <* P.eof) "operator expression"-  opTable = [P.Infix (P.try (parseTicks >>= \ident -> return (\t1 t2 -> App (App (Var ident) t1) t2))) P.AssocLeft]+  opTable = [P.Infix (P.try (parseTicks >>= \op -> return (\t1 t2 -> App (App op t1) t2))) P.AssocLeft]             : map (map (\(name, f, a) -> P.Infix (P.try (matchOp name) >> return f) (toAssoc a))) ops             ++ [[ P.Infix (P.try (parseOp >>= \ident -> return (\t1 t2 -> App (App (Var ident) t1) t2))) P.AssocLeft ]] @@ -136,14 +136,14 @@ parseOp :: P.Parsec Chain () (Qualified Ident) parseOp = token (either (const Nothing) fromOp) P.<?> "operator"   where-  fromOp q@(Qualified _ (Op _)) = Just q+  fromOp (Var q@(Qualified _ (Op _))) = Just q   fromOp _ = Nothing -parseTicks :: P.Parsec Chain () (Qualified Ident)-parseTicks = token (either (const Nothing) fromOp) P.<?> "infix function"+parseTicks :: P.Parsec Chain () Expr+parseTicks = token (either (const Nothing) fromOther) P.<?> "infix function"   where-  fromOp q@(Qualified _ (Ident _)) = Just q-  fromOp _ = Nothing+  fromOther (Var (Qualified _ (Op _))) = Nothing+  fromOther v = Just v  matchOp :: Qualified Ident -> P.Parsec Chain () () matchOp op = do@@ -158,8 +158,8 @@   (goDecl, _, _) = everywhereOnValuesM return goExpr return    goExpr :: Expr -> SupplyT (Either ErrorStack) Expr-  goExpr (OperatorSection op (Left val)) = return $ App (Var op) val+  goExpr (OperatorSection op (Left val)) = return $ App op val   goExpr (OperatorSection op (Right val)) = do     arg <- Ident <$> freshName-    return $ Abs (Left arg) $ App (App (Var op) (Var (Qualified Nothing arg))) val+    return $ Abs (Left arg) $ App (App op (Var (Qualified Nothing arg))) val   goExpr other = return other