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 eec4db2..1180d1c 100644 --- a/Stackage/Snapshot/Diff.hs +++ b/Stackage/Snapshot/Diff.hs @@ -5,19 +5,33 @@ module Stackage.Snapshot.Diff , 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) +import Stackage.Database.Types (SnapName) import Types +import Web.PathPieces + +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 @@ -28,6 +42,14 @@ toDiffList = sortOn (toCaseFold . unPackageName . fst) . HashMap.toList . unSnap -- 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 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