From 5c960601aaff0d02223efbb52aad8b134bf24a73 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 11 Jun 2015 16:25:37 -0400
Subject: [PATCH] 4 ns optimisation of repeated calls to hasDifference on the
 same Differences

I want this as fast as possible, so it can be added to code paths without
slowing them down.

Avoid the set lookup, and rely on laziness,
drops runtime from 14.37 ns to 11.03 ns according to this criterion benchmark:

import Criterion.Main
import qualified Types.Difference as New
import qualified Types.DifferenceOld as Old

main :: IO ()
main = defaultMain
	[ bgroup "hasDifference"
		[ bench "new" $ whnf (New.hasDifference New.OneLevelObjectHash) new
		, bench "old" $ whnf (Old.hasDifference Old.OneLevelObjectHash) old
		]
	]
  where
	s = "fromList [ObjectHashLower, OneLevelObjectHash, OneLevelBranchHash]"
	new = New.readDifferences s
	old = Old.readDifferences s

A little bit of added boilerplate, but I suppose it's worth it to not
need to worry about set lookup overhead. Note that adding more differences
would slow down the old implementation; the new implementation will run
the same speed.
---
 Logs/Difference.hs  |  4 +--
 Types/Difference.hs | 60 ++++++++++++++++++++++++++++++++++++---------
 Utility/URI.hs      |  8 ------
 3 files changed, 50 insertions(+), 22 deletions(-)

diff --git a/Logs/Difference.hs b/Logs/Difference.hs
index 8d37a09c40..fd93fc3cfa 100644
--- a/Logs/Difference.hs
+++ b/Logs/Difference.hs
@@ -23,10 +23,10 @@ import Logs.UUIDBased
 import Logs.Difference.Pure
 
 recordDifferences :: Differences -> UUID -> Annex ()
-recordDifferences (Differences differences) uuid = do
+recordDifferences ds@(Differences {}) uuid = do
 	ts <- liftIO getPOSIXTime
 	Annex.Branch.change differenceLog $
-		showLog id . changeLog ts uuid (show differences) . parseLog Just
+		showLog id . changeLog ts uuid (showDifferences ds) . parseLog Just
 recordDifferences UnknownDifferences _ = return ()
 
 -- Map of UUIDs that have Differences recorded.
diff --git a/Types/Difference.hs b/Types/Difference.hs
index 1bab3fe36d..4abc75c447 100644
--- a/Types/Difference.hs
+++ b/Types/Difference.hs
@@ -9,6 +9,7 @@ module Types.Difference (
 	Difference(..),
 	Differences(..),
 	readDifferences,
+	showDifferences,
 	getDifferences,
 	differenceConfigKey,
 	differenceConfigVal,
@@ -20,10 +21,10 @@ import Utility.PartialPrelude
 import qualified Git
 import qualified Git.Config
 
-import qualified Data.Set as S
 import Data.Maybe
 import Data.Monoid
 import Prelude
+import qualified Data.Set as S
 
 -- Describes differences from the v5 repository format.
 --
@@ -31,7 +32,7 @@ import Prelude
 -- would break compatability.
 --
 -- Not breaking compatability is why a list of Differences is used, rather
--- than a sum type. With a sum type, adding a new field for some future
+-- than a record type. With a record type, adding a new field for some future
 -- difference would serialize to a value that an older version could not
 -- parse, even if that new field was not used. With the Differences list,
 -- old versions can still parse it, unless the new Difference constructor 
@@ -44,26 +45,45 @@ data Difference
 	= ObjectHashLower
 	| OneLevelObjectHash
 	| OneLevelBranchHash
-	deriving (Show, Read, Ord, Eq, Enum, Bounded)
+	deriving (Show, Read, Eq, Ord, Enum, Bounded)
 
+-- This type is used internally for efficient checking for differences,
+-- but converted to S.Set Difference for serialization.
 data Differences
-	= Differences (S.Set Difference)
+	= Differences
+		{ objectHashLower :: Bool
+		, oneLevelObjectHash :: Bool
+		, oneLevelBranchHash :: Bool
+		}
 	| UnknownDifferences
 
+-- UnknownDifferences cannot be equal
 instance Eq Differences where
-	Differences a == Differences b = a == b
-	_ == _ = False -- UnknownDifferences cannot be equal
+	UnknownDifferences == _ = False
+	_ == UnknownDifferences = False
+	a == b = all (\f -> f a == f b)
+		[ objectHashLower
+		, oneLevelObjectHash
+		, oneLevelBranchHash
+		]
 
 instance Monoid Differences where
-	mempty = Differences S.empty
-	mappend (Differences a) (Differences b) = Differences (S.union a b)
+	mempty = Differences False False False
+	mappend a@(Differences {}) b@(Differences {}) = a
+		{ objectHashLower = objectHashLower a || objectHashLower b
+		, oneLevelObjectHash = oneLevelObjectHash a || oneLevelObjectHash b
+		, oneLevelBranchHash = oneLevelBranchHash a || oneLevelBranchHash b
+		}
 	mappend _ _ = UnknownDifferences
 
 readDifferences :: String -> Differences
-readDifferences = maybe UnknownDifferences Differences . readish
+readDifferences = maybe UnknownDifferences mkDifferences . readish
+
+showDifferences :: Differences -> String
+showDifferences = show . S.fromList . listDifferences
 
 getDifferences :: Git.Repo -> Differences
-getDifferences r = Differences $ S.fromList $
+getDifferences r = mkDifferences $ S.fromList $
 	mapMaybe getmaybe [minBound .. maxBound]
   where
 	getmaybe d = case Git.Config.isTrue =<< Git.Config.getMaybe (differenceConfigKey d) r of
@@ -82,9 +102,25 @@ tunable :: String -> String
 tunable k = "annex.tune." ++ k
 
 hasDifference :: Difference -> Differences -> Bool
-hasDifference d (Differences s) = S.member d s
 hasDifference _ UnknownDifferences = False
+hasDifference ObjectHashLower ds = objectHashLower ds
+hasDifference OneLevelObjectHash ds = oneLevelObjectHash ds
+hasDifference OneLevelBranchHash ds = oneLevelBranchHash ds
 
 listDifferences :: Differences -> [Difference]
-listDifferences (Differences s) = S.toList s
+listDifferences d@(Differences {}) = map snd $
+	filter (\(f, _) -> f d)
+		[ (objectHashLower, ObjectHashLower)
+		, (oneLevelObjectHash, OneLevelObjectHash)
+		, (oneLevelBranchHash, OneLevelBranchHash)
+		]
 listDifferences UnknownDifferences = []
+
+mkDifferences :: S.Set Difference -> Differences
+mkDifferences s = Differences
+	{ objectHashLower = check ObjectHashLower
+	, oneLevelObjectHash = check OneLevelObjectHash
+	, oneLevelBranchHash = check OneLevelBranchHash
+	}
+  where
+	check f = f `S.member` s
diff --git a/Utility/URI.hs b/Utility/URI.hs
index e68fda58da..1e2129a479 100644
--- a/Utility/URI.hs
+++ b/Utility/URI.hs
@@ -8,11 +8,3 @@
 {-# LANGUAGE CPP #-}
 
 module Utility.URI where
-
--- Old versions of network lacked an Ord for URI
-#if ! MIN_VERSION_network(2,4,0)
-import Network.URI
-
-instance Ord URI where
-	a `compare` b = show a `compare` show b
-#endif