6658c63 · rowtype-yoga/purescript-native

psc-publish/Main.hs+2−2

compare with golang

unifiedsplit

@@ -38,8 +38,8 @@ publish :: Bool -> IO ()

38publish isDryRun =

39 if isDryRun

40 then do

41− _ <- preparePackage dryRunOptions

41+ _ <- unsafePreparePackage dryRunOptions

42 putStrLn "Dry run completed, no errors."

43 else do

44− pkg <- preparePackage defaultPublishOptions

44+ pkg <- unsafePreparePackage defaultPublishOptions

45 BL.putStrLn (A.encode pkg)

src/Language/PureScript/Ide/CaseSplit.hs+10−6

@@ -55,7 +55,8 @@ noAnnotations = WildcardAnnotations False

55caseSplit :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

56 Text -> m [Constructor]

57caseSplit q = do

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

58+ type' <- parseType' (T.unpack q)

59+ (tc, args) <- splitTypeConstructor type'

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

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

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

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

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

62 let appliedCtors = map (second (map applyTypeVars)) ctors

@@ -120,11 +121,14 @@ addClause s wca =

120 " = ?" <> (T.strip . T.pack . runIdent $ fName)

121 " = ?" <> (T.strip . T.pack . runIdent $ fName)

121 in [s, template]

122 in [s, template]

122

123

124+parseType' :: (MonadError PscIdeError m) =>

123−parseType' :: String -> Type

125+ String -> m Type

124−parseType' s = let (Right t) = do

126+parseType' s =

125− ts <- lex "" s

126− runTokenParser "" (parseType <* P.eof) ts

127+ case lex "<psc-ide>" s >>= runTokenParser "<psc-ide>" (parseType <* P.eof) of

127− in t

128+ Right type' -> pure type'

129+ Left err ->

130+ throwError (GeneralError ("Parsing the splittype failed with:"

131+ ++ show err))

128

132

129parseTypeDeclaration' :: String -> (Ident, Type)

133parseTypeDeclaration' :: String -> (Ident, Type)

130parseTypeDeclaration' s =

134parseTypeDeclaration' s =

src/Language/PureScript/Ide/Matcher.hs+21−11

@@ -86,15 +86,25 @@ flexRate pattern c@(Completion (_,ident,_)) = do

86-- the matchas a (start, length) tuple if there's a match.

87-- If match fails then it would be (-1,0)

88flexScore :: Text -> DeclIdent -> Maybe Double

89−flexScore "" _ = Nothing

90flexScore pat str =

89flexScore pat str =

90+ case T.uncons pat of

91+ Nothing -> Nothing

92+ Just (first, pattern) ->

91− case TE.encodeUtf8 str =~ TE.encodeUtf8 pat' :: (Int, Int) of

93+ case TE.encodeUtf8 str =~ TE.encodeUtf8 pat' :: (Int, Int) of

92− (-1,0) -> Nothing

94+ (-1,0) -> Nothing

93− (start,len) -> Just $ calcScore start (start + len)

95+ (start,len) -> Just $ calcScore start (start + len)

94− where

96+ where

95− Just (first,pattern) = T.uncons pat

97+ escapedPattern :: [Text]

98+ escapedPattern = map escape (T.unpack pattern)

99+

100+ -- escape prepends a backslash to "regexy" characters to prevent the

101+ -- matcher from crashing when trying to build the regex

102+ escape :: Char -> Text

103+ escape c = if c `elem` ("[\\^$.|?*+(){}" :: String)

104+ then T.pack ['\\', c]

105+ else T.singleton c

96− -- This just interleaves the search string with .*

106+ -- This just interleaves the search pattern with .*

97− -- abcd -> a.*b.*c.*d

107+ -- abcd[*] -> a.*b.*c.*d.*[*]

98− pat' = first `T.cons` T.concatMap (T.snoc ".*") pattern

108+ pat' = escape first <> foldMap (<> ".*") escapedPattern

99− calcScore start end =

109+ calcScore start end =

100− 100.0 / fromIntegral ((1 + start) * (end - start + 1))

110+ 100.0 / fromIntegral ((1 + start) * (end - start + 1))

src/Language/PureScript/Publish.hs+9−3

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

6module Language.PureScript.Publish

