307b71d · rowtype-yoga/purescript-native

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

on golang help sign in

Merge pull request #2544 from purescript/include-tag-date

307b71dHarry Garrood10 years ago

src/Language/PureScript/Docs/Types.hs+44−5

compare with golang

unifiedsplit

@@ -10,17 +10,19 @@ import Control.Arrow (first, (***))

10import Control.Monad (when)

11import Control.Monad.Error.Class (catchError)

13−import Data.Monoid ((<>))

14import Data.Aeson ((.=))

13import Data.Aeson ((.=))

15import Data.Aeson.BetterErrors

14import Data.Aeson.BetterErrors

16import Data.ByteString.Lazy (ByteString)

15import Data.ByteString.Lazy (ByteString)

17import Data.Either (isLeft, isRight)

16import Data.Either (isLeft, isRight)

18−import Data.Maybe (mapMaybe, fromMaybe)

17+import Data.Maybe (mapMaybe, fromMaybe, maybeToList)

18+import Data.Monoid ((<>))

19import Data.Text (Text)

20+import Data.Time.Clock (UTCTime)

21+import qualified Data.Time.Format as TimeFormat

20import Data.Version

22import Data.Version

21−import qualified Data.Vector as V

22import qualified Data.Aeson as A

23import qualified Data.Aeson as A

23import qualified Data.Text as T

24import qualified Data.Text as T

25+import qualified Data.Vector as V

25import qualified Language.PureScript as P

27import qualified Language.PureScript as P

@@ -40,6 +42,10 @@ data Package a = Package

