6ab89de · rowtype-yoga/purescript-native

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

Add the compiler version to psc-publish output

For pursuit: to determine whether a given JSON-serialized package was produced by a sufficiently recent compiler, so that it can fail gracefully if necessary. We also modify the parsers to accept an extra argument which is the minimum allowable version. The FromJSON instance sets the minimum allowable version to 0.0.0.0 (that is, it never fails with a CompilerTooOld error).

commit6ab89dea2aea1b5f90ad5815e2f098a136fcf04f authorHarry Garrood <harry@garrood.me> dateTue 7 Jul 2015, 01:33 (11 years ago) parent190b129

2 files changed+54−25

compare with golang

unifiedsplit

psc-publish/Main.hs+2 src/Language/PureScript/Docs/Types.hs+52−25

psc-publish/Main.hs+2

@@ -38,6 +38,7 @@ import Web.Bower.PackageMeta (PackageMeta(..), BowerError(..), PackageName,

3838 runPackageName, parsePackageName, Repository(..))

3939import qualified Web.Bower.PackageMeta as Bower

4040

41+import qualified Language.PureScript as P (version)

4142import qualified Language.PureScript.Docs as D

4243import Utils

4344import ErrorsWarnings

@@ -107,6 +108,7 @@ preparePackage' = do

107108 pkgResolvedDependencies <- getResolvedDependencies declaredDeps

108109

109110 let pkgUploader = D.NotYetKnown

111+ let pkgCompilerVersion = P.version

110112

111113 return D.Package{..}

112114

src/Language/PureScript/Docs/Types.hs+52−25

@@ -10,7 +10,8 @@ module Language.PureScript.Docs.Types

1010 where

1111

1212import Control.Arrow (first, (***))

13−import Control.Applicative ((<$>), (<*>))

13+import Control.Applicative ((<$>), (<*>), pure)

14+import Control.Monad (when)

1415import Data.Functor ((<$))

1516import Data.Maybe (mapMaybe)

1617import Data.Version

@@ -22,7 +23,7 @@ import Data.Text (Text)

2223import Data.ByteString.Lazy (ByteString)

2324import qualified Data.Text as T

2425

25−import Web.Bower.PackageMeta hiding (Version)

26+import Web.Bower.PackageMeta hiding (Version, displayError)

2627

2728import qualified Language.PureScript as P

2829

@@ -43,6 +44,9 @@ data Package a = Package

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

4445 , pkgGithub :: (GithubUser, GithubRepo)

4546 , pkgUploader :: a

47+ , pkgCompilerVersion :: Version

48+ -- ^ The version of the PureScript compiler which was used to generate

49+ -- this data. We store this in order to reject packages which are too old.

4650 }

4751 deriving (Show, Eq, Ord)

4852

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

6266 pkgResolvedDependencies

6367 pkgGithub

6468 verifiedUser

69+ pkgCompilerVersion

6570

6671packageName :: Package a -> PackageName

6772packageName = bowerName . pkgMeta

@@ -170,7 +175,10 @@ newtype GithubRepo

170175 deriving (Show, Eq, Ord)

171176

172177data PackageError

173− = ErrorInPackageMeta BowerError

178+ = CompilerTooOld Version Version

179+ -- ^ Minimum allowable version for generating data with the current

180+ -- parser, and actual version used.

181+ | ErrorInPackageMeta BowerError

174182 | InvalidVersion

175183 | InvalidDeclarationType String

176184 | InvalidChildDeclarationType String

@@ -204,14 +212,21 @@ ignorePackage (FromDep _ x) = x

204212----------------------

205213-- Parsing

206214

207−parseUploadedPackage :: ByteString -> Either (ParseError PackageError) UploadedPackage

208−parseUploadedPackage = parse asUploadedPackage

215+parseUploadedPackage :: Version -> ByteString -> Either (ParseError PackageError) UploadedPackage

216+parseUploadedPackage minVersion = parse $ asUploadedPackage minVersion

209217

210−parseVerifiedPackage :: ByteString -> Either (ParseError PackageError) VerifiedPackage

211−parseVerifiedPackage = parse asVerifiedPackage

218+parseVerifiedPackage :: Version -> ByteString -> Either (ParseError PackageError) VerifiedPackage

219+parseVerifiedPackage minVersion = parse $ asVerifiedPackage minVersion

220+

221+asPackage :: Version -> (forall e. Parse e a) -> Parse PackageError (Package a)

222+asPackage minimumVersion uploader = do

223+ -- If the compilerVersion key is missing, we can be sure that it was produced

