ToJSON for SnapshotDiff
This commit is contained in:
parent
1e1e875bd0
commit
62434f29c5
4 changed files with 36 additions and 2 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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
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 }
|
||||
|
|
|
@ -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…
Reference in a new issue