0c5b8cc · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

various fixes

commit0c5b8cc79233f59b2092ec035aec349776467019 authorfaineance <faineance@users.noreply.github.com> dateThu 17 Mar 2016, 22:36 (11 years ago) parent546809c

24 files changed+43−51

compare with golang

unifiedsplit

license-generator/generate.hs+1−1

@@ -27,7 +27,7 @@ depsLicense dep = do

2727 putStrLn ""

2828 putStrLn $ f license

2929 where

30− f = unlines . map trimEnd . map (" " ++) . lines

30+ f = unlines . map (trimEnd . (" " ++)) . lines

3131 trimEnd = reverse . dropWhile isSpace . reverse

3232

3333main :: IO ()

psc-bundle/Main.hs+2−1

@@ -19,6 +19,7 @@

1919

2020module Main (main) where

2121

22+import Data.Maybe

2223import Data.Traversable (for)

2324import Data.Version (showVersion)

2425

@@ -125,7 +126,7 @@ options = Options <$> some inputFile

125126main :: IO ()

126127main = do

127128 opts <- execParser (info (version <*> helper <*> options) infoModList)

128− when (optionsRequirePath opts /= Nothing) $ hPutStrLn stderr "The require-path option is deprecated and will be removed in PureScript 0.9."

129+ when (isJust (optionsRequirePath opts)) $ hPutStrLn stderr "The require-path option is deprecated and will be removed in PureScript 0.9."

129130 output <- runExceptT (app opts)

130131 case output of

131132 Left err -> do

psc-docs/Main.hs+2−2

@@ -32,7 +32,7 @@ import qualified Text.PrettyPrint.ANSI.Leijen as PP

3232import qualified Language.PureScript as P

3333import qualified Paths_purescript as Paths

3434import System.Exit (exitFailure)

35−import System.IO (hPutStrLn, stderr)

35+import System.IO (hPutStrLn, hPrint, stderr)

3636import System.Directory (createDirectoryIfMissing)

3737import System.FilePath (takeDirectory)

3838import System.FilePath.Glob (glob)

@@ -139,7 +139,7 @@ dumpTags input renderTags = do

139139 e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)

140140 case e of

141141 Left err -> do

142− hPutStrLn stderr (show err)

142+ hPrint stderr err

143143 exitFailure

144144 Right ms ->

145145 ldump (renderTags (pairs ms))

psci/PSCi.hs+1−1

@@ -337,7 +337,7 @@ handleKindOf typ = do