224+ -- with 0.7.0.0, since that is the only released version that included the

225+ -- psc-publish tool before this key was added.

226+ compilerVersion <- keyOrDefault "compilerVersion" (Version [0,7,0,0] []) asVersion

227+ when (compilerVersion < minimumVersion)

228+ (throwCustomError $ CompilerTooOld minimumVersion compilerVersion)

212229

213−asPackage :: (forall e. Parse e a) -> Parse PackageError (Package a)

214−asPackage uploader =

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

216231 <*> key "version" asVersion

217232 <*> key "versionTag" asString

@@ -220,9 +235,10 @@ asPackage uploader =

220235 <*> key "resolvedDependencies" asResolvedDependencies

221236 <*> key "github" asGithub

222237 <*> key "uploader" uploader

238+ <*> pure compilerVersion

223239

224−asUploadedPackage :: Parse PackageError UploadedPackage

225−asUploadedPackage = asPackage asNotYetKnown

240+asUploadedPackage :: Version -> Parse PackageError UploadedPackage

241+asUploadedPackage minVersion = asPackage minVersion asNotYetKnown

226242

227243asNotYetKnown :: Parse e NotYetKnown

228244asNotYetKnown = NotYetKnown <$ asNull

@@ -230,32 +246,42 @@ asNotYetKnown = NotYetKnown <$ asNull

230246instance A.FromJSON NotYetKnown where

231247 parseJSON = toAesonParser' asNotYetKnown

232248

233−asVerifiedPackage :: Parse PackageError VerifiedPackage

234−asVerifiedPackage = asPackage asGithubUser

249+asVerifiedPackage :: Version -> Parse PackageError VerifiedPackage

250+asVerifiedPackage minVersion = asPackage minVersion asGithubUser

235251

236252displayPackageError :: PackageError -> Text

237253displayPackageError e = case e of

238− ErrorInPackageMeta err -> "Error in package metadata: " <> showBowerError err

239− InvalidVersion -> "Invalid version"

240− InvalidDeclarationType str -> "Invalid declaration type: \"" <> T.pack str <> "\""

241− InvalidChildDeclarationType str -> "Invalid child declaration type: \"" <> T.pack str <> "\""

242− InvalidFixity -> "Invalid fixity"

243− InvalidKind str -> "Invalid kind: \"" <> T.pack str <> "\""

244− InvalidDataDeclType str -> "Invalid data declaration type: \"" <> T.pack str <> "\""

254+ CompilerTooOld minV usedV ->

255+ "Expecting data produced by at least version " <> T.pack (showVersion minV)

256+ <> " of the compiler, but it appears that " <> T.pack (showVersion usedV)

257+ <> " was used."

258+ ErrorInPackageMeta err ->

259+ "Error in package metadata: " <> showBowerError err

260+ InvalidVersion ->

261+ "Invalid version"

262+ InvalidDeclarationType str ->

263+ "Invalid declaration type: \"" <> T.pack str <> "\""

264+ InvalidChildDeclarationType str ->

265+ "Invalid child declaration type: \"" <> T.pack str <> "\""

266+ InvalidFixity ->

267+ "Invalid fixity"

268+ InvalidKind str ->

269+ "Invalid kind: \"" <> T.pack str <> "\""

270+ InvalidDataDeclType str ->

271+ "Invalid data declaration type: \"" <> T.pack str <> "\""

245272 where

246273 (<>) = T.append

247274

275+instance A.FromJSON a => A.FromJSON (Package a) where

276+ parseJSON = toAesonParser displayPackageError

277+ (asPackage (Version [0,0,0,0] []) fromAesonParser)

278+

248279asGithubUser :: Parse e GithubUser

249280asGithubUser = GithubUser <$> asString

250281

251282instance A.FromJSON GithubUser where

252283 parseJSON = toAesonParser' asGithubUser

253284

254−instance A.FromJSON a => A.FromJSON (Package a) where

255− -- TODO: actual error display

256− parseJSON = toAesonParser (T.pack . show)

257− (asPackage fromAesonParser)

258−

259285asVersion :: Parse PackageError Version

260286asVersion = withString (maybe (Left InvalidVersion) Right . parseVersion')

261287

@@ -408,6 +434,7 @@ instance A.ToJSON a => A.ToJSON (Package a) where

408434 pkgResolvedDependencies

409435 , "github" .= pkgGithub

410436 , "uploader" .= pkgUploader

437+ , "compilerVersion" .= showVersion P.version

411438 ]

412439

413440instance A.ToJSON NotYetKnown where