mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

Fix build with ghc 8.4+, which broke due to the Semigroup Monoid change

Browse source 
https://prime.haskell.org/wiki/Libraries/Proposals/SemigroupMonoid

I am not happy with the fragile pile of CPP boilerplate required to support
ghc back to 7.0, which git-annex still targets for both the android build
and the standalone build targeting old linux kernels. It makes me unlikely
to want to use Semigroup more in git-annex, because the benefit of the
abstraction is swamped by the ugliness. I actually considered ripping out
all the Semigroup instances, but some are needed to use
optparse-applicative.

The problem, I think, is they made this transaction on too fast a timeline.
(Although ironically, work on it started in 2015 or earlier!)
In particular, Debian oldstable is not out of security support, and it's
not possible to follow the simpler workarounds documented on the wiki and
have it build on oldstable (because the semigroups package in it is too
old).

I have only tested this build with ghc 8.2.2, not the newer and older
versions that branches of the CPP support. So there could be typoes, we'll
see.

This commit was sponsored by Brock Spratlen on Patreon.
This commit is contained in:
Joey Hess 2018-05-30 12:28:43 -04:00
parent 519c693030
commit 1c8ee99b46
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
7 changed files with 128 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

34
Git/Fsck.hs
View file

@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BangPatterns, CPP #-}
module Git.Fsck (
FsckResults(..),
@ -26,6 +26,10 @@ import qualified Git.Version
import qualified Data.Set as S
import Control.Concurrent.Async
#if MIN_VERSION_base(4,9,0)
import qualified Data.Semigroup as Sem
#endif
import Prelude
data FsckResults
= FsckFoundMissing
@ -44,15 +48,29 @@ type MissingObjects = S.Set Sha
type Truncated = Bool
appendFsckOutput :: FsckOutput -> FsckOutput -> FsckOutput
appendFsckOutput (FsckOutput s1 t1) (FsckOutput s2 t2) =
FsckOutput (S.union s1 s2) (t1 || t2)
appendFsckOutput (FsckOutput s t) _ = FsckOutput s t
appendFsckOutput _ (FsckOutput s t) = FsckOutput s t
appendFsckOutput NoFsckOutput NoFsckOutput = NoFsckOutput
appendFsckOutput AllDuplicateEntriesWarning AllDuplicateEntriesWarning = AllDuplicateEntriesWarning
appendFsckOutput AllDuplicateEntriesWarning NoFsckOutput = AllDuplicateEntriesWarning
appendFsckOutput NoFsckOutput AllDuplicateEntriesWarning = AllDuplicateEntriesWarning
#if MIN_VERSION_base(4,9,0)
instance Sem.Semigroup FsckOutput where
(<>) = appendFsckOutput
#endif
instance Monoid FsckOutput where
mempty = NoFsckOutput
mappend (FsckOutput s1 t1) (FsckOutput s2 t2) = FsckOutput (S.union s1 s2) (t1 || t2)
mappend (FsckOutput s t) _ = FsckOutput s t
mappend _ (FsckOutput s t) = FsckOutput s t
mappend NoFsckOutput NoFsckOutput = NoFsckOutput
mappend AllDuplicateEntriesWarning AllDuplicateEntriesWarning = AllDuplicateEntriesWarning
mappend AllDuplicateEntriesWarning NoFsckOutput = AllDuplicateEntriesWarning
mappend NoFsckOutput AllDuplicateEntriesWarning = AllDuplicateEntriesWarning
#if MIN_VERSION_base(4,11,0)
#elif MIN_VERSION_base(4,9,0)
mappend = (Sem.<>)
#else
mappend = appendFsckOutput
#endif
{- Runs fsck to find some of the broken objects in the repository.
- May not find all broken objects, if fsck fails on bad data in some of