git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
various fixes
0c5b8ccfaineance
license-generator/generate.hs+1−1
@@ -27,7 +27,7 @@ depsLicense dep = do
27 putStrLn ""
27 putStrLn ""
28 putStrLn $ f license
28 putStrLn $ f license
29 where
29 where
30− f = unlines . map trimEnd . map (" " ++) . lines
30+ f = unlines . map (trimEnd . (" " ++)) . lines
31 trimEnd = reverse . dropWhile isSpace . reverse
31 trimEnd = reverse . dropWhile isSpace . reverse
32
32
33main :: IO ()
33main :: IO ()
psc-bundle/Main.hs+2−1
@@ -19,6 +19,7 @@
19
19
20module Main (main) where
20module Main (main) where
21
21
22+import Data.Maybe
22import Data.Traversable (for)
23import Data.Traversable (for)
23import Data.Version (showVersion)
24import Data.Version (showVersion)
24
25
@@ -125,7 +126,7 @@ options = Options <$> some inputFile
125main :: IO ()
126main :: IO ()
126main = do
127main = do
127 opts <- execParser (info (version <*> helper <*> options) infoModList)
128 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."
129 output <- runExceptT (app opts)
130 output <- runExceptT (app opts)
130 case output of
131 case output of
131 Left err -> do
132 Left err -> do
psc-docs/Main.hs+2−2
@@ -32,7 +32,7 @@ import qualified Text.PrettyPrint.ANSI.Leijen as PP
32import qualified Language.PureScript as P
32import qualified Language.PureScript as P
33import qualified Paths_purescript as Paths
33import qualified Paths_purescript as Paths
34import System.Exit (exitFailure)
34import System.Exit (exitFailure)
35−import System.IO (hPutStrLn, stderr)
35+import System.IO (hPutStrLn, hPrint, stderr)
36import System.Directory (createDirectoryIfMissing)
36import System.Directory (createDirectoryIfMissing)
37import System.FilePath (takeDirectory)
37import System.FilePath (takeDirectory)
38import System.FilePath.Glob (glob)
38import System.FilePath.Glob (glob)
@@ -139,7 +139,7 @@ dumpTags input renderTags = do
139 e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
139 e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
140 case e of
140 case e of
141 Left err -> do
141 Left err -> do
142− hPutStrLn stderr (show err)
142+ hPrint stderr err
143 exitFailure
143 exitFailure
144 Right ms ->
144 Right ms ->
145 ldump (renderTags (pairs ms))
145 ldump (renderTags (pairs ms))
psci/PSCi.hs+1−1
@@ -337,7 +337,7 @@ handleKindOf typ = do
337 k = check (P.kindOf typ') chk
337 k = check (P.kindOf typ') chk
338
338
339 check :: StateT P.CheckState (ExceptT P.MultipleErrors (Writer P.MultipleErrors)) a -> P.CheckState -> Either P.MultipleErrors (a, P.CheckState)
339 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
341 case k of
341 case k of
342 Left errStack -> PSCI . outputStrLn . P.prettyPrintMultipleErrors False $ errStack
342 Left errStack -> PSCI . outputStrLn . P.prettyPrintMultipleErrors False $ errStack
343 Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind
343 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
21 fresh = lift fresh
21 fresh = lift fresh
22
22
23freshName :: (MonadSupply m) => m String
23freshName :: (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_ =
55 rethrow (addHint (ErrorInModule mn)) $ do
55 rethrow (addHint (ErrorInModule mn)) $ do
56 let usedNames = concatMap getNames decls
56 let usedNames = concatMap getNames decls
57 let mnLookup = renameImports usedNames imps
57 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
59 let decls' = renameModules mnLookup decls
59 let decls' = renameModules mnLookup decls
60 jsDecls <- mapM bindToJs decls'
60 jsDecls <- mapM bindToJs decls'
61 optimized <- T.traverse (T.traverse optimize) jsDecls
61 optimized <- T.traverse (T.traverse optimize) jsDecls
@@ -67,7 +67,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
67 let moduleBody = header : foreign' ++ jsImports ++ concat optimized
67 let moduleBody = header : foreign' ++ jsImports ++ concat optimized
68 let foreignExps = exps `intersect` (fst `map` foreigns)
68 let foreignExps = exps `intersect` (fst `map` foreigns)
69 let standardExps = exps \\ foreignExps
69 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
71 ++ map (runIdent &&& foreignIdent) foreignExps
71 ++ map (runIdent &&& foreignIdent) foreignExps
72 return $ moduleBody ++ [JSAssignment Nothing (JSAccessor Nothing "exports" (JSVar Nothing "module")) exps']
72 return $ moduleBody ++ [JSAssignment Nothing (JSAccessor Nothing "exports" (JSVar Nothing "module")) exps']
73
73
@@ -85,7 +85,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
85 -- with declaration names.
85 -- with declaration names.
86 --
86 --
87 renameImports :: [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)
87 renameImports :: [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)
88− renameImports ids mns = go M.empty ids mns
88+ renameImports = go M.empty
89 where
89 where
90 go :: M.Map ModuleName (Ann, ModuleName) -> [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)
90 go :: M.Map ModuleName (Ann, ModuleName) -> [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)
91 go acc used ((ann, mn') : mns') =
91 go acc used ((ann, mn') : mns') =
src/Language/PureScript/CodeGen/JS/Common.hs+1−1
@@ -78,7 +78,7 @@ nameIsJsReserved name =
78--
78--
79nameIsJsBuiltIn :: String -> Bool
79nameIsJsBuiltIn :: String -> Bool
80nameIsJsBuiltIn name =
80nameIsJsBuiltIn name =
81− elem name
81+ name `elem`
82 [ "arguments"
82 [ "arguments"
83 , "Array"
83 , "Array"
84 , "ArrayBuffer"
84 , "ArrayBuffer"
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs+3−3
@@ -96,9 +96,9 @@ inlineCommonValues = everywhereOnJS convert
96 fnOne = [(C.prelude, C.one), (C.dataSemiring, C.one)]
96 fnOne = [(C.prelude, C.one), (C.dataSemiring, C.one)]
97 fnBottom = [(C.prelude, C.bottom), (C.dataBounded, C.bottom)]
97 fnBottom = [(C.prelude, C.bottom), (C.dataBounded, C.bottom)]
98 fnTop = [(C.prelude, C.top), (C.dataBounded, C.top)]
98 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))]
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)]
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))]
101+ fnMultiply = [(C.prelude, (C.*)), (C.prelude, C.mul), (C.dataSemiring, (C.*)), (C.dataSemiring, C.mul)]
102 fnSubtract = [(C.prelude, (C.-)), (C.prelude, C.sub), (C.dataRing, C.sub)]
102 fnSubtract = [(C.prelude, (C.-)), (C.prelude, C.sub), (C.dataRing, C.sub)]
103 intOp ss op x y = JSBinary ss BitwiseOr (JSBinary ss op x y) (JSNumericLiteral ss (Left 0))
103 intOp ss op x y = JSBinary ss BitwiseOr (JSBinary ss op x y) (JSNumericLiteral ss (Left 0))
104
104
src/Language/PureScript/CoreFn/Desugar.hs+1−1
@@ -144,7 +144,7 @@ moduleToCoreFn env (A.Module _ coms mn decls (Just exps)) =
144 binderToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Binder -> Binder Ann
144 binderToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Binder -> Binder Ann
145 binderToCoreFn ss com (A.LiteralBinder lit) =
145 binderToCoreFn ss com (A.LiteralBinder lit) =
146 LiteralBinder (ss, com, Nothing, Nothing) (fmap (binderToCoreFn ss com) lit)
146 LiteralBinder (ss, com, Nothing, Nothing) (fmap (binderToCoreFn ss com) lit)
147− binderToCoreFn ss com (A.NullBinder) =
147+ binderToCoreFn ss com A.NullBinder =
148 NullBinder (ss, com, Nothing, Nothing)
148 NullBinder (ss, com, Nothing, Nothing)
149 binderToCoreFn ss com (A.VarBinder name) =
149 binderToCoreFn ss com (A.VarBinder name) =
150 VarBinder (ss, com, Nothing, Nothing) name
150 VarBinder (ss, com, Nothing, Nothing) name
src/Language/PureScript/Docs/Convert.hs−2
@@ -1,7 +1,5 @@
1{-# LANGUAGE TupleSections #-}
1{-# LANGUAGE TupleSections #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE RecordWildCards #-}
4−{-# LANGUAGE ViewPatterns #-}
5{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
6
4
7-- | Functions for converting PureScript ASTs into values of the data types
5-- | 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 #-}
2{-# LANGUAGE TupleSections #-}
1{-# LANGUAGE TupleSections #-}
3{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
@@ -217,8 +216,7 @@ lookupValueDeclaration importedFrom ident = do
217 pure (importedFrom, [Left r'])
216 pure (importedFrom, [Left r'])
218 other ->
217 other ->
219 errOther other
218 errOther other
220− other -> do
221− errOther other
219+ other -> errOther other
222
220
223 where
221 where
224 thd :: (a, b, c) -> c
222 thd :: (a, b, c) -> c
@@ -381,7 +379,7 @@ handleEnv TypeClassEnv{..} =
381 promoteChild constraint ChildDeclaration{..} =
379 promoteChild constraint ChildDeclaration{..} =
382 case cdeclInfo of
380 case cdeclInfo of
383 ChildTypeClassMember typ ->
381 ChildTypeClassMember typ ->
384− pure $ Declaration
382+ pure Declaration
385 { declTitle = cdeclTitle
383 { declTitle = cdeclTitle
386 , declComments = cdeclComments
384 , declComments = cdeclComments
387 , declSourceSpan = cdeclSourceSpan
385 , declSourceSpan = cdeclSourceSpan
src/Language/PureScript/Docs/Convert/Single.hs+3−4
@@ -11,11 +11,10 @@ module Language.PureScript.Docs.Convert.Single
11
11
12import Prelude ()
12import Prelude ()
13import Prelude.Compat
13import Prelude.Compat
14−import Data.Maybe (catMaybes)
14+import Data.Maybe (mapMaybe, isNothing)
15
15
16import Control.Monad
16import Control.Monad
17import Control.Category ((>>>))
17import Control.Category ((>>>))
18−import Data.Maybe (mapMaybe, isNothing)
19import Data.Either
18import Data.Either
20import Data.List (nub, isPrefixOf, isSuffixOf)
19import Data.List (nub, isPrefixOf, isSuffixOf)
21
20
@@ -137,7 +136,7 @@ basicDeclaration title info = Just $ Right $ mkDeclaration title info
137convertDeclaration :: P.Declaration -> String -> Maybe IntermediateDeclaration
136convertDeclaration :: P.Declaration -> String -> Maybe IntermediateDeclaration
138convertDeclaration (P.ValueDeclaration _ _ _ (Right (P.TypedValue _ _ ty))) title =
137convertDeclaration (P.ValueDeclaration _ _ _ (Right (P.TypedValue _ _ ty))) title =
139 basicDeclaration title (ValueDeclaration ty)
138 basicDeclaration title (ValueDeclaration ty)
140−convertDeclaration (P.ValueDeclaration _ _ _ _) title =
139+convertDeclaration (P.ValueDeclaration {}) title =
141 -- If no explicit type declaration was provided, insert a wildcard, so that
140 -- If no explicit type declaration was provided, insert a wildcard, so that
142 -- the actual type will be added during type checking.
141 -- the actual type will be added during type checking.
143 basicDeclaration title (ValueDeclaration P.TypeWildcard)
142 basicDeclaration title (ValueDeclaration P.TypeWildcard)
@@ -205,7 +204,7 @@ convertDeclaration _ _ = Nothing
205convertComments :: [P.Comment] -> Maybe String
204convertComments :: [P.Comment] -> Maybe String
206convertComments cs = do
205convertComments cs = do
207 let raw = concatMap toLines cs
206 let raw = concatMap toLines cs
208− let docs = catMaybes (map stripPipe raw)
207+ let docs = mapMaybe stripPipe raw
209 guard (not (null docs))
208 guard (not (null docs))
210 pure (unlines docs)
209 pure (unlines docs)
211
210
src/Language/PureScript/Errors.hs+8−7
@@ -637,7 +637,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
637 renderSimpleErrorMessage (CycleInDeclaration nm) =
637 renderSimpleErrorMessage (CycleInDeclaration nm) =
638 line $ "The value of " ++ showIdent nm ++ " is undefined here, so this reference is not allowed."
638 line $ "The value of " ++ showIdent nm ++ " is undefined here, so this reference is not allowed."
639 renderSimpleErrorMessage (CycleInModules mns) =
639 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: "
641 , indent $ paras (map (line . runModuleName) mns)
641 , indent $ paras (map (line . runModuleName) mns)
642 ]
642 ]
643 renderSimpleErrorMessage (CycleInTypeSynonym name) =
643 renderSimpleErrorMessage (CycleInTypeSynonym name) =
@@ -671,7 +671,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
671 sortRows' :: ([(String, Type)], Type) -> ([(String, Type)], Type) -> (Type, Type)
671 sortRows' :: ([(String, Type)], Type) -> ([(String, Type)], Type) -> (Type, Type)
672 sortRows' (s1, r1) (s2, r2) =
672 sortRows' (s1, r1) (s2, r2) =
673 let common :: [(String, (Type, Type))]
673 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' ]
675
675
676 sd1, sd2 :: [(String, Type)]
676 sd1, sd2 :: [(String, Type)]
677 sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]
677 sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]
@@ -840,8 +840,9 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
840 paras [ line "A case expression could not be determined to cover all inputs."
840 paras [ line "A case expression could not be determined to cover all inputs."
841 , line "The following additional cases are required to cover all inputs:\n"
841 , line "The following additional cases are required to cover all inputs:\n"
842 , indent $ paras $
842 , indent $ paras $
843+ Box.hsep 1 Box.left
843− [ Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs)) ]
844+ (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))
844− ++ [ line "..." | not b ]
845+ : [line "..." | not b]
845 , line "Or alternatively, add a Partial constraint to the type of the enclosing value."
846 , line "Or alternatively, add a Partial constraint to the type of the enclosing value."
846 , line "Non-exhaustive patterns for values without a `Partial` constraint will be disallowed in PureScript 0.9."
847 , line "Non-exhaustive patterns for values without a `Partial` constraint will be disallowed in PureScript 0.9."
847 ]
848 ]
@@ -973,7 +974,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
973 line "An anonymous function argument appears in an invalid context."
974 line "An anonymous function argument appears in an invalid context."
974
975
975 renderSimpleErrorMessage (InvalidOperatorInBinder op fn) =
976 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 ++ "."
977 , line "Only aliases for data constructors may be used in patterns."
978 , line "Only aliases for data constructors may be used in patterns."
978 ]
979 ]
979
980
@@ -1197,11 +1198,11 @@ prettyPrintMultipleWarnings full = unlines . map renderBox . prettyPrintMultiple
1197
1198
1198-- | Pretty print warnings as a Box
1199-- | Pretty print warnings as a Box
1199prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> [Box.Box]
1200prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> [Box.Box]
1200−prettyPrintMultipleWarningsBox full = prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning" full
1201+prettyPrintMultipleWarningsBox = prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning"
1201
1202
1202-- | Pretty print errors as a Box
1203-- | Pretty print errors as a Box
1203prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> [Box.Box]
1204prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> [Box.Box]
1204−prettyPrintMultipleErrorsBox full = prettyPrintMultipleErrorsWith Error "Error found:" "Error" full
1205+prettyPrintMultipleErrorsBox = prettyPrintMultipleErrorsWith Error "Error found:" "Error"
1205
1206
1206prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> [Box.Box]
1207prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> [Box.Box]
1207prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) =
1208prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) =
src/Language/PureScript/Ide/CaseSplit.hs+2−1
@@ -19,6 +19,7 @@ module Language.PureScript.Ide.CaseSplit
19import Prelude ()
19import Prelude ()
20import Prelude.Compat hiding (lex)
20import Prelude.Compat hiding (lex)
21
21
22+import Control.Arrow (second)
22import Control.Monad.Error.Class
23import Control.Monad.Error.Class
23import "monad-logger" Control.Monad.Logger
24import "monad-logger" Control.Monad.Logger
24import Data.List (find)
25import Data.List (find)
@@ -57,7 +58,7 @@ caseSplit q = do
57 (tc, args) <- splitTypeConstructor (parseType' (T.unpack q))
58 (tc, args) <- splitTypeConstructor (parseType' (T.unpack q))
58 (EDType _ _ (DataType typeVars ctors)) <- findTypeDeclaration tc
59 (EDType _ _ (DataType typeVars ctors)) <- findTypeDeclaration tc
59 let applyTypeVars = everywhereOnTypes (replaceAllTypeVars (zip (map fst typeVars) args))
60 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
61 pure appliedCtors
62 pure appliedCtors
62
63
63findTypeDeclaration :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
64findTypeDeclaration :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
src/Language/PureScript/Ide/State.hs+5−6
@@ -72,9 +72,8 @@ insertModule externsFile = do
72 liftIO . atomically $ insertModule' (envStateVar env) externsFile
72 liftIO . atomically $ insertModule' (envStateVar env) externsFile
73
73
74insertModule' :: TVar PscIdeState -> ExternsFile -> STM ()
74insertModule' :: TVar PscIdeState -> ExternsFile -> STM ()
75−insertModule' st ef = do
75+insertModule' st ef = modifyTVar st $ \x ->
76− modifyTVar st $ \x ->
77− x { externsFiles = M.insert (efModuleName ef) ef (externsFiles x)
76+ x { externsFiles = M.insert (efModuleName ef) ef (externsFiles x)
78− , pscStateModules = let (mn, decls) = convertExterns ef
77+ , pscStateModules = let (mn, decls) = convertExterns ef
79− in M.insert mn decls (pscStateModules x)
78+ in M.insert mn decls (pscStateModules x)
80− }
79+ }
src/Language/PureScript/Ide/Types.hs−1
@@ -2,7 +2,6 @@
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE RecordWildCards #-}
6{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
7
6
8module Language.PureScript.Ide.Types where
7module 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
152 in foldr go used (classes ++ types ++ dctors ++ values)
152 in foldr go used (classes ++ types ++ dctors ++ values)
153 where
153 where
154 go :: (ModuleName, Name) -> UsedImports -> UsedImports
154 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
156
156
157 extractByQual
157 extractByQual
158 :: (Eq a)
158 :: (Eq a)
src/Language/PureScript/Make.hs+3−4
@@ -40,7 +40,7 @@ import Control.Monad.Trans.Control (MonadBaseControl(..))
40import Control.Concurrent.Lifted as C
40import Control.Concurrent.Lifted as C
41
41
42import Data.List (foldl', sort)
42import Data.List (foldl', sort)
43−import Data.Maybe (fromMaybe, catMaybes)
43+import Data.Maybe (fromMaybe, catMaybes, isJust)
44import Data.Time.Clock
44import Data.Time.Clock
45import Data.String (fromString)
45import Data.String (fromString)
46import Data.Foldable (for_)
46import Data.Foldable (for_)
@@ -151,7 +151,7 @@ make :: forall m. (Monad m, MonadBaseControl IO m, MonadReader Options m, MonadE
151 -> m Environment
151 -> m Environment
152make MakeActions{..} ms = do
152make MakeActions{..} ms = do
153 requirePath <- asks optionsRequirePath
153 requirePath <- asks optionsRequirePath
154− when (requirePath /= Nothing) $ tell $ errorMessage DeprecatedRequirePath
154+ when (isJust requirePath) $ tell $ errorMessage DeprecatedRequirePath
155
155
156 checkModuleNamesAreUnique
156 checkModuleNamesAreUnique
157
157
@@ -364,8 +364,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
364 , mapSourceFile = sourceFile
364 , mapSourceFile = sourceFile
365 , mapGenerated = convertPos $ add (extraLines+1) 0 gen
365 , mapGenerated = convertPos $ add (extraLines+1) 0 gen
366 , mapName = Nothing
366 , mapName = Nothing
367− }) $
368− mappings
367+ }) mappings
369 }
368 }
370 let mapping = generate rawMapping
369 let mapping = generate rawMapping
371 writeTextFile mapFile $ BU8.toString . B.toStrict . encode $ mapping
370 writeTextFile mapFile $ BU8.toString . B.toStrict . encode $ mapping
src/Language/PureScript/Parser/Declarations.hs−1
@@ -184,7 +184,6 @@ parseTypeClassDeclaration = do
184 indented *> reserved "where"
184 indented *> reserved "where"
185 indented *> mark (P.many (same *> positioned parseTypeDeclaration))
185 indented *> mark (P.many (same *> positioned parseTypeDeclaration))
186 return $ TypeClassDeclaration className idents implies members
186 return $ TypeClassDeclaration className idents implies members
187− where
188
187
189parseConstraint :: TokenParser Constraint
188parseConstraint :: TokenParser Constraint
190parseConstraint = (,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)
189parseConstraint = (,) <$> 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] ->
148prettyPrintMany f xs = do
148prettyPrintMany f xs = do
149 ss <- mapM f xs
149 ss <- mapM f xs
150 indentString <- currentIndent
150 indentString <- currentIndent
151− return $ intercalate (emit "\n") $ map (\s -> mappend indentString s) ss
151+ return $ intercalate (emit "\n") $ map (mappend indentString) ss
152
152
153-- |
153-- |
154-- Prints an object key, escaping reserved names.
154-- Prints an object key, escaping reserved names.
src/Language/PureScript/Pretty/JS.hs+1−2
@@ -274,8 +274,7 @@ prettyPrintJSWithSourceMaps js =
274 in (s, mp)
274 in (s, mp)
275
275
276prettyPrintJS :: [JS] -> String
276prettyPrintJS :: [JS] -> String
277−prettyPrintJS = fromMaybe (internalError "Incomplete pattern") . fmap runPlainString . flip evalStateT (PrinterState 0) . prettyStatements
277+prettyPrintJS = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyStatements
278−
279-- |
278-- |
280-- Generate an indented, pretty-printed string representing a Javascript expression
279-- Generate an indented, pretty-printed string representing a Javascript expression
281--
280--
src/Language/PureScript/Sugar/Names/Exports.hs+1−1
@@ -164,7 +164,7 @@ resolveExports env mn imps exps refs =
164 exps' <- envModuleExports <$> mn'' `M.lookup` env
164 exps' <- envModuleExports <$> mn'' `M.lookup` env
165 ((_, dctors'), mnOrig) <- find (\((name', _), _) -> name == name') (exportedTypes exps')
165 ((_, dctors'), mnOrig) <- find (\((name', _), _) -> name == name') (exportedTypes exps')
166 let relevantDctors = mapMaybe (\(Qualified mn''' dctor) -> if mn''' == Just mn'' then Just dctor else Nothing) dctors
166 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)
168 go (Qualified Nothing _) = internalError "Unqualified value in resolveTypeExports"
168 go (Qualified Nothing _) = internalError "Unqualified value in resolveTypeExports"
169
169
170
170
src/Language/PureScript/Sugar/Operators.hs+1−1
@@ -103,7 +103,7 @@ rebracket externs ms = do
103 Nothing ->
103 Nothing ->
104 maybe id rethrowWithPosition pos $
104 maybe id rethrowWithPosition pos $
105 throwError . errorMessage $ UnknownValue name
105 throwError . errorMessage $ UnknownValue name
106− goBinder _ (BinaryNoParensBinder _ _ _) =
106+ goBinder _ (BinaryNoParensBinder {}) =
107 internalError "BinaryNoParensBinder has no OpBinder"
107 internalError "BinaryNoParensBinder has no OpBinder"
108 goBinder pos other = return (pos, other)
108 goBinder pos other = return (pos, other)
109
109
src/Language/PureScript/TypeChecker/Monad.hs−1
@@ -1,4 +1,3 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2{-# LANGUAGE FlexibleInstances #-}
1{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE RankNTypes #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE MultiParamTypeClasses #-}