132a430 · rowtype-yoga/purescript-native

src/Language/PureScript/AST/Exported.hs+1−1

compare with golang

unifiedsplit

@@ -66,7 +66,7 @@ filterInstances (Just exps) =

66 -- * the name is defined in a different module (and must be exported from

67 -- that module; the code would fail to compile otherwise).

68 visibleOutside _ (Qualified (Just _) _) = True

69− visibleOutside refs (Qualified Nothing n) = any (== n) refs

69+ visibleOutside refs (Qualified Nothing n) = n `elem` refs

70

71 typeName (TypeRef n _) = Just n

72 typeName (PositionedDeclarationRef _ _ r) = typeName r

src/Language/PureScript/Bundle.hs+1−1

@@ -385,7 +385,7 @@ isModuleEmpty (Module _ els) = all isElementEmpty els

385 where

386 isElementEmpty :: ModuleElement -> Bool

387 isElementEmpty (ExportsList exps) = null exps

388− isElementEmpty (Require _ _ _) = True

388+ isElementEmpty Require{} = True

389 isElementEmpty (Other _) = True

390 isElementEmpty _ = False

391

src/Language/PureScript/CodeGen/JS.hs+2−1

@@ -27,6 +27,7 @@ module Language.PureScript.CodeGen.JS

27 ) where

28

29import Data.List ((\\), delete, intersect)

30+import Data.Maybe (isNothing)

30import qualified Data.Traversable as T (traverse)

31import qualified Data.Traversable as T (traverse)

31

32

32#if __GLASGOW_HASKELL__ < 710

33#if __GLASGOW_HASKELL__ < 710

@@ -62,7 +63,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ = do

62 comments <- not <$> asks optionsNoComments

63 comments <- not <$> asks optionsNoComments

63 let strict = JSStringLiteral "use strict"

64 let strict = JSStringLiteral "use strict"

64 let header = if comments && not (null coms) then JSComment coms strict else strict

65 let header = if comments && not (null coms) then JSComment coms strict else strict

65− let foreign' = [JSVariableIntroduction "$foreign" foreign_ | not $ null foreigns || foreign_ == Nothing]

66+ let foreign' = [JSVariableIntroduction "$foreign" foreign_ | not $ null foreigns || isNothing foreign_]

66 let moduleBody = header : foreign' ++ jsImports ++ concat optimized

67 let moduleBody = header : foreign' ++ jsImports ++ concat optimized

67 let foreignExps = exps `intersect` (fst `map` foreigns)

68 let foreignExps = exps `intersect` (fst `map` foreigns)

68 let standardExps = exps \\ foreignExps

69 let standardExps = exps \\ foreignExps

src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs+1−1

@@ -255,7 +255,7 @@ inlineFnComposition = everywhereOnJSTopDownM convert

255 return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])

256 convert other = return other

257 isFnCompose :: JS -> JS -> Bool

258− isFnCompose dict' fn = isDict semigroupoidFn dict' && (isPreludeFn (C.<<<) fn || isPreludeFn (C.compose) fn)

258+ isFnCompose dict' fn = isDict semigroupoidFn dict' && (isPreludeFn (C.<<<) fn || isPreludeFn C.compose fn)

259

260isDict :: (String, String) -> JS -> Bool

261isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName

src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs+1−1

@@ -124,5 +124,5 @@ tco' = everywhereOnJS convert

124 hasFunction :: JS -> Bool

125 hasFunction = getAny . everythingOnJS mappend (Any . isFunction)

126 where

127− isFunction (JSFunction _ _ _) = True

127+ isFunction JSFunction{} = True

128 isFunction _ = False

src/Language/PureScript/CodeGen/JS/Optimizer/Unused.hs+1−1

@@ -29,7 +29,7 @@ removeCodeAfterReturnStatements = everywhereOnJS (removeFromBlock go)

29 where

30 go :: [JS] -> [JS]

31 go jss | not (any isJSReturn jss) = jss

32− | otherwise = let (body, ret : _) = span (not . isJSReturn) jss in body ++ [ret]

32+ | otherwise = let (body, ret : _) = break isJSReturn jss in body ++ [ret]

33 isJSReturn (JSReturn _) = True

34 isJSReturn _ = False

35

src/Language/PureScript/CoreFn/Expr.hs+1−1

@@ -101,7 +101,7 @@ data CaseAlternative a = CaseAlternative

101instance Functor CaseAlternative where

102

103 fmap f (CaseAlternative cabs car) = CaseAlternative

104− (fmap (fmap f) $ cabs)

104+ (fmap (fmap f) cabs)

105 (either (Left . fmap (fmap f *** fmap f)) (Right . fmap f) car)

106

107-- |

src/Language/PureScript/Docs/Convert.hs+2−2

