751018b · rowtype-yoga/purescript-native

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

on golang help sign in

Add command to apply minor package updates (#2510)

751018bPhil Freeman10 years ago

psc-package/Main.hs+123−5

compare with golang

unifiedsplit

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

8module Main where

10+import qualified Control.Foldl as Foldl

10import qualified Data.Aeson as Aeson

11import qualified Data.Aeson as Aeson

11import Data.Aeson.Encode.Pretty

12import Data.Aeson.Encode.Pretty

12import Data.Foldable (fold, for_, traverse_)

13import Data.Foldable (fold, for_, traverse_)

@@ -15,9 +16,11 @@ import qualified Data.Map as Map

15import Data.Maybe (fromMaybe, mapMaybe)

16import Data.Maybe (fromMaybe, mapMaybe)

16import qualified Data.Set as Set

17import qualified Data.Set as Set

17import Data.Text (pack)

18import Data.Text (pack)

19+import qualified Data.Text as T

20+import Data.Text.Encoding (encodeUtf8)

18import qualified Data.Text.Lazy as TL

21import qualified Data.Text.Lazy as TL

19import qualified Data.Text.Lazy.Builder as TB

22import qualified Data.Text.Lazy.Builder as TB

20−import Data.Text.Encoding (encodeUtf8)

23+import qualified Data.Text.Read as TR

21import Data.Traversable (for)

24import Data.Traversable (for)

22import Data.Version (showVersion)

25import Data.Version (showVersion)

23import qualified Filesystem.Path.CurrentOS as Path

26import qualified Filesystem.Path.CurrentOS as Path

@@ -25,7 +28,8 @@ import GHC.Generics (Generic)

25import qualified Options.Applicative as Opts

28import qualified Options.Applicative as Opts

26import qualified Paths_purescript as Paths

29import qualified Paths_purescript as Paths

27import qualified System.IO as IO

30import qualified System.IO as IO

28−import Turtle hiding (fold)

31+import Turtle hiding (fold, s, x)

32+import qualified Turtle

30packageFile :: Path.FilePath

34packageFile :: Path.FilePath

31packageFile = "psc-package.json"

35packageFile = "psc-package.json"

@@ -61,8 +65,8 @@ readPackageFile = do

61 exit (ExitFailure 1)

65 exit (ExitFailure 1)

62 Just pkg -> return pkg

66 Just pkg -> return pkg

64−encodePrettyToText :: Aeson.ToJSON json => json -> Text

68+packageConfigToJSON :: PackageConfig -> Text

65−encodePrettyToText =

69+packageConfigToJSON =

66 TL.toStrict

70 TL.toStrict

67 . TB.toLazyText

71 . TB.toLazyText

68 . encodePrettyToTextBuilder' config

72 . encodePrettyToTextBuilder' config

@@ -76,10 +80,18 @@ encodePrettyToText =

76 ]

80 ]

77 }

81 }

83+packageSetToJSON :: PackageSet -> Text

84+packageSetToJSON =

85+ TL.toStrict

86+ . TB.toLazyText

87+ . encodePrettyToTextBuilder' config

88+ where

89+ config = defConfig { confCompare = compare }

90+

79writePackageFile :: PackageConfig -> IO ()

91writePackageFile :: PackageConfig -> IO ()

80writePackageFile =

92writePackageFile =

81 writeTextFile packageFile

93 writeTextFile packageFile

82− . encodePrettyToText

94+ . packageConfigToJSON

84data PackageInfo = PackageInfo

96data PackageInfo = PackageInfo

85 { repo :: Text

97 { repo :: Text

@@ -108,6 +120,18 @@ cloneShallow from ref into =

108 , pathToTextUnsafe into

120 , pathToTextUnsafe into

109 ] empty .||. exit (ExitFailure 1)

121 ] empty .||. exit (ExitFailure 1)

110

122

123+listRemoteTags

124+ :: Text

125+ -- ^ repo

126+ -> Turtle.Shell Text

127+listRemoteTags from =

128+ inproc "git"

129+ [ "ls-remote"

130+ , "-q"

131+ , "-t"

132+ , from

133+ ] empty

