@@ -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