7 ( preparePackage

8 , preparePackage'

9+ , unsafePreparePackage

9 , PrepareM()

10 , PrepareM()

10 , runPrepareM

11 , runPrepareM

11 , warn

12 , warn

@@ -79,11 +80,16 @@ defaultPublishOptions = PublishOptions

79

80

80-- | Attempt to retrieve package metadata from the current directory.

81-- | Attempt to retrieve package metadata from the current directory.

81-- Calls exitFailure if no package metadata could be retrieved.

82-- Calls exitFailure if no package metadata could be retrieved.

83+unsafePreparePackage :: PublishOptions -> IO D.UploadedPackage

84+unsafePreparePackage opts = either (\e -> printError e >> exitFailure) pure =<< preparePackage opts

85+

86+-- | Attempt to retrieve package metadata from the current directory.

87+-- Returns a PackageError on failure

82−preparePackage :: PublishOptions -> IO D.UploadedPackage

88+preparePackage :: PublishOptions -> IO (Either PackageError D.UploadedPackage)

83preparePackage opts =

89preparePackage opts =

84 runPrepareM (preparePackage' opts)

90 runPrepareM (preparePackage' opts)

85− >>= either (\e -> printError e >> exitFailure)

91+ >>= either (pure . Left) (fmap Right . handleWarnings)

86− handleWarnings

92+

87 where

93 where

88 handleWarnings (result, warns) = do

94 handleWarnings (result, warns) = do

89 printWarnings warns

95 printWarnings warns

src/Language/PureScript/Publish/BoxesHelpers.hs+3

@@ -36,3 +36,6 @@ bulletedList f = map (indented . para . ("* " ++) . f)

36

37printToStderr :: Boxes.Box -> IO ()

38printToStderr = hPutStr stderr . Boxes.render

39+

40+printToStdout :: Boxes.Box -> IO ()

41+printToStdout = putStr . Boxes.render

src/Language/PureScript/Publish/ErrorsWarnings.hs+4

@@ -10,6 +10,7 @@ module Language.PureScript.Publish.ErrorsWarnings

10 , RepositoryFieldError(..)

11 , JSONSource(..)

12 , printError

13+ , printErrorToStdout

13 , renderError

14 , renderError

14 , printWarnings

15 , printWarnings

15 , renderWarnings

16 , renderWarnings

@@ -88,6 +89,9 @@ data OtherError

88printError :: PackageError -> IO ()

89printError :: PackageError -> IO ()

89printError = printToStderr . renderError

90printError = printToStderr . renderError

90

91

92+printErrorToStdout :: PackageError -> IO ()

93+printErrorToStdout = printToStdout . renderError

94+

91renderError :: PackageError -> Box

95renderError :: PackageError -> Box

92renderError err =

96renderError err =

93 case err of

97 case err of

tests/TestDocs.hs+11−7

@@ -18,6 +18,7 @@ import System.Exit

18import qualified Language.PureScript as P

19import qualified Language.PureScript.Docs as Docs

20import qualified Language.PureScript.Publish as Publish

21+import qualified Language.PureScript.Publish.ErrorsWarnings as Publish

21

22

22import TestUtils

23import TestUtils

23

24

@@ -29,13 +30,16 @@ publishOpts = Publish.defaultPublishOptions

29 where testVersion = ("v999.0.0", Version [999,0,0] [])

30 where testVersion = ("v999.0.0", Version [999,0,0] [])

30

31

31main :: IO ()

32main :: IO ()

32−main = do

33− pushd "examples/docs" $ do

33+main = pushd "examples/docs" $ do

34− Docs.Package{..} <- Publish.preparePackage publishOpts

34+ res <- Publish.preparePackage publishOpts

35+ case res of

36+ Left e -> Publish.printErrorToStdout e >> exitFailure

37+ Right Docs.Package{..} ->

35− forM_ testCases $ \(P.moduleNameFromString -> mn, pragmas) ->

38+ forM_ testCases $ \(P.moduleNameFromString -> mn, pragmas) ->

36− let mdl = takeJust ("module not found in docs: " ++ P.runModuleName mn)

39+ let mdl = takeJust ("module not found in docs: " ++ P.runModuleName mn)

37− (find ((==) mn . Docs.modName) pkgModules)

40+ (find ((==) mn . Docs.modName) pkgModules)

38− in forM_ pragmas (`runAssertionIO` mdl)

41+ in forM_ pragmas (`runAssertionIO` mdl)

42+

39

43

40takeJust :: String -> Maybe a -> a

44takeJust :: String -> Maybe a -> a

41takeJust msg = fromMaybe (error msg)

45takeJust msg = fromMaybe (error msg)

tests/TestPscPublish.hs+18−6

@@ -19,12 +19,12 @@ import Data.Version

19

20import Language.PureScript.Docs

21import Language.PureScript.Publish

22+import Language.PureScript.Publish.ErrorsWarnings as Publish

22

23

23import TestUtils

24import TestUtils

24

25

25main :: IO ()

26main :: IO ()

26−main = do

27− testPackage "tests/support/prelude"

27+main = testPackage "tests/support/prelude"

28

29data TestResult

30 = ParseFailed String

@@ -53,10 +53,11 @@ testRunOptions = defaultPublishOptions

53-- | Given a directory which contains a package, produce JSON from it, and then

54-- | attempt to parse it again, and ensure that it doesn't change.

55testPackage :: String -> IO ()

56−testPackage dir = do

56+testPackage dir = pushd dir $ do

57− pushd dir $ do

58− r <- roundTrip <$> preparePackage testRunOptions

57+ res <- preparePackage testRunOptions

59− case r of

58+ case res of

59+ Left e -> preparePackageError e

60+ Right package -> case roundTrip package of

60 Pass _ -> do

61 Pass _ -> do

61 putStrLn ("psc-publish test passed for: " ++ dir)

62 putStrLn ("psc-publish test passed for: " ++ dir)

62 pure ()

63 pure ()

@@ -64,3 +65,14 @@ testPackage dir = do

64 putStrLn ("psc-publish tests failed on " ++ dir ++ ":")

65 putStrLn ("psc-publish tests failed on " ++ dir ++ ":")

65 print other

66 print other

66 exitFailure

67 exitFailure

68+ where

69+ preparePackageError e@(UserError BowerJSONNotFound) = do

70+ Publish.printErrorToStdout e

71+ putStrLn ""

72+ putStrLn "=========================================="

73+ putStrLn "Did you forget to update the submodules?"

74+ putStrLn "$ git submodule sync; git submodule update"

75+ putStrLn "=========================================="

76+ putStrLn ""

77+ exitFailure

78+ preparePackageError e = Publish.printErrorToStdout e >> exitFailure