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:
parent
9cc7f662b3
commit
912a0175d4
3 changed files with 37 additions and 5 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue