diff --git a/Stackage/Database.hs b/Stackage/Database.hs index 5604dff..2f25d76 100644 --- a/Stackage/Database.hs +++ b/Stackage/Database.hs @@ -2,6 +2,7 @@ module Stackage.Database ( StackageDatabase , GetStackageDatabase (..) , SnapName (..) + , SnapshotId () , Snapshot (..) , newestLTS , newestLTSMajor diff --git a/Stackage/Snapshot/Diff.hs b/Stackage/Snapshot/Diff.hs new file mode 100644 index 0000000..95224fd --- /dev/null +++ b/Stackage/Snapshot/Diff.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE PartialTypeSignatures #-} +module Stackage.Snapshot.Diff + ( getSnapshotDiff + , snapshotDiff + , SnapshotDiff + , PackageName + , Version + , VersionChange(..) + ) where + +import qualified Data.HashMap.Strict as HashMap +import Data.Align +import Control.Arrow +import ClassyPrelude +import Data.These +import Stackage.Database (SnapshotId, PackageListingInfo(..), + GetStackageDatabase, getPackages) +type PackageName = Text +type Version = Text + +type SnapshotDiff = HashMap PackageName VersionChange + +newtype VersionChange = VersionChange { unVersionChange :: These Version Version } + +changed :: VersionChange -> Bool +changed = these (const True) (const True) (/=) . unVersionChange + +getSnapshotDiff :: GetStackageDatabase m => SnapshotId -> SnapshotId -> m SnapshotDiff +getSnapshotDiff a b = snapshotDiff <$> getPackages a <*> getPackages b + +snapshotDiff :: [PackageListingInfo] -> [PackageListingInfo] -> SnapshotDiff +snapshotDiff as bs = HashMap.filter changed $ alignWith VersionChange (toMap as) (toMap bs) + where + toMap = HashMap.fromList . map (pliName &&& pliVersion) diff --git a/stack.yaml b/stack.yaml index ecdbb12..6bf90a2 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1 +1,3 @@ resolver: lts-3.8 +extra-deps: + - these-0.6.1.0 diff --git a/stackage-server.cabal b/stackage-server.cabal index d110a26..ead55a7 100644 --- a/stackage-server.cabal +++ b/stackage-server.cabal @@ -31,6 +31,7 @@ library Stackage.Database.Haddock Stackage.Database.Types Stackage.Database.Cron + Stackage.Snapshot.Diff Handler.Home Handler.Snapshots @@ -93,6 +94,7 @@ library , blaze-markup >= 0.7 && < 0.8 , byteable >= 0.1 && < 0.2 , bytestring >= 0.10 && < 0.11 + , classy-prelude >= 0.12 && < 0.13 , classy-prelude-yesod >= 0.12 && < 0.13 , conduit >= 1.2 && < 1.3 , conduit-extra >= 1.1 && < 1.2 @@ -123,6 +125,7 @@ library , template-haskell >= 2.10 && < 2.11 , temporary-rc >= 1.2 && < 1.3 , text >= 1.2 && < 1.3 + , these >= 0.6 && < 0.7 , wai >= 3.0 && < 3.1 , wai-extra >= 3.0 && < 3.1 , wai-logger >= 2.2 && < 2.3