0b07beb · rowtype-yoga/purescript-native

hierarchy/Main.hs+1−1

compare with golang

unifiedsplit

@@ -40,7 +40,7 @@ data HierarchyOptions = HierarchyOptions

40 , hierarchyOutput :: Maybe FilePath

41 }

42

43−newtype SuperMap = SuperMap { unSuperMap :: Either (P.ProperName 'P.ClassName) ((P.ProperName 'P.ClassName), (P.ProperName 'P.ClassName)) }

43+newtype SuperMap = SuperMap { unSuperMap :: Either (P.ProperName 'P.ClassName) (P.ProperName 'P.ClassName, P.ProperName 'P.ClassName) }

44 deriving Eq

45

46instance Show SuperMap where

psc/Main.hs+4−4

@@ -79,11 +79,11 @@ warnFileTypeNotFound = hPutStrLn stderr . ("psc: No files found using pattern: "

79globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath]

80globWarningOnMisses warn = concatMapM globWithWarning

81 where

82− globWithWarning pattern = do

82+ globWithWarning pattern' = do

83− paths <- glob pattern

83+ paths <- glob pattern'

84− when (null paths) $ warn pattern

84+ when (null paths) $ warn pattern'

85 return paths

86− concatMapM f = liftM concat . mapM f

86+ concatMapM f = fmap concat . mapM f

87

88readInput :: [FilePath] -> IO [(FilePath, String)]

89readInput inputFiles = forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8File inFile

psci/Main.hs+3−3

@@ -207,7 +207,7 @@ browserBackend serverPort = Backend setup evaluate reload shutdown

207 -- With many connected clients, all but one of

208 -- these attempts will fail.

209 tryPutMVar resultVar (unpack result)

210− Reload -> do

210+ Reload ->

211 WS.sendTextData conn ("reload" :: Text)

212

213 shutdownHandler :: IO () -> IO ()

@@ -278,7 +278,7 @@ browserBackend serverPort = Backend setup evaluate reload shutdown

278 Left err -> do

279 putStrLn (unlines (Bundle.printErrorMessage err))

280 exitFailure

281− Right js -> do

281+ Right js ->

282 atomically $ writeTVar (browserBundleJS state) (Just js)

283

284 reload :: BrowserState -> IO ()

@@ -335,7 +335,7 @@ main = getOpt >>= loop

335 (externs, env) <- ExceptT . runMake . make $ modules

336 return (modules, externs, env)

337 case psciBackend of

338− Backend setup eval reload (shutdown :: state -> IO ()) -> do

338+ Backend setup eval reload (shutdown :: state -> IO ()) ->

339 case e of

340 Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure

341 Right (modules, externs, env) -> do

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

@@ -256,7 +256,7 @@ toModule mids mid top

256 = pure (Member stmt exported name decl [])

257 toModuleElement stmt

258 | Just props <- matchExportsAssignment stmt

259− = (ExportsList <$> traverse toExport (trailingCommaList props))

259+ = ExportsList <$> traverse toExport (trailingCommaList props)

260 where

261 toExport :: JSObjectProperty -> m (ExportType, String, JSExpression, [Key])

262 toExport (JSPropertyNameandValue name _ [val]) =

@@ -524,7 +524,7 @@ codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (p

524 indent :: [JSStatement] -> [JSStatement]

525 indent = everywhere (mkT squash)

526 where

527− squash JSNoAnnot = (JSAnnot (TokenPn 0 0 2) [])

527+ squash JSNoAnnot = JSAnnot (TokenPn 0 0 2) []

528 squash (JSAnnot pos ann) = JSAnnot (keepCol pos) (map splat ann)

529

530 splat (CommentA pos s) = CommentA (keepCol pos) s

@@ -571,15 +571,15 @@ codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (p

571 (JSSemi JSNoAnnot)

572 ]

573 where

574− lfHead (h:t) = (addAnn (WhiteSpace tokenPosnEmpty "\n ") h) : t

574+ lfHead (h:t) = addAnn (WhiteSpace tokenPosnEmpty "\n ") h : t

575 lfHead x = x

576

577 addAnn :: CommentAnnotation -> JSStatement -> JSStatement

578 addAnn a (JSExpressionStatement (JSStringLiteral ann s) _) =

579− (JSExpressionStatement (JSStringLiteral (appendAnn a ann) s) (JSSemi JSNoAnnot))

579+ JSExpressionStatement (JSStringLiteral (appendAnn a ann) s) (JSSemi JSNoAnnot)

580 addAnn _ x = x

581

582− appendAnn a JSNoAnnot = (JSAnnot tokenPosnEmpty [a])

582+ appendAnn a JSNoAnnot = JSAnnot tokenPosnEmpty [a]

583 appendAnn a (JSAnnot _ anns) = JSAnnot tokenPosnEmpty (a:anns ++ [WhiteSpace tokenPosnEmpty " "])

584

585 runMain :: String -> [JSStatement]

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

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

367 -- binder.

368 --

369 binderToJs' :: String -> [JS] -> Binder Ann -> m [JS]

370− binderToJs' _ done (NullBinder{}) = return done

370+ binderToJs' _ done NullBinder{} = return done

371 binderToJs' varName done (LiteralBinder _ l) =

372 literalToBinderJS varName done l

373 binderToJs' varName done (VarBinder _ ident) =

src/Language/PureScript/Ide/Reexports.hs−2

@@ -14,8 +14,6 @@

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

15

16{-# LANGUAGE OverloadedStrings #-}

17−{-# LANGUAGE PackageImports #-}

18−{-# LANGUAGE TemplateHaskell #-}

19{-# LANGUAGE RecordWildCards #-}

17{-# LANGUAGE RecordWildCards #-}

20

18

21module Language.PureScript.Ide.Reexports

19module Language.PureScript.Ide.Reexports

src/Language/PureScript/Ide/State.hs+1−1

@@ -180,7 +180,7 @@ populateStage2 = do

180populateStage2STM :: TVar IdeState -> STM ()

181populateStage2STM ref = do

182 modules <- s1Modules <$> getStage1STM ref

183− let spans = map (\((P.Module ss _ _ decls _), _) -> M.fromList (concatMap (extractSpans ss) decls)) modules

183+ let spans = map (\(P.Module ss _ _ decls _, _) -> M.fromList (concatMap (extractSpans ss) decls)) modules

184 setStage2STM ref (Stage2 (AstData spans))

185

186-- | Resolves reexports and populates Stage3 with data to be used in queries.

src/Language/PureScript/Ide/Util.hs+1−1

@@ -75,7 +75,7 @@ completionFromMatch' (Match (m', d)) = case d of

75 in T.unwords [asso, show p, r, "as", runOpNameT o]

76

77infoFromMatch :: Match IdeDeclarationAnn -> Info

78−infoFromMatch (Match (m, (IdeDeclarationAnn ann d))) =

78+infoFromMatch (Match (m, IdeDeclarationAnn ann d)) =

79 Info (a, b, c, annLocation ann)

80 where

81 (a, b, c) = completionFromMatch' (Match (m, d))

src/Language/PureScript/Interactive/Completion.hs+1−1

@@ -214,7 +214,7 @@ dctorNames :: P.Module -> [(N.ProperName 'N.ConstructorName, P.Declaration)]

214dctorNames = nubOnFst . concatMap go . P.exportedDeclarations

215 where

216 go :: P.Declaration -> [(N.ProperName 'N.ConstructorName, P.Declaration)]

217− go decl@(P.DataDeclaration _ _ _ ctors) = map (\n -> (n, decl)) (map fst ctors)

217+ go decl@(P.DataDeclaration _ _ _ ctors) = map ((\n -> (n, decl)) . fst) ctors

218 go (P.PositionedDeclaration _ _ d) = go d

219 go _ = []

220

src/Language/PureScript/Interactive/Printer.hs+1−1

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

17-- Pretty print a module's signatures

18--

19printModuleSignatures :: P.ModuleName -> P.Environment -> String

20−printModuleSignatures moduleName (P.Environment {..}) =

20+printModuleSignatures moduleName P.Environment{..} =

21 -- get relevant components of a module from environment

22 let moduleNamesIdent = byModuleName names

23 moduleTypeClasses = byModuleName typeClasses

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

@@ -42,11 +42,11 @@ initialPSCiState = PSCiState [] [] []

42type ImportedModule = (P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)

43

44psciImportedModuleNames :: PSCiState -> [P.ModuleName]

45−psciImportedModuleNames (PSCiState{psciImportedModules = is}) =

45+psciImportedModuleNames PSCiState{psciImportedModules = is} =

46 map (\(mn, _, _) -> mn) is

47

48allImportsOf :: P.Module -> PSCiState -> [ImportedModule]

49−allImportsOf m (PSCiState{psciImportedModules = is}) =

49+allImportsOf m PSCiState{psciImportedModules = is} =

50 filter isImportOfThis is

51 where

52 name = P.getModuleName m

src/Language/PureScript/Pretty/Common.hs+1−1

@@ -74,7 +74,7 @@ instance Emit StrPos where

74 -- |

75 -- Add a new mapping entry for given source position with initially zero generated position

76 --

77− addMapping (SourceSpan { spanName = file, spanStart = startPos }) = StrPos (zeroPos, mempty, [mapping])

77+ addMapping SourceSpan { spanName = file, spanStart = startPos } = StrPos (zeroPos, mempty, [mapping])

78 where

79 mapping = SMap file startPos zeroPos

80 zeroPos = SourcePos 0 0

src/Language/PureScript/Publish/ErrorsWarnings.hs+8−8

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

182 , spacer

183 ] ++ spdxExamples ++

184 [ spacer

185− , para (concat

185+ , para (

186− [ "Note that distributing code without a license means that nobody "

186+ "Note that distributing code without a license means that nobody "

187− , "will (legally) be able to use it."

187+ ++ "will (legally) be able to use it."

188− ])

188+ )

189 , spacer

190 , para (concat

191 [ "It is also recommended to add a LICENSE file to the repository, "

@@ -420,10 +420,10 @@ warnUnacceptableVersions pkgs =

420

421warnDirtyWorkingTree :: Box

422warnDirtyWorkingTree =

423− para (concat

423+ para (

424− [ "Your working tree is dirty. (Note: this would be an error if it "

424+ "Your working tree is dirty. (Note: this would be an error if it "

425− , "were not a dry run)"

425+ ++ "were not a dry run)"

426− ])

426+ )

427

428printWarnings :: [PackageWarning] -> IO ()

429printWarnings = printToStderr . renderWarnings

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

@@ -142,7 +142,7 @@ renameInDecl isTopLevel (Rec ds) = do

142renameInValue :: Expr Ann -> Rename (Expr Ann)

143renameInValue (Literal ann l) =

144 Literal ann <$> renameInLiteral renameInValue l

145−renameInValue c@(Constructor{}) = return c

145+renameInValue c@Constructor{} = return c

146renameInValue (Accessor ann prop v) =

147 Accessor ann prop <$> renameInValue v

148renameInValue (ObjectUpdate ann obj vs) =

@@ -154,7 +154,7 @@ renameInValue (App ann v1 v2) =

154 App ann <$> renameInValue v1 <*> renameInValue v2

155renameInValue (Var ann (Qualified Nothing name)) =

156 Var ann . Qualified Nothing <$> lookupIdent name

157−renameInValue v@(Var{}) = return v

157+renameInValue v@Var{} = return v

158renameInValue (Case ann vs alts) =

159 newScope $ Case ann <$> traverse renameInValue vs <*> traverse renameInCaseAlternative alts

160renameInValue (Let ann ds v) =

@@ -180,7 +180,7 @@ renameInCaseAlternative (CaseAlternative bs v) = newScope $

180-- Renames within binders.

181--

182renameInBinder :: Binder a -> Rename (Binder a)

183−renameInBinder n@(NullBinder{}) = return n

183+renameInBinder n@NullBinder{} = return n

184renameInBinder (LiteralBinder ann b) =

185 LiteralBinder ann <$> renameInLiteral renameInBinder b

186renameInBinder (VarBinder ann name) =

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

@@ -50,7 +50,7 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> ma

50 return $ Abs (Left arg) (Accessor prop (argToExpr arg))

51 desugarExpr (Case args cas) | any isAnonymousArgument args = do

52 argIdents <- forM args freshIfAnon

53− let args' = zipWith (\p -> maybe p argToExpr) args argIdents

53+ let args' = zipWith (`maybe` argToExpr) args argIdents

54 return $ foldr (Abs . Left) (Case args' cas) (catMaybes argIdents)

55 desugarExpr (IfThenElse u t f) | any isAnonymousArgument [u, t, f] = do

56 u' <- freshIfAnon u

src/Language/PureScript/Sugar/Operators/Common.hs+2−2

@@ -28,12 +28,12 @@ parseValue :: P.Parsec (Chain a) () a

28parseValue = token (either Just (const Nothing)) P.<?> "expression"

29

30parseOp

31− :: (a -> (Maybe (Qualified (OpName nameType))))

31+ :: (a -> Maybe (Qualified (OpName nameType)))

32 -> P.Parsec (Chain a) () (Qualified (OpName nameType))

33parseOp fromOp = token (either (const Nothing) fromOp) P.<?> "operator"

34

35matchOp

36− :: (a -> (Maybe (Qualified (OpName nameType))))

36+ :: (a -> Maybe (Qualified (OpName nameType)))

37 -> Qualified (OpName nameType)

38 -> P.Parsec (Chain a) () ()

39matchOp fromOp op = do

src/Language/PureScript/Sugar/Operators/Expr.hs+1−1

@@ -28,7 +28,7 @@ matchExprOperators = matchOperators isBinOp extractOp fromOp reapply modOpTable

28 fromOp _ = Nothing

29

30 reapply :: Qualified (OpName 'ValueOpName) -> Expr -> Expr -> Expr

31− reapply op t1 t2 = App (App (Op op) t1) t2

31+ reapply op t1 = App (App (Op op) t1)

32

33 modOpTable

34 :: [[P.Operator (Chain Expr) () Identity Expr]]

src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+1−1

@@ -223,7 +223,7 @@ deriveGeneric mn ds tyConNm dargs = do

223 $ liftApplicative (mkRecFun rs) (map (\(x, y) -> fromSpineFun (Accessor "recValue" (mkVar (Ident x))) y) rs)

224

225 mkRecFun :: [(String, Type)] -> Expr

226− mkRecFun xs = mkJust $ foldr lam recLiteral (map (Ident . fst) xs)

226+ mkRecFun xs = mkJust $ foldr (lam . Ident . fst) recLiteral xs

227 where recLiteral = Literal . ObjectLiteral $ map (\(s,_) -> (s, mkVar (Ident s))) xs

228 mkFromSpineFunction (PositionedDeclaration _ _ d) = mkFromSpineFunction d

229 mkFromSpineFunction _ = internalError "mkFromSpineFunction: expected DataDeclaration"

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

@@ -245,7 +245,7 @@ getEnv = checkEnv <$> get

245getLocalContext :: MonadState CheckState m => m Context

246getLocalContext = do

247 env <- getEnv

248− return [ (ident, ty') | ((Qualified Nothing ident@Ident{}), (ty', _, Defined)) <- M.toList (names env) ]

248+ return [ (ident, ty') | (Qualified Nothing ident@Ident{}, (ty', _, Defined)) <- M.toList (names env) ]

249

250-- | Update the @Environment@

251putEnv :: (MonadState CheckState m) => Environment -> m ()

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

@@ -89,7 +89,7 @@ subsumes' val (TypeApp f1 r1) (TypeApp f2 r2) | f1 == tyRecord && f2 == tyRecord

89 unifyTypes r1' (RCons p2 ty2 rest)

90 go ((p1, ty1) : ts1) ts2 rest r2'

91 -- Find the first property that's in the first list (of tuples) but not in the second

92− firstMissingProp t1 t2 = fst <$> (uncons $ minusBy' (comparing fst) t1 t2)

92+ firstMissingProp t1 t2 = fst <$> uncons (minusBy' (comparing fst) t1 t2)

93subsumes' val ty1 ty2@(TypeApp obj _) | obj == tyRecord = subsumes val ty2 ty1

94subsumes' val ty1 ty2 = do

95 unifyTypes ty1 ty2

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

@@ -148,7 +148,7 @@ typeDictionaryForBindingGroup moduleName vals = do

148 -- Make a map of names to the unification variables of untyped declarations

149 untypedDict = zip (map fst untyped) untypedNames

150 -- Create the dictionary of all name/type pairs, which will be added to the environment during type checking

151− dict = M.fromList (map (\(ident, ty) -> ((Qualified moduleName ident), (ty, Private, Undefined))) $ typedDict ++ untypedDict)

151+ dict = M.fromList (map (\(ident, ty) -> (Qualified moduleName ident, (ty, Private, Undefined))) $ typedDict ++ untypedDict)

152 return (untyped, typed, dict, untypedDict)

153

154checkTypedBindingGroupElement

tests/Language/PureScript/Ide/ReexportsSpec.hs+1−1

@@ -2,7 +2,7 @@

2{-# LANGUAGE NoImplicitPrelude #-}

3module Language.PureScript.Ide.ReexportsSpec where

4

5−import qualified Prelude as Prelude

5+import qualified Prelude

6import Protolude

7

8import qualified Data.Map as Map

tests/Language/PureScript/Ide/SourceFile/IntegrationSpec.hs+8−8

@@ -14,23 +14,23 @@ setup :: IO ()

14setup = void (Integration.reset *> Integration.loadAll)

15

16spec :: Spec

17−spec = beforeAll_ setup $ do

17+spec = beforeAll_ setup $

18 describe "Sourcefile Integration" $ do

19− it "finds a value declaration" $ do

19+ it "finds a value declaration" $

20 testCase "sfValue" (3, 1)

21− it "finds a type declaration" $ do

21+ it "finds a type declaration" $

22 testCase "SFType" (5, 1)

23− it "finds a data declaration" $ do

23+ it "finds a data declaration" $

24 testCase "SFData" (7, 1)

25− it "finds a data constructor" $ do

25+ it "finds a data constructor" $

26 testCase "SFOne" (7, 1)

27− it "finds a typeclass" $ do

27+ it "finds a typeclass" $

28 testCase "SFClass" (9, 1)

29− it "finds a typeclass member" $ do

29+ it "finds a typeclass member" $

30 testCase "sfShow" (10, 3)

31

32testCase :: Text -> (Int, Int) -> IO ()

33testCase s (x, y) = do

34− (P.SourceSpan f (P.SourcePos l c) _):_ <- Integration.getInfo s

34+ P.SourceSpan f (P.SourcePos l c) _ : _ <- Integration.getInfo s

35 toS f `shouldSatisfy` T.isSuffixOf "SourceFileSpec.purs"

36 (l, c) `shouldBe` (x, y)

tests/Language/PureScript/Ide/SourceFileSpec.hs+1−1

@@ -26,7 +26,7 @@ foreign2 = P.ExternDataDeclaration (P.ProperName "Foreign2") P.Star

26member1 = P.TypeDeclaration (P.Ident "member1") P.REmpty

27

28spec :: Spec

29−spec = do

29+spec =

30 describe "Extracting Spans" $ do

31 it "extracts a span for a value declaration" $

32 extractSpans span0 (P.PositionedDeclaration span1 [] value1) `shouldBe` [(Left "value1", span1)]

tests/TestPsci.hs−1

@@ -102,7 +102,6 @@ completionTestData =

102 , ("ST.new", ["ST.newSTRef"])

103 , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])

104 ]

105− where

106

105

107assertCompletedOk :: (String, [String]) -> Assertion

106assertCompletedOk :: (String, [String]) -> Assertion

108assertCompletedOk (line, expecteds) = do

107assertCompletedOk (line, expecteds) = do