| #{name}
- $case verChange
- $of This oldVersion
- | #{oldVersion}
+ $case change
+ $of This (Version old)
+ | #{old}
|
- $of That newVersion
+ $of That (Version new)
|
- | #{newVersion}
- $of These oldVersion newVersion
- | #{oldVersion}
- | #{newVersion}
+ | #{new}
+ $of These (Version old) (Version new)
+ | #{old}
+ | #{new}
|]
diff --git a/Handler/StackageHome.hs b/Handler/StackageHome.hs
index 7ee954d..b69ac41 100644
--- a/Handler/StackageHome.hs
+++ b/Handler/StackageHome.hs
@@ -7,7 +7,6 @@ module Handler.StackageHome
) where
import Import
-import qualified Data.HashMap.Strict as HashMap
import Data.These
import Data.Time (FormatTime)
import Stackage.Database
@@ -28,17 +27,19 @@ getStackageHomeR name = do
$(widgetFile "stackage-home")
where strip x = fromMaybe x (stripSuffix "." x)
-getStackageDiffR :: SnapName -> SnapName -> Handler Html
+getStackageDiffR :: SnapName -> SnapName -> Handler TypedContent
getStackageDiffR name1 name2 = do
Entity sid1 _ <- lookupSnapshot name1 >>= maybe notFound return
Entity sid2 _ <- lookupSnapshot name2 >>= maybe notFound return
(map (snapshotName . entityVal) -> snapNames) <- getSnapshots Nothing 0 0
let (ltsSnaps, nightlySnaps) = partition isLts $ reverse $ sort snapNames
snapDiff <- getSnapshotDiff sid1 sid2
- defaultLayout $ do
- setTitle $ "Compare " ++ toHtml (toPathPiece name1) ++ " with "
- ++ toHtml (toPathPiece name2)
- $(widgetFile "stackage-diff")
+ selectRep $ do
+ provideRep $ defaultLayout $ do
+ setTitle $ "Compare " ++ toHtml (toPathPiece name1) ++ " with "
+ ++ toHtml (toPathPiece name2)
+ $(widgetFile "stackage-diff")
+ provideRep $ pure $ toJSON $ WithSnapshotNames name1 name2 snapDiff
getStackageCabalConfigR :: SnapName -> Handler TypedContent
getStackageCabalConfigR name = do
diff --git a/Stackage/Database.hs b/Stackage/Database.hs
index ee721c0..094a990 100644
--- a/Stackage/Database.hs
+++ b/Stackage/Database.hs
@@ -10,8 +10,6 @@ module Stackage.Database
, newestNightly
, ltsMajorVersions
, snapshotBefore
- , nightlyBefore
- , ltsBefore
, lookupSnapshot
, snapshotTitle
, PackageListingInfo (..)
diff --git a/Stackage/Database/Types.hs b/Stackage/Database/Types.hs
index 9eb70eb..19a8f56 100644
--- a/Stackage/Database/Types.hs
+++ b/Stackage/Database/Types.hs
@@ -6,6 +6,7 @@ module Stackage.Database.Types
import ClassyPrelude.Conduit
import Web.PathPieces
+import Data.Aeson.Extra
import Data.Text.Read (decimal)
import Database.Persist
import Database.Persist.Sql
@@ -22,6 +23,9 @@ isNightly :: SnapName -> Bool
isNightly SNLts{} = False
isNightly SNNightly{} = True
+instance ToJSONKey SnapName where
+ toJSONKey = toPathPiece
+
instance PersistField SnapName where
toPersistValue = toPersistValue . toPathPiece
fromPersistValue v = do
@@ -45,3 +49,4 @@ instance PathPiece SnapName where
t3 <- stripPrefix "." t2
Right (y, "") <- Just $ decimal t3
return $ SNLts x y
+
diff --git a/Stackage/Snapshot/Diff.hs b/Stackage/Snapshot/Diff.hs
index f041df4..1180d1c 100644
--- a/Stackage/Snapshot/Diff.hs
+++ b/Stackage/Snapshot/Diff.hs
@@ -2,21 +2,39 @@
module Stackage.Snapshot.Diff
( getSnapshotDiff
, snapshotDiff
- , SnapshotDiff
+ , SnapshotDiff()
+ , toDiffList
, VersionChange(..)
+ , WithSnapshotNames(..)
) where
-import qualified Data.HashMap.Strict as HashMap
import Data.Align
+import Data.Aeson.Extra
+import qualified Data.HashMap.Strict as HashMap
import Control.Arrow
import ClassyPrelude
import Data.These
import Stackage.Database (SnapshotId, PackageListingInfo(..),
GetStackageDatabase, getPackages)
-type PackageName = Text
-type Version = Text
+import Stackage.Database.Types (SnapName)
+import Types
+import Web.PathPieces
-type SnapshotDiff = HashMap PackageName VersionChange
+data WithSnapshotNames a
+ = WithSnapshotNames SnapName SnapName a
+
+newtype SnapshotDiff
+ = SnapshotDiff { unSnapshotDiff :: HashMap PackageName VersionChange }
+ deriving (Show, Eq, Generic, Typeable)
+
+instance ToJSON (WithSnapshotNames SnapshotDiff) where
+ toJSON (WithSnapshotNames nameA nameB (SnapshotDiff diff)) =
+ object [ "comparing" .= [toPathPiece nameA, toPathPiece nameB]
+ , "diff" .= Object (toJSONMap (WithSnapshotNames nameA nameB <$> diff))
+ ]
+
+toDiffList :: SnapshotDiff -> [(PackageName, VersionChange)]
+toDiffList = sortOn (toCaseFold . unPackageName . fst) . HashMap.toList . unSnapshotDiff
-- | Versions of a package as it occurs in the listings provided to `snapshotDiff`.
--
@@ -24,6 +42,14 @@ type SnapshotDiff = HashMap PackageName VersionChange
-- otherwise it would be `This v1` if the package is present only in the first listing,
-- or `That v2` if only in the second.
newtype VersionChange = VersionChange { unVersionChange :: These Version Version }
+ deriving (Show, Eq, Generic, Typeable)
+
+instance ToJSON (WithSnapshotNames VersionChange) where
+ toJSON (WithSnapshotNames (toJSONKey -> aKey) (toJSONKey -> bKey) change) =
+ case change of
+ VersionChange (This a) -> object [ aKey .= a ]
+ VersionChange (That b) -> object [ bKey .= b ]
+ VersionChange (These a b) -> object [ aKey .= a, bKey .= b ]
changed :: VersionChange -> Bool
changed = these (const True) (const True) (/=) . unVersionChange
@@ -32,6 +58,8 @@ getSnapshotDiff :: GetStackageDatabase m => SnapshotId -> SnapshotId -> m Snapsh
getSnapshotDiff a b = snapshotDiff <$> getPackages a <*> getPackages b
snapshotDiff :: [PackageListingInfo] -> [PackageListingInfo] -> SnapshotDiff
-snapshotDiff as bs = HashMap.filter changed $ alignWith VersionChange (toMap as) (toMap bs)
+snapshotDiff as bs =
+ SnapshotDiff $ HashMap.filter changed
+ $ alignWith VersionChange (toMap as) (toMap bs)
where
- toMap = HashMap.fromList . map (pliName &&& pliVersion)
+ toMap = HashMap.fromList . map (PackageName . pliName &&& Version . pliVersion)
diff --git a/Types.hs b/Types.hs
index d4e97d2..f0481d1 100644
--- a/Types.hs
+++ b/Types.hs
@@ -1,7 +1,7 @@
module Types where
import ClassyPrelude.Yesod
-import Data.Aeson
+import Data.Aeson.Extra
import Data.Hashable (hashUsing)
import Text.Blaze (ToMarkup)
import Database.Persist.Sql (PersistFieldSql (sqlType))
@@ -29,10 +29,16 @@ instance PathPiece SnapshotBranch where
newtype PackageName = PackageName { unPackageName :: Text }
deriving (Show, Read, Typeable, Eq, Ord, Hashable, PathPiece, ToMarkup, PersistField, IsString)
+instance ToJSON PackageName where
+ toJSON = toJSON . unPackageName
+instance ToJSONKey PackageName where
+ toJSONKey = unPackageName
instance PersistFieldSql PackageName where
sqlType = sqlType . liftM unPackageName
newtype Version = Version { unVersion :: Text }
deriving (Show, Read, Typeable, Eq, Ord, Hashable, PathPiece, ToMarkup, PersistField)
+instance ToJSON Version where
+ toJSON = toJSON . unVersion
instance PersistFieldSql Version where
sqlType = sqlType . liftM unVersion
newtype PackageSetIdent = PackageSetIdent { unPackageSetIdent :: Text }
diff --git a/stackage-server.cabal b/stackage-server.cabal
index 7d91335..247e67c 100644
--- a/stackage-server.cabal
+++ b/stackage-server.cabal
@@ -91,6 +91,7 @@ library
build-depends:
base >= 4.8 && < 4.9
, aeson >= 0.8 && < 0.9
+ , aeson-extra >= 0.2 && < 0.3
, aws >= 0.12 && < 0.13
, barrier >= 0.1 && < 0.2
, base16-bytestring >= 0.1 && < 0.2
diff --git a/templates/stackage-diff.hamlet b/templates/stackage-diff.hamlet
index 8197d95..d2b90b6 100644
--- a/templates/stackage-diff.hamlet
+++ b/templates/stackage-diff.hamlet
@@ -33,15 +33,15 @@
$else
|