337337 k = check (P.kindOf typ') chk

338338

339339 check :: StateT P.CheckState (ExceptT P.MultipleErrors (Writer P.MultipleErrors)) a -> P.CheckState -> Either P.MultipleErrors (a, P.CheckState)

340− check sew cs = fst . runWriter . runExceptT . runStateT sew $ cs

340+ check sew = fst . runWriter . runExceptT . runStateT sew

341341 case k of

342342 Left errStack -> PSCI . outputStrLn . P.prettyPrintMultipleErrors False $ errStack

343343 Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind

src/Control/Monad/Supply/Class.hs+1−1

@@ -21,4 +21,4 @@ instance (MonadSupply m) => MonadSupply (StateT s m) where

2121 fresh = lift fresh

2222

2323freshName :: (MonadSupply m) => m String

24−freshName = liftM (('$' :) . show) fresh

24+freshName = fmap (('$' :) . show) fresh

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

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

5555 rethrow (addHint (ErrorInModule mn)) $ do

5656 let usedNames = concatMap getNames decls

5757 let mnLookup = renameImports usedNames imps

58− jsImports <- T.traverse (importToJs mnLookup) . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ map snd $ imps

58+ jsImports <- T.traverse (importToJs mnLookup) . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ map snd imps

5959 let decls' = renameModules mnLookup decls

6060 jsDecls <- mapM bindToJs decls'

6161 optimized <- T.traverse (T.traverse optimize) jsDecls

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

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

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

6969 let standardExps = exps \\ foreignExps

70− let exps' = JSObjectLiteral Nothing $ map (runIdent &&& (JSVar Nothing) . identToJs) standardExps

70+ let exps' = JSObjectLiteral Nothing $ map (runIdent &&& JSVar Nothing . identToJs) standardExps

7171 ++ map (runIdent &&& foreignIdent) foreignExps

7272 return $ moduleBody ++ [JSAssignment Nothing (JSAccessor Nothing "exports" (JSVar Nothing "module")) exps']

7373

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

8585 -- with declaration names.

8686 --

8787 renameImports :: [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)

88− renameImports ids mns = go M.empty ids mns

88+ renameImports = go M.empty

8989 where

9090 go :: M.Map ModuleName (Ann, ModuleName) -> [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)

9191 go acc used ((ann, mn') : mns') =

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

@@ -78,7 +78,7 @@ nameIsJsReserved name =

7878--

7979nameIsJsBuiltIn :: String -> Bool

8080nameIsJsBuiltIn name =

81− elem name

81+ name `elem`

8282 [ "arguments"

8383 , "Array"

8484 , "ArrayBuffer"

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

@@ -96,9 +96,9 @@ inlineCommonValues = everywhereOnJS convert

9696 fnOne = [(C.prelude, C.one), (C.dataSemiring, C.one)]

9797 fnBottom = [(C.prelude, C.bottom), (C.dataBounded, C.bottom)]

9898 fnTop = [(C.prelude, C.top), (C.dataBounded, C.top)]

99− fnAdd = [(C.prelude, (C.+)), (C.prelude, (C.add)), (C.dataSemiring, (C.+)), (C.dataSemiring, (C.add))]

100− fnDivide = [(C.prelude, (C./)), (C.prelude, (C.div)), (C.dataModuloSemiring, C.div)]

101− fnMultiply = [(C.prelude, (C.*)), (C.prelude, (C.mul)), (C.dataSemiring, (C.*)), (C.dataSemiring, (C.mul))]

99+ fnAdd = [(C.prelude, (C.+)), (C.prelude, C.add), (C.dataSemiring, (C.+)), (C.dataSemiring, C.add)]

100+ fnDivide = [(C.prelude, (C./)), (C.prelude, C.div), (C.dataModuloSemiring, C.div)]

101+ fnMultiply = [(C.prelude, (C.*)), (C.prelude, C.mul), (C.dataSemiring, (C.*)), (C.dataSemiring, C.mul)]

102102 fnSubtract = [(C.prelude, (C.-)), (C.prelude, C.sub), (C.dataRing, C.sub)]

103103 intOp ss op x y = JSBinary ss BitwiseOr (JSBinary ss op x y) (JSNumericLiteral ss (Left 0))

104104

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

@@ -144,7 +144,7 @@ moduleToCoreFn env (A.Module _ coms mn decls (Just exps)) =

144144 binderToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Binder -> Binder Ann

145145 binderToCoreFn ss com (A.LiteralBinder lit) =

146146 LiteralBinder (ss, com, Nothing, Nothing) (fmap (binderToCoreFn ss com) lit)

147− binderToCoreFn ss com (A.NullBinder) =

147+ binderToCoreFn ss com A.NullBinder =

148148 NullBinder (ss, com, Nothing, Nothing)

149149 binderToCoreFn ss com (A.VarBinder name) =

150150 VarBinder (ss, com, Nothing, Nothing) name

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

@@ -1,7 +1,5 @@

11{-# LANGUAGE TupleSections #-}

22{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE RecordWildCards #-}

4−{-# LANGUAGE ViewPatterns #-}

53{-# LANGUAGE FlexibleContexts #-}

75-- | Functions for converting PureScript ASTs into values of the data types

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

@@ -1,4 +1,3 @@

1−{-# LANGUAGE ViewPatterns #-}

21{-# LANGUAGE TupleSections #-}

32{-# LANGUAGE RecordWildCards #-}

43{-# LANGUAGE FlexibleContexts #-}

@@ -217,8 +216,7 @@ lookupValueDeclaration importedFrom ident = do

217216 pure (importedFrom, [Left r'])

218217 other ->

219218 errOther other

220− other -> do

221− errOther other

219+ other -> errOther other

222220

223221 where

224222 thd :: (a, b, c) -> c

@@ -381,7 +379,7 @@ handleEnv TypeClassEnv{..} =

381379 promoteChild constraint ChildDeclaration{..} =

382380 case cdeclInfo of

383381 ChildTypeClassMember typ ->

384− pure $ Declaration

382+ pure Declaration

385383 { declTitle = cdeclTitle

386384 , declComments = cdeclComments

387385 , declSourceSpan = cdeclSourceSpan

src/Language/PureScript/Docs/Convert/Single.hs+3−4

@@ -11,11 +11,10 @@ module Language.PureScript.Docs.Convert.Single

1111

1212import Prelude ()

1313import Prelude.Compat

14−import Data.Maybe (catMaybes)

14+import Data.Maybe (mapMaybe, isNothing)

1515

1616import Control.Monad

1717import Control.Category ((>>>))

18−import Data.Maybe (mapMaybe, isNothing)

1918import Data.Either

2019import Data.List (nub, isPrefixOf, isSuffixOf)

2120

@@ -137,7 +136,7 @@ basicDeclaration title info = Just $ Right $ mkDeclaration title info

137136convertDeclaration :: P.Declaration -> String -> Maybe IntermediateDeclaration

138137convertDeclaration (P.ValueDeclaration _ _ _ (Right (P.TypedValue _ _ ty))) title =

139138 basicDeclaration title (ValueDeclaration ty)

140−convertDeclaration (P.ValueDeclaration _ _ _ _) title =

139+convertDeclaration (P.ValueDeclaration {}) title =

141140 -- If no explicit type declaration was provided, insert a wildcard, so that

142141 -- the actual type will be added during type checking.

143142 basicDeclaration title (ValueDeclaration P.TypeWildcard)

@@ -205,7 +204,7 @@ convertDeclaration _ _ = Nothing

205204convertComments :: [P.Comment] -> Maybe String

206205convertComments cs = do

207206 let raw = concatMap toLines cs

208− let docs = catMaybes (map stripPipe raw)

207+ let docs = mapMaybe stripPipe raw

209208 guard (not (null docs))

210209 pure (unlines docs)

211210

src/Language/PureScript/Errors.hs+8−7

@@ -637,7 +637,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

637637 renderSimpleErrorMessage (CycleInDeclaration nm) =

638638 line $ "The value of " ++ showIdent nm ++ " is undefined here, so this reference is not allowed."

639639 renderSimpleErrorMessage (CycleInModules mns) =

640− paras [ line $ "There is a cycle in module dependencies in these modules: "

640+ paras [ line "There is a cycle in module dependencies in these modules: "

641641 , indent $ paras (map (line . runModuleName) mns)

642642 ]

643643 renderSimpleErrorMessage (CycleInTypeSynonym name) =

@@ -671,7 +671,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

671671 sortRows' :: ([(String, Type)], Type) -> ([(String, Type)], Type) -> (Type, Type)

672672 sortRows' (s1, r1) (s2, r2) =

673673 let common :: [(String, (Type, Type))]

674− common = sortBy (comparing fst) $ [ (name, (t1, t2)) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

674+ common = sortBy (comparing fst) [ (name, (t1, t2)) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

675675

676676 sd1, sd2 :: [(String, Type)]

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

@@ -840,8 +840,9 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

840840 paras [ line "A case expression could not be determined to cover all inputs."

841841 , line "The following additional cases are required to cover all inputs:\n"

842842 , indent $ paras $

843− [ Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs)) ]

844− ++ [ line "..." | not b ]

843+ Box.hsep 1 Box.left

844+ (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))

845+ : [line "..." | not b]

845846 , line "Or alternatively, add a Partial constraint to the type of the enclosing value."

846847 , line "Non-exhaustive patterns for values without a `Partial` constraint will be disallowed in PureScript 0.9."

847848 ]

@@ -973,7 +974,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

973974 line "An anonymous function argument appears in an invalid context."

974975

975976 renderSimpleErrorMessage (InvalidOperatorInBinder op fn) =

976− paras $ [ line $ "Operator " ++ showIdent op ++ " cannot be used in a pattern as it is an alias for function " ++ showIdent fn ++ "."

977+ paras [ line $ "Operator " ++ showIdent op ++ " cannot be used in a pattern as it is an alias for function " ++ showIdent fn ++ "."

977978 , line "Only aliases for data constructors may be used in patterns."

978979 ]

979980

@@ -1197,11 +1198,11 @@ prettyPrintMultipleWarnings full = unlines . map renderBox . prettyPrintMultiple

11971198

11981199-- | Pretty print warnings as a Box

11991200prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> [Box.Box]

1200−prettyPrintMultipleWarningsBox full = prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning" full

1201+prettyPrintMultipleWarningsBox = prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning"

12011202

12021203-- | Pretty print errors as a Box

12031204prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> [Box.Box]

1204−prettyPrintMultipleErrorsBox full = prettyPrintMultipleErrorsWith Error "Error found:" "Error" full

1205+prettyPrintMultipleErrorsBox = prettyPrintMultipleErrorsWith Error "Error found:" "Error"

12051206

12061207prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> [Box.Box]

12071208prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) =

src/Language/PureScript/Ide/CaseSplit.hs+2−1

@@ -19,6 +19,7 @@ module Language.PureScript.Ide.CaseSplit

1919import Prelude ()

2020import Prelude.Compat hiding (lex)

2121

22+import Control.Arrow (second)

2223import Control.Monad.Error.Class

2324import "monad-logger" Control.Monad.Logger

2425import Data.List (find)

@@ -57,7 +58,7 @@ caseSplit q = do

5758 (tc, args) <- splitTypeConstructor (parseType' (T.unpack q))

5859 (EDType _ _ (DataType typeVars ctors)) <- findTypeDeclaration tc

5960 let applyTypeVars = everywhereOnTypes (replaceAllTypeVars (zip (map fst typeVars) args))

60− let appliedCtors = map (\(n, ts) -> (n, map applyTypeVars ts)) ctors

61+ let appliedCtors = map (second (map applyTypeVars)) ctors

6162 pure appliedCtors

6263

6364findTypeDeclaration :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

src/Language/PureScript/Ide/State.hs+5−6

@@ -72,9 +72,8 @@ insertModule externsFile = do

7272 liftIO . atomically $ insertModule' (envStateVar env) externsFile

7373

7474insertModule' :: TVar PscIdeState -> ExternsFile -> STM ()

75−insertModule' st ef = do

76− modifyTVar st $ \x ->

77− x { externsFiles = M.insert (efModuleName ef) ef (externsFiles x)

78− , pscStateModules = let (mn, decls) = convertExterns ef

79− in M.insert mn decls (pscStateModules x)

80− }

75+insertModule' st ef = modifyTVar st $ \x ->

76+ x { externsFiles = M.insert (efModuleName ef) ef (externsFiles x)

77+ , pscStateModules = let (mn, decls) = convertExterns ef

78+ in M.insert mn decls (pscStateModules x)

79+ }

src/Language/PureScript/Ide/Types.hs−1

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

22{-# LANGUAGE FlexibleContexts #-}

33{-# LANGUAGE GeneralizedNewtypeDeriving #-}

44{-# LANGUAGE OverloadedStrings #-}

5−{-# LANGUAGE RecordWildCards #-}

65{-# LANGUAGE ScopedTypeVariables #-}

87module Language.PureScript.Ide.Types where

src/Language/PureScript/Linter/Imports.hs+1−1

@@ -152,7 +152,7 @@ lintImports (Module _ _ mn mdecls mexports) env usedImps = do

152152 in foldr go used (classes ++ types ++ dctors ++ values)

153153 where

154154 go :: (ModuleName, Name) -> UsedImports -> UsedImports

155− go (q, name) acc = M.alter (Just . maybe [name] (name :)) q acc

155+ go (q, name) = M.alter (Just . maybe [name] (name :)) q

156156

157157 extractByQual

158158 :: (Eq a)

src/Language/PureScript/Make.hs+3−4

@@ -40,7 +40,7 @@ import Control.Monad.Trans.Control (MonadBaseControl(..))

4040import Control.Concurrent.Lifted as C

4141

4242import Data.List (foldl', sort)

43−import Data.Maybe (fromMaybe, catMaybes)

43+import Data.Maybe (fromMaybe, catMaybes, isJust)

4444import Data.Time.Clock

4545import Data.String (fromString)

4646import Data.Foldable (for_)

@@ -151,7 +151,7 @@ make :: forall m. (Monad m, MonadBaseControl IO m, MonadReader Options m, MonadE

151151 -> m Environment

152152make MakeActions{..} ms = do

153153 requirePath <- asks optionsRequirePath

154− when (requirePath /= Nothing) $ tell $ errorMessage DeprecatedRequirePath

154+ when (isJust requirePath) $ tell $ errorMessage DeprecatedRequirePath

155155

156156 checkModuleNamesAreUnique

157157

@@ -364,8 +364,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

364364 , mapSourceFile = sourceFile

365365 , mapGenerated = convertPos $ add (extraLines+1) 0 gen

366366 , mapName = Nothing

367− }) $

368− mappings

367+ }) mappings

369368 }

370369 let mapping = generate rawMapping

371370 writeTextFile mapFile $ BU8.toString . B.toStrict . encode $ mapping

src/Language/PureScript/Parser/Declarations.hs−1

@@ -184,7 +184,6 @@ parseTypeClassDeclaration = do

184184 indented *> reserved "where"

185185 indented *> mark (P.many (same *> positioned parseTypeDeclaration))

186186 return $ TypeClassDeclaration className idents implies members

187− where

188187

189188parseConstraint :: TokenParser Constraint

190189parseConstraint = (,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)

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

@@ -148,7 +148,7 @@ prettyPrintMany :: (Emit gen) => (a -> StateT PrinterState Maybe gen) -> [a] ->

148148prettyPrintMany f xs = do

149149 ss <- mapM f xs

150150 indentString <- currentIndent

151− return $ intercalate (emit "\n") $ map (\s -> mappend indentString s) ss

151+ return $ intercalate (emit "\n") $ map (mappend indentString) ss

152152

153153-- |

154154-- Prints an object key, escaping reserved names.

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

@@ -274,8 +274,7 @@ prettyPrintJSWithSourceMaps js =

274274 in (s, mp)

275275

276276prettyPrintJS :: [JS] -> String

277−prettyPrintJS = fromMaybe (internalError "Incomplete pattern") . fmap runPlainString . flip evalStateT (PrinterState 0) . prettyStatements

278−

277+prettyPrintJS = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyStatements

279278-- |

280279-- Generate an indented, pretty-printed string representing a Javascript expression

281280--

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

@@ -164,7 +164,7 @@ resolveExports env mn imps exps refs =

164164 exps' <- envModuleExports <$> mn'' `M.lookup` env

165165 ((_, dctors'), mnOrig) <- find (\((name', _), _) -> name == name') (exportedTypes exps')

166166 let relevantDctors = mapMaybe (\(Qualified mn''' dctor) -> if mn''' == Just mn'' then Just dctor else Nothing) dctors

167− return ((name, intersect relevantDctors dctors'), mnOrig)

167+ return ((name, relevantDctors `intersect` dctors'), mnOrig)

168168 go (Qualified Nothing _) = internalError "Unqualified value in resolveTypeExports"

169169

170170

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

@@ -103,7 +103,7 @@ rebracket externs ms = do

103103 Nothing ->

104104 maybe id rethrowWithPosition pos $

105105 throwError . errorMessage $ UnknownValue name

106− goBinder _ (BinaryNoParensBinder _ _ _) =

106+ goBinder _ (BinaryNoParensBinder {}) =

107107 internalError "BinaryNoParensBinder has no OpBinder"

108108 goBinder pos other = return (pos, other)

109109

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

@@ -1,4 +1,3 @@

1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

21{-# LANGUAGE FlexibleInstances #-}

32{-# LANGUAGE RankNTypes #-}

43{-# LANGUAGE MultiParamTypeClasses #-}