@@ -147,7 +147,7 @@ convertDeclaration (P.ExternDataDeclaration _ kind') title =

147 basicDeclaration title (ExternDataDeclaration kind')

148convertDeclaration (P.TypeSynonymDeclaration _ args ty) title =

149 basicDeclaration title (TypeSynonymDeclaration args ty)

150−convertDeclaration (P.TypeClassDeclaration _ args implies ds) title = do

150+convertDeclaration (P.TypeClassDeclaration _ args implies ds) title =

151 Just (Right (mkDeclaration title info) { declChildren = children })

152 where

153 info = TypeClassDeclaration args implies

@@ -158,7 +158,7 @@ convertDeclaration (P.TypeClassDeclaration _ args implies ds) title = do

158 ChildDeclaration (P.showIdent ident') Nothing Nothing (ChildTypeClassMember ty)

159 convertClassMember _ =

160 error "Invalid argument to convertClassMember."

161−convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) title = do

161+convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) title =

162 Just (Left (classNameString : typeNameStrings, AugmentChild childDecl))

163 where

164 classNameString = unQual className

src/Language/PureScript/Docs/Render.hs+3−2

@@ -10,6 +10,7 @@

10

11module Language.PureScript.Docs.Render where

12

13+import Data.Maybe (maybeToList)

13import Data.Monoid ((<>))

14import Data.Monoid ((<>))

14import qualified Language.PureScript as P

15import qualified Language.PureScript as P

15

16

@@ -46,7 +47,7 @@ renderDeclarationWithOptions opts Declaration{..} =

46 ]

47 ]

47 TypeClassDeclaration args implies ->

48 TypeClassDeclaration args implies ->

48 [ keywordClass ]

49 [ keywordClass ]

49− ++ maybe [] (:[]) superclasses

50+ ++ maybeToList superclasses