40 { pkgMeta :: PackageMeta

42 { pkgMeta :: PackageMeta

41 , pkgVersion :: Version

43 , pkgVersion :: Version

42 , pkgVersionTag :: Text

44 , pkgVersionTag :: Text

45+ -- TODO: When this field was introduced, it was given the Maybe type for the

46+ -- sake of backwards compatibility, as older JSON blobs will not include the

47+ -- field. It should eventually be changed to just UTCTime.

48+ , pkgTagTime :: Maybe UTCTime

43 , pkgModules :: [Module]

49 , pkgModules :: [Module]

44 , pkgBookmarks :: [Bookmark]

50 , pkgBookmarks :: [Bookmark]

45 , pkgResolvedDependencies :: [(PackageName, Version)]

51 , pkgResolvedDependencies :: [(PackageName, Version)]

@@ -62,6 +68,7 @@ verifyPackage verifiedUser Package{..} =

62 Package pkgMeta

68 Package pkgMeta

63 pkgVersion

69 pkgVersion

64 pkgVersionTag

70 pkgVersionTag

71+ pkgTagTime

65 pkgModules

72 pkgModules

66 pkgBookmarks

73 pkgBookmarks

67 pkgResolvedDependencies

74 pkgResolvedDependencies

@@ -72,6 +79,29 @@ verifyPackage verifiedUser Package{..} =

72packageName :: Package a -> PackageName

79packageName :: Package a -> PackageName

73packageName = bowerName . pkgMeta

80packageName = bowerName . pkgMeta

82+-- |

83+-- The time format used for serializing package tag times in the JSON format.

84+-- This is the ISO 8601 date format which includes a time and a timezone.

85+--

86+jsonTimeFormat :: String

87+jsonTimeFormat = "%Y-%m-%dT%H:%M:%S%z"

88+

89+-- |

90+-- Convenience function for formatting a time in the format expected by this

91+-- module.

92+--

93+formatTime :: UTCTime -> String

94+formatTime =

95+ TimeFormat.formatTime TimeFormat.defaultTimeLocale jsonTimeFormat

96+

97+-- |

98+-- Convenience function for parsing a time in the format expected by this

99+-- module.

100+--

101+parseTime :: String -> Maybe UTCTime

102+parseTime =

103+ TimeFormat.parseTimeM False TimeFormat.defaultTimeLocale jsonTimeFormat

104+

75data Module = Module

105data Module = Module

76 { modName :: P.ModuleName

106 { modName :: P.ModuleName

77 , modComments :: Maybe Text

107 , modComments :: Maybe Text

@@ -275,6 +305,7 @@ data PackageError

275 | InvalidFixity

305 | InvalidFixity

276 | InvalidKind Text

306 | InvalidKind Text

277 | InvalidDataDeclType Text

307 | InvalidDataDeclType Text

308+ | InvalidTime

278 deriving (Show, Eq, Ord)

309 deriving (Show, Eq, Ord)

279

310

280type Bookmark = InPackage (P.ModuleName, Text)

311type Bookmark = InPackage (P.ModuleName, Text)

@@ -320,6 +351,7 @@ asPackage minimumVersion uploader = do

320 Package <$> key "packageMeta" asPackageMeta .! ErrorInPackageMeta

351 Package <$> key "packageMeta" asPackageMeta .! ErrorInPackageMeta

321 <*> key "version" asVersion

352 <*> key "version" asVersion

322 <*> key "versionTag" asText

353 <*> key "versionTag" asText

354+ <*> keyMay "tagTime" (withString parseTimeEither)

323 <*> key "modules" (eachInArray asModule)

355 <*> key "modules" (eachInArray asModule)

324 <*> key "bookmarks" asBookmarks .! ErrorInPackageMeta

356 <*> key "bookmarks" asBookmarks .! ErrorInPackageMeta

325 <*> key "resolvedDependencies" asResolvedDependencies

357 <*> key "resolvedDependencies" asResolvedDependencies

@@ -327,6 +359,10 @@ asPackage minimumVersion uploader = do

327 <*> key "uploader" uploader

359 <*> key "uploader" uploader

328 <*> pure compilerVersion

360 <*> pure compilerVersion

329

361

362+parseTimeEither :: String -> Either PackageError UTCTime

363+parseTimeEither =

364+ maybe (Left InvalidTime) Right . parseTime

365+

330asUploadedPackage :: Version -> Parse PackageError UploadedPackage

366asUploadedPackage :: Version -> Parse PackageError UploadedPackage

331asUploadedPackage minVersion = asPackage minVersion asNotYetKnown

367asUploadedPackage minVersion = asPackage minVersion asNotYetKnown

332

368

@@ -359,6 +395,8 @@ displayPackageError e = case e of

359 "Invalid kind: \"" <> str <> "\""

395 "Invalid kind: \"" <> str <> "\""

360 InvalidDataDeclType str ->

396 InvalidDataDeclType str ->

361 "Invalid data declaration type: \"" <> str <> "\""

397 "Invalid data declaration type: \"" <> str <> "\""

398+ InvalidTime ->

399+ "Invalid time"

362

400

363instance A.FromJSON a => A.FromJSON (Package a) where

401instance A.FromJSON a => A.FromJSON (Package a) where

364 parseJSON = toAesonParser displayPackageError

402 parseJSON = toAesonParser displayPackageError

@@ -550,7 +588,7 @@ asSourceSpan = P.SourceSpan <$> key "name" asString

550

588

551instance A.ToJSON a => A.ToJSON (Package a) where

589instance A.ToJSON a => A.ToJSON (Package a) where

552 toJSON Package{..} =

590 toJSON Package{..} =

553− A.object

591+ A.object $

554 [ "packageMeta" .= pkgMeta

592 [ "packageMeta" .= pkgMeta

555 , "version" .= showVersion pkgVersion

593 , "version" .= showVersion pkgVersion

556 , "versionTag" .= pkgVersionTag

594 , "versionTag" .= pkgVersionTag

@@ -562,7 +600,8 @@ instance A.ToJSON a => A.ToJSON (Package a) where

562 , "github" .= pkgGithub

600 , "github" .= pkgGithub

563 , "uploader" .= pkgUploader

601 , "uploader" .= pkgUploader

564 , "compilerVersion" .= showVersion P.version

602 , "compilerVersion" .= showVersion P.version

565− ]

603+ ] ++

604+ fmap (\t -> "tagTime" .= formatTime t) (maybeToList pkgTagTime)

566

605

567instance A.ToJSON NotYetKnown where

606instance A.ToJSON NotYetKnown where

568 toJSON _ = A.Null

607 toJSON _ = A.Null

src/Language/PureScript/Publish.hs+13−2

@@ -39,12 +39,13 @@ import Data.List (stripPrefix, (\\), nubBy)

39import Data.List.NonEmpty (NonEmpty(..))

40import Data.List.Split (splitOn)

41import Data.Maybe

42−import Data.Version

43−import qualified Data.SPDX as SPDX

44import Data.Text (Text)

42import Data.Text (Text)

45import qualified Data.Text as T

43import qualified Data.Text as T

46import qualified Data.Text.Lazy as TL

44import qualified Data.Text.Lazy as TL

47import qualified Data.Text.Lazy.Encoding as TL

45import qualified Data.Text.Lazy.Encoding as TL

46+import Data.Time.Clock (UTCTime)

47+import Data.Version

48+import qualified Data.SPDX as SPDX

49import Safe (headMay)

50import Safe (headMay)

@@ -67,6 +68,7 @@ data PublishOptions = PublishOptions

67 { -- | How to obtain the version tag and version that the data being

68 { -- | How to obtain the version tag and version that the data being

68 -- generated will refer to.

69 -- generated will refer to.

69 publishGetVersion :: PrepareM (Text, Version)

70 publishGetVersion :: PrepareM (Text, Version)

71+ , publishGetTagTime :: Text -> PrepareM UTCTime

70 , -- | What to do when the working tree is dirty

72 , -- | What to do when the working tree is dirty

71 publishWorkingTreeDirty :: PrepareM ()

73 publishWorkingTreeDirty :: PrepareM ()

72 }

74 }

@@ -74,6 +76,7 @@ data PublishOptions = PublishOptions

74defaultPublishOptions :: PublishOptions

76defaultPublishOptions :: PublishOptions

75defaultPublishOptions = PublishOptions

77defaultPublishOptions = PublishOptions

76 { publishGetVersion = getVersionFromGitTag

78 { publishGetVersion = getVersionFromGitTag

79+ , publishGetTagTime = getTagTime

77 , publishWorkingTreeDirty = userError DirtyWorkingTree

80 , publishWorkingTreeDirty = userError DirtyWorkingTree

78 }

81 }

@@ -139,6 +142,7 @@ preparePackage' opts = do

139 checkLicense pkgMeta

142 checkLicense pkgMeta

140

143

141 (pkgVersionTag, pkgVersion) <- publishGetVersion opts

144 (pkgVersionTag, pkgVersion) <- publishGetVersion opts

145+ pkgTagTime <- Just <$> publishGetTagTime opts pkgVersionTag

142 pkgGithub <- getBowerRepositoryInfo pkgMeta

146 pkgGithub <- getBowerRepositoryInfo pkgMeta

143 (pkgBookmarks, pkgModules) <- getModulesAndBookmarks

147 (pkgBookmarks, pkgModules) <- getModulesAndBookmarks

144

148

@@ -200,6 +204,13 @@ getVersionFromGitTag = do

200 digits <- stripPrefix "v" str

204 digits <- stripPrefix "v" str

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

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

202

206

207+-- | Given a git tag, get the time it was created.

208+getTagTime :: Text -> PrepareM UTCTime

209+getTagTime tag = do

210+ out <- readProcess' "git" ["show", T.unpack tag, "--no-patch", "--format=%aI"] ""

211+ let time = headMay (lines out) >>= D.parseTime

212+ maybe (internalError (CouldntParseGitTagDate tag)) pure time

213+

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

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

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

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

205 where

216 where

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

@@ -73,6 +73,7 @@ data RepositoryFieldError

73-- | An error that probably indicates a bug in this module.

74data InternalError

75 = JSONError JSONSource (ParseError BowerError)

76+ | CouldntParseGitTagDate Text

76 deriving (Show)

77 deriving (Show)

78data JSONSource

79data JSONSource

@@ -289,6 +290,9 @@ displayInternalError e = case e of

289 [ "Error in JSON " ++ displayJSONSource src ++ ":"

290 [ "Error in JSON " ++ displayJSONSource src ++ ":"

290 , T.unpack (Bower.displayError r)

291 , T.unpack (Bower.displayError r)

291 ]

292 ]

293+ CouldntParseGitTagDate tag ->

294+ [ "Unable to parse the date for a git tag: " ++ T.unpack tag

295+ ]

292

296

293displayJSONSource :: JSONSource -> String

297displayJSONSource :: JSONSource -> String

294displayJSONSource s = case s of

298displayJSONSource s = case s of

tests/TestDocs.hs+7−4

@@ -9,14 +9,16 @@ import Prelude ()

9import Prelude.Compat

11import Control.Arrow (first)

12+import Control.Monad.IO.Class (liftIO)

13−import Data.Version (Version(..))

14−import Data.Monoid

15−import Data.Maybe (fromMaybe)

16−import Data.List ((\\))

17import Data.Foldable

14import Data.Foldable

15+import Data.List ((\\))

16+import Data.Maybe (fromMaybe)

17+import Data.Monoid

18import Data.Text (Text)

19import qualified Data.Text as T

20+import Data.Time.Clock (getCurrentTime)

21+import Data.Version (Version(..))

20import System.Exit

22import System.Exit

22import qualified Language.PureScript as P

24import qualified Language.PureScript as P

@@ -32,6 +34,7 @@ import TestUtils

32publishOpts :: Publish.PublishOptions

34publishOpts :: Publish.PublishOptions

33publishOpts = Publish.defaultPublishOptions

35publishOpts = Publish.defaultPublishOptions

34 { Publish.publishGetVersion = return testVersion

36 { Publish.publishGetVersion = return testVersion

37+ , Publish.publishGetTagTime = const (liftIO getCurrentTime)

35 , Publish.publishWorkingTreeDirty = return ()

38 , Publish.publishWorkingTreeDirty = return ()

36 }

39 }

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

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

tests/TestPscPublish.hs+3

@@ -4,8 +4,10 @@

5module TestPscPublish where

7+import Control.Monad.IO.Class (liftIO)

7import System.Exit (exitFailure)

8import System.Exit (exitFailure)

8import Data.ByteString.Lazy (ByteString)

9import Data.ByteString.Lazy (ByteString)

10+import Data.Time.Clock (getCurrentTime)

9import qualified Data.Aeson as A

11import qualified Data.Aeson as A

10import Data.Version

12import Data.Version

@@ -38,6 +40,7 @@ roundTrip pkg =

38testRunOptions :: PublishOptions

40testRunOptions :: PublishOptions

39testRunOptions = defaultPublishOptions

41testRunOptions = defaultPublishOptions

40 { publishGetVersion = return testVersion

42 { publishGetVersion = return testVersion

43+ , publishGetTagTime = const (liftIO getCurrentTime)

41 , publishWorkingTreeDirty = return ()

44 , publishWorkingTreeDirty = return ()

42 }

45 }

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

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