Merge pull request #152 from fpco/snapshot-json

Provide snapshot content as JSON

Handler/StackageHome.hs

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

Stackage/Database.hs

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

Stackage/Database/Types.hs

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