Browse Source

ToJSON for SnapshotDiff

jsonDiff
Konstantin Zudov 6 years ago
parent
commit
62434f29c5
  1. 5
      Stackage/Database/Types.hs
  2. 24
      Stackage/Snapshot/Diff.hs
  3. 8
      Types.hs
  4. 1
      stackage-server.cabal

5
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

24
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

8
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 }

1
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

Loading…
Cancel
Save