Provide snapshot content as JSON

```json
$ http --json http://localhost:4000/lts-5.1
{
  "snapshot": {
    "ghc": "7.10.3",
    "created": "2016-01-30",
    "name": "lts-5.1"
  },
  "packages": [
    {
      "isCore": false,
      "name": "abstract-deque",
      "version": "0.3",
      "synopsis": "Abstract, parameterized interface to mutable Deques."
    },
    {
      "isCore": false,
      "name": "abstract-par",
      "version": "0.3.3",
      "synopsis": "Type classes generalizing the functionality of the 'monad-par' library."
    },
    ...
  ]
}

```
This commit is contained in:
Konstantin Zudov 2016-02-02 03:08:49 +02:00
parent 9cc7f662b3
commit 912a0175d4
3 changed files with 37 additions and 5 deletions

View file

@ -13,7 +13,7 @@ import Stackage.Database
import Stackage.Database.Types (isLts)
import Stackage.Snapshot.Diff
getStackageHomeR :: SnapName -> Handler Html
getStackageHomeR :: SnapName -> Handler TypedContent
getStackageHomeR name = do
Entity sid snapshot <- lookupSnapshot name >>= maybe notFound return
previousSnapName <- fromMaybe name . map snd <$> snapshotBefore (snapshotName snapshot)
@ -22,12 +22,26 @@ getStackageHomeR name = do
exact = False
in $(widgetFile "hoogle-form")
packageCount <- getPackageCount sid
defaultLayout $ do
setTitle $ toHtml $ snapshotTitle snapshot
packages <- getPackages sid
$(widgetFile "stackage-home")
packages <- getPackages sid
selectRep $ do
provideRep $ do
defaultLayout $ do
setTitle $ toHtml $ snapshotTitle snapshot
$(widgetFile "stackage-home")
provideRep $ pure $ toJSON $ SnapshotInfo snapshot packages
where strip x = fromMaybe x (stripSuffix "." x)
data SnapshotInfo
= SnapshotInfo { snapshot :: Snapshot
, packages :: [PackageListingInfo]
}
instance ToJSON SnapshotInfo where
toJSON SnapshotInfo{..} = object [ "snapshot" .= snapshot
, "packages" .= packages
]
getStackageDiffR :: SnapName -> SnapName -> Handler TypedContent
getStackageDiffR name1 name2 = do
Entity sid1 _ <- lookupSnapshot name1 >>= maybe notFound return

View file

@ -129,6 +129,13 @@ Deprecated
UniqueDeprecated package
|]
instance A.ToJSON Snapshot where
toJSON Snapshot{..} =
A.object [ "name" A..= snapshotName
, "ghc" A..= snapshotGhc
, "created" A..= formatTime defaultTimeLocale "%F" snapshotCreated
]
_hideUnusedWarnings
:: ( SnapshotPackageId
, SchemaId
@ -490,6 +497,14 @@ data PackageListingInfo = PackageListingInfo
, pliIsCore :: !Bool
}
instance A.ToJSON PackageListingInfo where
toJSON PackageListingInfo{..} =
A.object [ "name" A..= pliName
, "version" A..= pliVersion
, "synopsis" A..= pliSynopsis
, "isCore" A..= pliIsCore
]
getPackages :: GetStackageDatabase m => SnapshotId -> m [PackageListingInfo]
getPackages sid = liftM (map toPLI) $ run $ do
E.select $ E.from $ \(p,sp) -> do

View file

@ -26,6 +26,9 @@ isNightly SNNightly{} = True
instance ToJSONKey SnapName where
toJSONKey = toPathPiece
instance ToJSON SnapName where
toJSON = String . toPathPiece
instance PersistField SnapName where
toPersistValue = toPersistValue . toPathPiece
fromPersistValue v = do