134+

111getPackageSet :: PackageConfig -> IO ()

135getPackageSet :: PackageConfig -> IO ()

112getPackageSet PackageConfig{ source, set } = do

136getPackageSet PackageConfig{ source, set } = do

113 let pkgDir = ".psc-package" </> fromText set </> ".set"

137 let pkgDir = ".psc-package" </> fromText set </> ".set"

@@ -128,6 +152,11 @@ readPackageSet PackageConfig{ set } = do

128 exit (ExitFailure 1)

152 exit (ExitFailure 1)

129 Just db -> return db

153 Just db -> return db

130

154

155+writePackageSet :: PackageConfig -> PackageSet -> IO ()

156+writePackageSet PackageConfig{ set } =

157+ let dbFile = ".psc-package" </> fromText set </> ".set" </> "packages.json"

158+ in writeTextFile dbFile . packageSetToJSON

159+

131installOrUpdate :: Text -> Text -> PackageInfo -> IO Turtle.FilePath

160installOrUpdate :: Text -> Text -> PackageInfo -> IO Turtle.FilePath

132installOrUpdate set pkgName PackageInfo{ repo, version } = do

161installOrUpdate set pkgName PackageInfo{ repo, version } = do

133 echo ("Updating " <> pkgName)

162 echo ("Updating " <> pkgName)

@@ -233,6 +262,84 @@ exec exeName = do

233 (map pathToTextUnsafe ("src" </> "**" </> "*.purs" : paths))

262 (map pathToTextUnsafe ("src" </> "**" </> "*.purs" : paths))

234 empty

263 empty

235

264

265+checkForUpdates :: Bool -> Bool -> IO ()

266+checkForUpdates applyMinorUpdates applyMajorUpdates = do

267+ pkg <- readPackageFile

268+ db <- readPackageSet pkg

269+

270+ echo ("Checking " <> pack (show (Map.size db)) <> " packages for updates.")

271+ echo "Warning: this could take some time!"

272+

273+ newDb <- Map.fromList <$> (for (Map.toList db) $ \(name, p@PackageInfo{ repo, version }) -> do

274+ echo ("Checking package " <> name)

275+ tagLines <- Turtle.fold (listRemoteTags repo) Foldl.list

276+ let tags = mapMaybe parseTag tagLines

277+ newVersion <- case parseVersion version of

278+ Just parts ->

279+ let applyMinor =

280+ case filter (isMinorReleaseFrom parts) tags of

281+ [] -> pure version

282+ minorReleases -> do

283+ echo ("New minor release available")

284+ case applyMinorUpdates of

285+ True -> do

286+ let latestMinorRelease = maximum minorReleases

287+ pure ("v" <> T.intercalate "." (map (pack . show) latestMinorRelease))

288+ False -> pure version

289+ applyMajor =

290+ case filter (isMajorReleaseFrom parts) tags of

291+ [] -> applyMinor

292+ newReleases -> do

293+ echo ("New major release available")

294+ case applyMajorUpdates of

295+ True -> do

296+ let latestRelease = maximum newReleases

297+ pure ("v" <> T.intercalate "." (map (pack . show) latestRelease))

298+ False -> applyMinor

299+ in applyMajor

300+ _ -> do

301+ echo "Unable to parse version string"

302+ pure version

303+ pure (name, p { version = newVersion }))

304+

305+ when (applyMinorUpdates || applyMajorUpdates)

306+ (writePackageSet pkg newDb)

307+ where

308+ parseTag :: Text -> Maybe [Int]

309+ parseTag line =

310+ case T.splitOn "\t" line of

311+ [_sha, ref] ->

312+ case T.stripPrefix "refs/tags/" ref of

313+ Just tag ->

314+ case parseVersion tag of

315+ Just parts -> pure parts

316+ _ -> Nothing

317+ _ -> Nothing

318+ _ -> Nothing

319+

320+ parseVersion :: Text -> Maybe [Int]

321+ parseVersion ref =

322+ case T.stripPrefix "v" ref of

323+ Just tag ->

324+ traverse parseDecimal (T.splitOn "." tag)