50 ++ [renderType' (typeApp declTitle args)]

51 ++ [renderType' (typeApp declTitle args)]

51 ++ if any (isTypeClassMember . cdeclInfo) declChildren

52 ++ if any (isTypeClassMember . cdeclInfo) declChildren

52 then [keywordWhere]

53 then [keywordWhere]

@@ -75,7 +76,7 @@ renderChildDeclarationWithOptions opts ChildDeclaration{..} =

75 [ keywordInstance

76 [ keywordInstance

76 , ident cdeclTitle

77 , ident cdeclTitle

77 , syntax "::"

78 , syntax "::"

78− ] ++ maybe [] (:[]) (renderConstraints constraints)

79+ ] ++ maybeToList (renderConstraints constraints)

79 ++ [ renderType' ty ]

80 ++ [ renderType' ty ]

80 ChildDataConstructor args ->

81 ChildDataConstructor args ->

81 [ renderType' typeApp' ]

82 [ renderType' typeApp' ]

src/Language/PureScript/Docs/Types.hs+1−1

@@ -425,7 +425,7 @@ asSourceSpan = P.SourceSpan <$> key "name" asString

425

426instance A.ToJSON a => A.ToJSON (Package a) where

427 toJSON Package{..} =

428− A.object $

428+ A.object

429 [ "packageMeta" .= pkgMeta

430 , "version" .= showVersion pkgVersion

431 , "versionTag" .= pkgVersionTag

src/Language/PureScript/Errors.hs+33−34

@@ -20,7 +20,7 @@

20module Language.PureScript.Errors where

21

22import Data.Either (lefts, rights)

23−import Data.List (intercalate, transpose)

23+import Data.List (intercalate, transpose, nub)

24import Data.Function (on)

25#if __GLASGOW_HASKELL__ < 710

26import Data.Foldable (fold, foldMap)

@@ -52,7 +52,6 @@ import qualified Text.PrettyPrint.Boxes as Box

52import qualified Text.Parsec as P

53import qualified Text.Parsec.Error as PE

54import Text.Parsec.Error (Message(..))

55−import Data.List (nub)

56

55

57-- |

56-- |

58-- A type of error messages

57-- A type of error messages

@@ -366,33 +365,33 @@ replaceUnknowns = everywhereOnTypesM replaceTypes

366onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage

365onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage

367onTypesInErrorMessageM f = g

366onTypesInErrorMessageM f = g

368 where

367 where

369− gSimple (InfiniteType t) = InfiniteType <$> (f t)

368+ gSimple (InfiniteType t) = InfiniteType <$> f t

370− gSimple (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> (f t1) <*> (f t2)

369+ gSimple (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> f t1 <*> f t2

371− gSimple (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> (f t1) <*> (f t2)

370+ gSimple (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> f t1 <*> f t2

372− gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> (f t)

371+ gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> f t

373− gSimple (PropertyIsMissing s t) = PropertyIsMissing s <$> (f t)

372+ gSimple (PropertyIsMissing s t) = PropertyIsMissing s <$> f t

374− gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> (pure e)

373+ gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> pure e

375 gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t

374 gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t

376 gSimple other = pure other

375 gSimple other = pure other

377− g (ErrorInSubsumption t1 t2 em) = ErrorInSubsumption <$> (f t1) <*> (f t2) <*> (g em)

376+ g (ErrorInSubsumption t1 t2 em) = ErrorInSubsumption <$> f t1 <*> f t2 <*> g em

378− g (ErrorUnifyingTypes t1 t2 e) = ErrorUnifyingTypes <$> (f t1) <*> (f t2) <*> (g e)

377+ g (ErrorUnifyingTypes t1 t2 e) = ErrorUnifyingTypes <$> f t1 <*> f t2 <*> g e

379− g (ErrorCheckingType e t em) = ErrorCheckingType e <$> (f t) <*> (g em)

378+ g (ErrorCheckingType e t em) = ErrorCheckingType e <$> f t <*> g em

380− g (ErrorCheckingKind t em) = ErrorCheckingKind <$> (f t) <*> g em

379+ g (ErrorCheckingKind t em) = ErrorCheckingKind <$> f t <*> g em

381− g (ErrorInApplication e1 t1 e2 em) = ErrorInApplication e1 <$> (f t1) <*> (pure e2) <*> (g em)

380+ g (ErrorInApplication e1 t1 e2 em) = ErrorInApplication e1 <$> f t1 <*> pure e2 <*> g em

382− g (NotYetDefined x e) = NotYetDefined x <$> (g e)

381+ g (NotYetDefined x e) = NotYetDefined x <$> g e

383− g (ErrorInExpression x e) = ErrorInExpression x <$> (g e)

382+ g (ErrorInExpression x e) = ErrorInExpression x <$> g e

384− g (ErrorInModule x e) = ErrorInModule x <$> (g e)

383+ g (ErrorInModule x e) = ErrorInModule x <$> g e

385− g (ErrorInInstance x y e) = ErrorInInstance x y <$> (g e)

384+ g (ErrorInInstance x y e) = ErrorInInstance x y <$> g e

386− g (ErrorInferringType x e) = ErrorInferringType x <$> (g e)

385+ g (ErrorInferringType x e) = ErrorInferringType x <$> g e

387− g (ErrorInDataConstructor x e) = ErrorInDataConstructor x <$> (g e)

386+ g (ErrorInDataConstructor x e) = ErrorInDataConstructor x <$> g e

388− g (ErrorInTypeConstructor x e) = ErrorInTypeConstructor x <$> (g e)

387+ g (ErrorInTypeConstructor x e) = ErrorInTypeConstructor x <$> g e

389− g (ErrorInBindingGroup x e) = ErrorInBindingGroup x <$> (g e)

388+ g (ErrorInBindingGroup x e) = ErrorInBindingGroup x <$> g e

390− g (ErrorInDataBindingGroup e) = ErrorInDataBindingGroup <$> (g e)

389+ g (ErrorInDataBindingGroup e) = ErrorInDataBindingGroup <$> g e

391− g (ErrorInTypeSynonym x e) = ErrorInTypeSynonym x <$> (g e)

390+ g (ErrorInTypeSynonym x e) = ErrorInTypeSynonym x <$> g e

392− g (ErrorInValueDeclaration x e) = ErrorInValueDeclaration x <$> (g e)

391+ g (ErrorInValueDeclaration x e) = ErrorInValueDeclaration x <$> g e

393− g (ErrorInTypeDeclaration x e) = ErrorInTypeDeclaration x <$> (g e)

392+ g (ErrorInTypeDeclaration x e) = ErrorInTypeDeclaration x <$> g e

394− g (ErrorInForeignImport x e) = ErrorInForeignImport x <$> (g e)

393+ g (ErrorInForeignImport x e) = ErrorInForeignImport x <$> g e

395− g (PositionedError x e) = PositionedError x <$> (g e)

394+ g (PositionedError x e) = PositionedError x <$> g e

396 g (SimpleErrorWrapper sem) = SimpleErrorWrapper <$> gSimple sem

395 g (SimpleErrorWrapper sem) = SimpleErrorWrapper <$> gSimple sem

397

396

398-- |

397-- |

@@ -738,7 +737,7 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

738 , go err

737 , go err

739 ]

738 ]

740 go (ErrorInDataBindingGroup err) =

739 go (ErrorInDataBindingGroup err) =

741− paras [ lineWithLevel $ "in data binding group:"

740+ paras [ lineWithLevel "in data binding group:"

742 , go err

741 , go err

743 ]

742 ]

744 go (ErrorInTypeSynonym name err) =

743 go (ErrorInTypeSynonym name err) =

@@ -857,7 +856,7 @@ prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) = do

857 , result

856 , result

858 ]

857 ]

859prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) = do

858prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) = do

860− result <- forM es $ (liftM $ Box.moveRight 2) . prettyPrintSingleError full level

859+ result <- forM es $ liftM (Box.moveRight 2) . prettyPrintSingleError full level

861 return $

860 return $

862 Box.vcat Box.left [ Box.text intro

861 Box.vcat Box.left [ Box.text intro

863 , Box.vsep 1 Box.left result

862 , Box.vsep 1 Box.left result

@@ -865,7 +864,7 @@ prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) = do

865

864

866-- | Pretty print a Parsec ParseError as a Box

865-- | Pretty print a Parsec ParseError as a Box

867prettyPrintParseError :: P.ParseError -> Box.Box

866prettyPrintParseError :: P.ParseError -> Box.Box

868−prettyPrintParseError = (prettyPrintParseErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input") . PE.errorMessages

867+prettyPrintParseError = prettyPrintParseErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" . PE.errorMessages

869

868

870-- |

869-- |

871-- Pretty print ParseError detail messages.

870-- Pretty print ParseError detail messages.

@@ -878,9 +877,9 @@ prettyPrintParseErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEnd

878 | otherwise = Box.vcat Box.left $ map Box.text $ clean [showSysUnExpect,showUnExpect,showExpect,showMessages]

877 | otherwise = Box.vcat Box.left $ map Box.text $ clean [showSysUnExpect,showUnExpect,showExpect,showMessages]

879

878

880 where

879 where

881− (sysUnExpect,msgs1) = span ((SysUnExpect "") ==) msgs

880+ (sysUnExpect,msgs1) = span (SysUnExpect "" ==) msgs

882− (unExpect,msgs2) = span ((UnExpect "") ==) msgs1

881+ (unExpect,msgs2) = span (UnExpect "" ==) msgs1

883− (expect,messages) = span ((Expect "") ==) msgs2

882+ (expect,messages) = span (Expect "" ==) msgs2

884

883

885 showExpect = showMany msgExpecting expect

884 showExpect = showMany msgExpecting expect

886 showUnExpect = showMany msgUnExpected unExpect

885 showUnExpect = showMany msgUnExpected unExpect

@@ -928,7 +927,7 @@ renderBox = unlines . map trimEnd . lines . Box.render

928interpretMultipleErrorsAndWarnings :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => (Either MultipleErrors a, MultipleErrors) -> m a

927interpretMultipleErrorsAndWarnings :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => (Either MultipleErrors a, MultipleErrors) -> m a

929interpretMultipleErrorsAndWarnings (err, ws) = do

928interpretMultipleErrorsAndWarnings (err, ws) = do

930 tell ws

929 tell ws

931− either throwError return $ err

930+ either throwError return err

932

931

933-- |

932-- |

934-- Rethrow an error with a more detailed error message in the case of failure

933-- Rethrow an error with a more detailed error message in the case of failure

src/Language/PureScript/Parser/Declarations.hs+13−16

@@ -175,9 +175,9 @@ parseImportDeclaration' = do

175

176parseDeclarationRef :: TokenParser DeclarationRef

177parseDeclarationRef =

178− parseModuleRef <|> (

178+ parseModuleRef <|>

179− withSourceSpan PositionedDeclarationRef $

179+ withSourceSpan PositionedDeclarationRef

180− ValueRef <$> parseIdent

180+ (ValueRef <$> parseIdent

181 <|> do name <- properName

182 dctors <- P.optionMaybe $ parens (symbol' ".." *> pure Nothing <|> Just <$> commaSep properName)

183 return $ maybe (TypeClassRef name) (TypeRef name) dctors

@@ -203,8 +203,8 @@ parseTypeClassDeclaration = do

203 mark (P.many (same *> positioned parseTypeDeclaration))

204 return $ TypeClassDeclaration className idents implies members

205

206−parseTypeInstanceDeclaration :: TokenParser Declaration

206+parseInstanceDeclaration :: TokenParser (TypeInstanceBody -> Declaration)

207−parseTypeInstanceDeclaration = do

207+parseInstanceDeclaration = do

208 reserved "instance"

209 name <- parseIdent <* indented <* doubleColon

210 deps <- P.optionMaybe $ do

@@ -214,24 +214,21 @@ parseTypeInstanceDeclaration = do

214 return deps

215 className <- indented *> parseQualified properName

216 ty <- P.many (indented *> noWildcards parseTypeAtom)

217+ return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty

218+

219+parseTypeInstanceDeclaration :: TokenParser Declaration

220+parseTypeInstanceDeclaration = do

221+ instanceDecl <- parseInstanceDeclaration

217 members <- P.option [] . P.try $ do

222 members <- P.option [] . P.try $ do

218 indented *> reserved "where"

223 indented *> reserved "where"

219 mark (P.many (same *> positioned parseValueDeclaration))

224 mark (P.many (same *> positioned parseValueDeclaration))

220− return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty (ExplicitInstance members)

225+ return $ instanceDecl (ExplicitInstance members)

221

226

222parseDerivingInstanceDeclaration :: TokenParser Declaration

227parseDerivingInstanceDeclaration :: TokenParser Declaration

223parseDerivingInstanceDeclaration = do

228parseDerivingInstanceDeclaration = do

224 reserved "derive"

229 reserved "derive"

225− reserved "instance"

230+ instanceDecl <- parseInstanceDeclaration

226− name <- parseIdent <* indented <* doubleColon

227− deps <- P.optionMaybe $ do

228− deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))

229− indented

230− rfatArrow

231− return deps

232− className <- indented *> parseQualified properName

233− ty <- P.many (indented *> noWildcards parseTypeAtom)

234− return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty DerivedInstance

231+ return $ instanceDecl DerivedInstance

235

232

236positioned :: TokenParser Declaration -> TokenParser Declaration

233positioned :: TokenParser Declaration -> TokenParser Declaration

237positioned = withSourceSpan PositionedDeclaration

234positioned = withSourceSpan PositionedDeclaration

src/Language/PureScript/Parser/Kinds.hs+1−1

@@ -46,4 +46,4 @@ parseKind :: TokenParser Kind

46parseKind = P.buildExpressionParser operators parseTypeAtom P.<?> "kind"

47 where

48 operators = [ [ P.Prefix (symbol' "#" >> return Row) ]

49− , [ P.Infix ((P.try rarrow) >> return FunKind) P.AssocRight ] ]

49+ , [ P.Infix (P.try rarrow >> return FunKind) P.AssocRight ] ]

src/Language/PureScript/Parser/Lexer.hs+1−1

@@ -479,7 +479,7 @@ identifier = token go P.<?> "identifier"

479 go _ = Nothing

480

481validModuleName :: String -> Bool

482−validModuleName s = not ('_' `elem` s)

482+validModuleName s = '_' `notElem` s

483

484-- |

485-- A list of purescript reserved identifiers

src/Language/PureScript/Pretty/JS.hs+13−13

@@ -45,13 +45,13 @@ literals = mkPattern' match

45 match (JSStringLiteral s) = return $ string s

46 match (JSBooleanLiteral True) = return "true"

47 match (JSBooleanLiteral False) = return "false"

48− match (JSArrayLiteral xs) = fmap concat $ sequence

48+ match (JSArrayLiteral xs) = concat <$> sequence

49 [ return "[ "

50− , fmap (intercalate ", ") $ forM xs prettyPrintJS'

50+ , intercalate ", " <$> forM xs prettyPrintJS'

51 , return " ]"

52 ]

53 match (JSObjectLiteral []) = return "{}"

54− match (JSObjectLiteral ps) = fmap concat $ sequence

54+ match (JSObjectLiteral ps) = concat <$> sequence

55 [ return "{\n"

56 , withIndent $ do

57 jss <- forM ps $ \(key, value) -> fmap ((objectPropertyToString key ++ ": ") ++) . prettyPrintJS' $ value

@@ -65,7 +65,7 @@ literals = mkPattern' match

65 objectPropertyToString :: String -> String

66 objectPropertyToString s | identNeedsEscaping s = show s

67 | otherwise = s

68− match (JSBlock sts) = fmap concat $ sequence

68+ match (JSBlock sts) = concat <$> sequence

69 [ return "{\n"

70 , withIndent $ prettyStatements sts

71 , return "\n"

@@ -73,23 +73,23 @@ literals = mkPattern' match

73 , return "}"

74 ]

75 match (JSVar ident) = return ident

76− match (JSVariableIntroduction ident value) = fmap concat $ sequence

76+ match (JSVariableIntroduction ident value) = concat <$> sequence

77 [ return "var "

78 , return ident

79 , maybe (return "") (fmap (" = " ++) . prettyPrintJS') value

80 ]

81− match (JSAssignment target value) = fmap concat $ sequence

81+ match (JSAssignment target value) = concat <$> sequence

82 [ prettyPrintJS' target

83 , return " = "

84 , prettyPrintJS' value

85 ]

86− match (JSWhile cond sts) = fmap concat $ sequence

86+ match (JSWhile cond sts) = concat <$> sequence

87 [ return "while ("

88 , prettyPrintJS' cond

89 , return ") "

90 , prettyPrintJS' sts

91 ]

92− match (JSFor ident start end sts) = fmap concat $ sequence

92+ match (JSFor ident start end sts) = concat <$> sequence

93 [ return $ "for (var " ++ ident ++ " = "

94 , prettyPrintJS' start

95 , return $ "; " ++ ident ++ " < "

@@ -97,30 +97,30 @@ literals = mkPattern' match

97 , return $ "; " ++ ident ++ "++) "

98 , prettyPrintJS' sts

99 ]

100− match (JSForIn ident obj sts) = fmap concat $ sequence

100+ match (JSForIn ident obj sts) = concat <$> sequence

101 [ return $ "for (var " ++ ident ++ " in "

102 , prettyPrintJS' obj

103 , return ") "

104 , prettyPrintJS' sts

105 ]

106− match (JSIfElse cond thens elses) = fmap concat $ sequence

106+ match (JSIfElse cond thens elses) = concat <$> sequence

107 [ return "if ("

108 , prettyPrintJS' cond

109 , return ") "

110 , prettyPrintJS' thens

111 , maybe (return "") (fmap (" else " ++) . prettyPrintJS') elses

112 ]

113− match (JSReturn value) = fmap concat $ sequence

113+ match (JSReturn value) = concat <$> sequence

114 [ return "return "

115 , prettyPrintJS' value

116 ]

117− match (JSThrow value) = fmap concat $ sequence

117+ match (JSThrow value) = concat <$> sequence

118 [ return "throw "

119 , prettyPrintJS' value

120 ]

121 match (JSBreak lbl) = return $ "break " ++ lbl

122 match (JSContinue lbl) = return $ "continue " ++ lbl

123− match (JSLabel lbl js) = fmap concat $ sequence

123+ match (JSLabel lbl js) = concat <$> sequence

124 [ return $ lbl ++ ": "

125 , prettyPrintJS' js

126 ]

src/Language/PureScript/Publish.hs+1−1

@@ -153,7 +153,7 @@ getGitWorkingTreeStatus :: PrepareM TreeStatus

153getGitWorkingTreeStatus = do

154 out <- readProcess' "git" ["status", "--porcelain"] ""

155 return $

156− if null . filter (not . null) . lines $ out

156+ if all null . lines $ out

157 then Clean

158 else Dirty

159

src/Language/PureScript/Publish/ErrorsWarnings.hs+14−15

@@ -98,10 +98,10 @@ renderError err =

98 case err of

99 UserError e ->

100 vcat

101− [ para (concat

101+ [ para (

102− [ "There is a problem with your package, which meant that "

102+ "There is a problem with your package, which meant that " ++

103− , "it could not be published."

103+ "it could not be published."

104− ])

104+ )

105 , para "Details:"

106 , indented (displayUserError e)

107 ]

@@ -123,10 +123,10 @@ renderError err =

123displayUserError :: UserError -> Box

124displayUserError e = case e of

125 BowerJSONNotFound ->

126− para (concat

126+ para (

127− [ "The bower.json file was not found. Please create one, or run "

127+ "The bower.json file was not found. Please create one, or run " ++

128− , "`pulp init`."

128+ "`pulp init`."

129− ])

129+ )

130 BowerExecutableNotFound names ->

131 para (concat

132 [ "The Bower executable was not found (tried: ", format names, "). Please"

@@ -217,10 +217,10 @@ displayUserError e = case e of

217 , indented (P.prettyPrintMultipleErrorsBox False err)

218 ]

219 DirtyWorkingTree ->

220− para (concat

220+ para (

221− [ "Your git working tree is dirty. Please commit, discard, or stash "

221+ "Your git working tree is dirty. Please commit, discard, or stash " ++

222− , "your changes first."

222+ "your changes first."

223− ])

223+ )

224

225displayRepositoryError :: RepositoryFieldError -> Box

226displayRepositoryError err = case err of

@@ -356,12 +356,11 @@ warnUndeclaredDependencies pkgNames =

356 are = pl "are" "is"

357 dependencies = pl "dependencies" "a dependency"

358 in vcat $

359− [ para (concat

359+ para (concat

360 [ "The following Bower ", packages, " ", are, " installed, but not "

361 , "declared as ", dependencies, " in your bower.json file:"

362 ])

363− ] ++

364− bulletedList runPackageName (NonEmpty.toList pkgNames)

363+ : bulletedList runPackageName (NonEmpty.toList pkgNames)

365

364

366warnUnacceptableVersions :: NonEmpty (PackageName, String) -> Box

365warnUnacceptableVersions :: NonEmpty (PackageName, String) -> Box

367warnUnacceptableVersions pkgs =

366warnUnacceptableVersions pkgs =

src/Language/PureScript/Renamer.hs+3−3

@@ -80,12 +80,12 @@ updateScope :: Ident -> Rename Ident

80updateScope i@(Ident name) | name == C.__unused = return i

81updateScope name = do

82 scope <- get

83− name' <- case name `S.member` rsUsedNames scope of

83+ name' <- if name `S.member` rsUsedNames scope

84− True -> do

84+ then do

85 let newNames = [ Ident (runIdent name ++ "_" ++ show (i :: Int)) | i <- [1..] ]

86 Just newName = find (`S.notMember` rsUsedNames scope) newNames

87 return newName

88− False -> return name

88+ else return name

89 modify $ \s -> s { rsBoundNames = M.insert name name' (rsBoundNames s)

90 , rsUsedNames = S.insert name' (rsUsedNames s)

91 }

src/Language/PureScript/Sugar/DoNotation.hs+2−2

@@ -42,13 +42,13 @@ desugarDoModule :: forall m. (Applicative m, MonadSupply m, MonadError MultipleE

42desugarDoModule (Module ss coms mn ds exts) = Module ss coms mn <$> parU ds desugarDo <*> pure exts

43

44desugarDo :: forall m. (Applicative m, MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration

45−desugarDo (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> (rethrowWithPosition pos $ desugarDo d)

45+desugarDo (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> rethrowWithPosition pos (desugarDo d)

46desugarDo d =

47 let (f, _, _) = everywhereOnValuesM return replace return

48 in f d

49 where

50 bind :: Expr

51− bind = Var (Qualified Nothing (Ident (C.bind)))

51+ bind = Var (Qualified Nothing (Ident C.bind))

52

53 replace :: Expr -> m Expr

54 replace (Do els) = go els

src/Language/PureScript/Sugar/Names.hs+1−1

@@ -132,7 +132,7 @@ elaborateImports imps (Module ss coms mn decls exps) = Module ss coms mn decls'

132 let (f, _, _, _, _) = everythingOnValues (++) (const []) fqValues (const []) (const []) (const [])

133 in mkImport `map` nub (f `concatMap` decls) ++ decls

134 fqValues :: Expr -> [ModuleName]

135− fqValues (Var (Qualified (Just mn') _)) | notElem mn' (importedModules imps) = [mn']

135+ fqValues (Var (Qualified (Just mn') _)) | mn' `notElem` importedModules imps = [mn']

136 fqValues _ = []

137 mkImport :: ModuleName -> Declaration

138 mkImport mn' = ImportDeclaration mn' (Explicit []) Nothing

src/Language/PureScript/Sugar/Names/Exports.hs+2−3

@@ -205,9 +205,8 @@ filterModule mn exps refs = do

205 -- the data constructor to check.

206 checkDcon :: ProperName -> [ProperName] -> ProperName -> m ()

207 checkDcon tcon exps' name =

208− if name `elem` exps'

208+ unless (name `elem` exps') $

209− then return ()

210− else throwError . errorMessage $ UnknownExportDataConstructor tcon name

209+ throwError . errorMessage $ UnknownExportDataConstructor tcon name

211

210

212 -- Takes a list of all the exportable classes, the accumulated list of

211 -- Takes a list of all the exportable classes, the accumulated list of

213 -- filtered exports, and a `DeclarationRef` for an explicit export. When the

212 -- filtered exports, and a `DeclarationRef` for an explicit export. When the

src/Language/PureScript/Sugar/TypeDeclarations.hs+1−1

@@ -59,7 +59,7 @@ desugarTypeDeclarations (TypeDeclaration name ty : d : rest) = do

59 (ident, nameKind, val) <- rethrowWithPosition pos $ fromValueDeclaration d'

60 return (ident, nameKind, PositionedValue pos com val)

61 fromValueDeclaration _ = throwError . errorMessage $ OrphanTypeDeclaration name

62−desugarTypeDeclarations (TypeDeclaration name _ : []) = throwError . errorMessage $ OrphanTypeDeclaration name

62+desugarTypeDeclarations [TypeDeclaration name _] = throwError . errorMessage $ OrphanTypeDeclaration name

63desugarTypeDeclarations (ValueDeclaration name nameKind bs val : rest) = do

64 let (_, f, _) = everywhereOnValuesTopDownM return go return

65 f' (Left gs) = Left <$> mapM (pairM return f) gs

src/Language/PureScript/TypeChecker/Entailment.hs+2−3

@@ -13,7 +13,6 @@

13--

14-----------------------------------------------------------------------------

15

16−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

17{-# LANGUAGE CPP #-}

16{-# LANGUAGE CPP #-}

18

17

19module Language.PureScript.TypeChecker.Entailment (

18module Language.PureScript.TypeChecker.Entailment (

@@ -160,14 +159,14 @@ typeHeadsAreEqual m e (SaturatedTypeSynonym name args) t2 = case expandTypeSynon

160 Left _ -> Nothing

159 Left _ -> Nothing

161 Right t1 -> typeHeadsAreEqual m e t1 t2

160 Right t1 -> typeHeadsAreEqual m e t1 t2

162typeHeadsAreEqual _ _ REmpty REmpty = Just []

161typeHeadsAreEqual _ _ REmpty REmpty = Just []

163−typeHeadsAreEqual m e r1@(RCons _ _ _) r2@(RCons _ _ _) =

162+typeHeadsAreEqual m e r1@RCons{} r2@RCons{} =

164 let (s1, r1') = rowToList r1

163 let (s1, r1') = rowToList r1

165 (s2, r2') = rowToList r2

164 (s2, r2') = rowToList r2

166

165

167 int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

166 int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

168 sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

167 sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

169 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

168 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

170− in (++) <$> foldMap (\(t1, t2) -> typeHeadsAreEqual m e t1 t2) int

169+ in (++) <$> foldMap (uncurry (typeHeadsAreEqual m e)) int

171 <*> go sd1 r1' sd2 r2'

170 <*> go sd1 r1' sd2 r2'

172 where

171 where

173 go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Maybe [(String, Type)]

172 go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Maybe [(String, Type)]

src/Language/PureScript/TypeChecker/Types.hs+1−1

@@ -419,7 +419,7 @@ binderRequiresMonotype _ = True

419

420-- | Instantiate polytypes only when necessitated by a binder.

421instantiateForBinders :: [Expr] -> [CaseAlternative] -> UnifyT Type Check ([Expr], [Type])

422−instantiateForBinders vals cas = fmap unzip $ zipWithM (\val inst -> do

422+instantiateForBinders vals cas = unzip <$> zipWithM (\val inst -> do

423 TypedValue _ val' ty <- infer val

424 if inst

425 then instantiatePolyTypeWithUnknowns val' ty

src/Language/PureScript/TypeChecker/Unify.hs+3−3

@@ -133,7 +133,7 @@ unifyRows r1 r2 =

133 u1 =:= rowFromList (sd2, rest)

134 u2 =:= rowFromList (sd1, rest)

135 unifyRows' sd1 (SaturatedTypeSynonym name args) sd2 r2' = do

136− r1' <- expandTypeSynonym name $ args

136+ r1' <- expandTypeSynonym name args

137 unifyRows (rowFromList (sd1, r1')) (rowFromList (sd2, r2'))

138 unifyRows' sd1 r1' sd2 r2'@(SaturatedTypeSynonym _ _) = unifyRows' sd2 r2' sd1 r1'

139 unifyRows' [] REmpty [] REmpty = return ()

@@ -156,14 +156,14 @@ unifiesWith e (SaturatedTypeSynonym name args) t2 =

156 Right t1 -> unifiesWith e t1 t2

157unifiesWith e t1 t2@(SaturatedTypeSynonym _ _) = unifiesWith e t2 t1

158unifiesWith _ REmpty REmpty = True

159−unifiesWith e r1@(RCons _ _ _) r2@(RCons _ _ _) =

159+unifiesWith e r1@RCons{} r2@RCons{} =

160 let (s1, r1') = rowToList r1

161 (s2, r2') = rowToList r2

162

163 int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

164 sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

165 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

166− in all (\(t1, t2) -> unifiesWith e t1 t2) int && go sd1 r1' sd2 r2'

166+ in all (uncurry (unifiesWith e)) int && go sd1 r1' sd2 r2'

167 where

168 go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Bool

169 go [] REmpty [] REmpty = True

src/Language/PureScript/Types.hs+2−4

@@ -22,6 +22,7 @@ module Language.PureScript.Types where

22

23import Data.Data

24import Data.List (nub)

25+import Data.Maybe (fromMaybe)

25import qualified Data.Aeson as A

26import qualified Data.Aeson as A

26import qualified Data.Aeson.TH as A

27import qualified Data.Aeson.TH as A

27

28

@@ -156,10 +157,7 @@ replaceAllTypeVars = go []

156 where

157 where

157

158

158 go :: [String] -> [(String, Type)] -> Type -> Type

159 go :: [String] -> [(String, Type)] -> Type -> Type

159− go _ m (TypeVar v) =

160+ go _ m (TypeVar v) = fromMaybe (TypeVar v) (v `lookup` m)

160− case v `lookup` m of

161− Just r -> r

162− Nothing -> TypeVar v

163 go bs m (TypeApp t1 t2) = TypeApp (go bs m t1) (go bs m t2)

161 go bs m (TypeApp t1 t2) = TypeApp (go bs m t1) (go bs m t2)

164 go bs m (SaturatedTypeSynonym name' ts) = SaturatedTypeSynonym name' $ map (go bs m) ts

162 go bs m (SaturatedTypeSynonym name' ts) = SaturatedTypeSynonym name' $ map (go bs m) ts

165 go bs m f@(ForAll v t sco) | v `elem` keys = go bs (filter ((/= v) . fst) m) f

163 go bs m f@(ForAll v t sco) | v `elem` keys = go bs (filter ((/= v) . fst) m) f