Refactor snapshot diffs

- do not leak the HashMap out
- use existing types (Version, PackageName)
This commit is contained in:
Konstantin Zudov 2015-10-17 11:49:28 +03:00
parent 49828b012f
commit 1e1e875bd0
4 changed files with 26 additions and 22 deletions

View File

@ -5,9 +5,8 @@ module Handler.Feed
import Import import Import
import Stackage.Database import Stackage.Database
import Data.These import Data.These
import Stackage.Snapshot.Diff import Stackage.Snapshot.Diff
import qualified Data.HashMap.Strict as HashMap
import Text.Blaze (text) import Text.Blaze (text)
getFeedR :: Handler TypedContent getFeedR :: Handler TypedContent
@ -67,17 +66,17 @@ getContent sid2 snap = do
<th align=right>Old <th align=right>Old
<th align=left>New <th align=left>New
<tbody> <tbody>
$forall (name, VersionChange verChange) <- sortOn (toCaseFold . fst) $ HashMap.toList snapDiff $forall (PackageName name, VersionChange change) <- toDiffList snapDiff
<tr> <tr>
<th align=right>#{name} <th align=right>#{name}
$case verChange $case change
$of This oldVersion $of This (Version old)
<td align=right>#{oldVersion} <td align=right>#{old}
<td> <td>
$of That newVersion $of That (Version new)
<td align=right> <td align=right>
<td>#{newVersion} <td>#{new}
$of These oldVersion newVersion $of These (Version old) (Version new)
<td align=right>#{oldVersion} <td align=right>#{old}
<td>#{newVersion} <td>#{new}
|] |]

View File

@ -7,7 +7,6 @@ module Handler.StackageHome
) where ) where
import Import import Import
import qualified Data.HashMap.Strict as HashMap
import Data.These import Data.These
import Data.Time (FormatTime) import Data.Time (FormatTime)
import Stackage.Database import Stackage.Database

View File

@ -2,7 +2,8 @@
module Stackage.Snapshot.Diff module Stackage.Snapshot.Diff
( getSnapshotDiff ( getSnapshotDiff
, snapshotDiff , snapshotDiff
, SnapshotDiff , SnapshotDiff()
, toDiffList
, VersionChange(..) , VersionChange(..)
) where ) where
@ -13,10 +14,13 @@ import ClassyPrelude
import Data.These import Data.These
import Stackage.Database (SnapshotId, PackageListingInfo(..), import Stackage.Database (SnapshotId, PackageListingInfo(..),
GetStackageDatabase, getPackages) GetStackageDatabase, getPackages)
type PackageName = Text import Types
type Version = Text
type SnapshotDiff = HashMap PackageName VersionChange newtype SnapshotDiff
= SnapshotDiff { unSnapshotDiff :: HashMap PackageName VersionChange }
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`. -- | Versions of a package as it occurs in the listings provided to `snapshotDiff`.
-- --
@ -32,6 +36,8 @@ getSnapshotDiff :: GetStackageDatabase m => SnapshotId -> SnapshotId -> m Snapsh
getSnapshotDiff a b = snapshotDiff <$> getPackages a <*> getPackages b getSnapshotDiff a b = snapshotDiff <$> getPackages a <*> getPackages b
snapshotDiff :: [PackageListingInfo] -> [PackageListingInfo] -> SnapshotDiff 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 where
toMap = HashMap.fromList . map (pliName &&& pliVersion) toMap = HashMap.fromList . map (PackageName . pliName &&& Version . pliVersion)

View File

@ -33,15 +33,15 @@
$else $else
<option value=@{StackageDiffR name1 name2'}>#{toPathPiece name2'} <option value=@{StackageDiffR name1 name2'}>#{toPathPiece name2'}
<tbody> <tbody>
$forall (name, VersionChange verChange) <- sortOn (toCaseFold . fst) $ HashMap.toList snapDiff $forall (PackageName name, VersionChange verChange) <- toDiffList snapDiff
<tr> <tr>
$case verChange $case verChange
$of This oldVersion $of This (Version oldVersion)
<td>#{name}-#{oldVersion} <td>#{name}-#{oldVersion}
<td> <td>
$of That newVersion $of That (Version newVersion)
<td> <td>
<td>#{name}-#{newVersion} <td>#{name}-#{newVersion}
$of These oldVersion newVersion $of These (Version oldVersion) (Version newVersion)
<td>#{name}-#{oldVersion} <td>#{name}-#{oldVersion}
<td>#{name}-#{newVersion} <td>#{name}-#{newVersion}