325+ _ -> Nothing

326+

327+ parseDecimal :: Text -> Maybe Int

328+ parseDecimal s =

329+ case TR.decimal s of

330+ Right (n, "") -> Just n

331+ _ -> Nothing

332+

333+ isMajorReleaseFrom :: [Int] -> [Int] -> Bool

334+ isMajorReleaseFrom (0 : xs) (0 : ys) = isMajorReleaseFrom xs ys

335+ isMajorReleaseFrom (x : _) (y : _) = y > x

336+ isMajorReleaseFrom _ _ = False

337+

338+ isMinorReleaseFrom :: [Int] -> [Int] -> Bool

339+ isMinorReleaseFrom (0 : xs) (0 : ys) = isMinorReleaseFrom xs ys

340+ isMinorReleaseFrom (x : xs) (y : ys) = y == x && ys > xs

341+ isMinorReleaseFrom _ _ = False

342+

236verifyPackageSet :: IO ()

343verifyPackageSet :: IO ()

237verifyPackageSet = do

344verifyPackageSet = do

238 pkg <- readPackageFile

345 pkg <- readPackageFile

@@ -292,6 +399,9 @@ main = do

292 , Opts.command "available"

399 , Opts.command "available"

293 (Opts.info (pure listPackages)

400 (Opts.info (pure listPackages)

294 (Opts.progDesc "List all packages available in the package set"))

401 (Opts.progDesc "List all packages available in the package set"))

402+ , Opts.command "updates"

403+ (Opts.info (checkForUpdates <$> apply <*> applyMajor)

404+ (Opts.progDesc "Check all packages in the package set for new releases"))

295 , Opts.command "verify-set"

405 , Opts.command "verify-set"

296 (Opts.info (pure verifyPackageSet)

406 (Opts.info (pure verifyPackageSet)

297 (Opts.progDesc "Verify that the packages in the package set build correctly"))

407 (Opts.progDesc "Verify that the packages in the package set build correctly"))

@@ -300,3 +410,11 @@ main = do

300 pkg = Opts.strArgument $

410 pkg = Opts.strArgument $

301 Opts.metavar "PACKAGE"

411 Opts.metavar "PACKAGE"

302 <> Opts.help "The name of the package to install"

412 <> Opts.help "The name of the package to install"

413+

414+ apply = Opts.switch $

415+ Opts.long "apply"

416+ <> Opts.help "Apply all minor package updates"

417+

418+ applyMajor = Opts.switch $

419+ Opts.long "apply-breaking"

420+ <> Opts.help "Apply all major package updates"

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

@@ -196,10 +196,9 @@ getVersionFromGitTag = do

196 where

197 trimWhitespace =

198 dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse

199− parseMay str =

199+ parseMay str = do

200+ digits <- stripPrefix "v" str

200− (str,) <$> D.parseVersion' (dropPrefix "v" str)

201+ (str,) <$> D.parseVersion' digits

201− dropPrefix prefix str =

202− fromMaybe str (stripPrefix prefix str)

203

202

204getBowerRepositoryInfo :: PackageMeta -> PrepareM (D.GithubUser, D.GithubRepo)

203getBowerRepositoryInfo :: PackageMeta -> PrepareM (D.GithubUser, D.GithubRepo)

205getBowerRepositoryInfo = either (userError . BadRepositoryField) return . tryExtract

204getBowerRepositoryInfo = either (userError . BadRepositoryField) return . tryExtract

src/Language/PureScript/Publish/ErrorsWarnings.hs+2−3

@@ -148,9 +148,8 @@ displayUserError e = case e of

148 , "version."

149 ])

150 , spacer

151− , para "Note: tagged versions must be in one of the following forms:"

151+ , para "Note: tagged versions must be in the form"

152− , indented (para "* v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")

152+ , indented (para "v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")

153− , indented (para "* {MAJOR}.{MINOR}.{PATCH} (example: \"1.6.2\")")

154 , spacer

153 , spacer

155 , para (concat

154 , para (concat

156 [ "If the version you are publishing is not yet tagged, you might "

155 [ "If the version you are publishing is not yet tagged, you might "