Use Prelude from base-compat for ghc 8.4 too.

We were having trouble building on ghc 8.4 because of
the lack of a Foldable instance for (Alt Maybe) in
base < 4.12.

Mystery: for some reason our builds were failing for gitit
but not in the pandoc CI.
This commit is contained in:
John MacFarlane 2021-08-12 09:22:34 -07:00
parent 86cce2b2eb
commit 3cfcfacd72
2 changed files with 2 additions and 6 deletions

View file

@ -410,7 +410,7 @@ common common-options
-Wincomplete-record-updates
-Wnoncanonical-monad-instances
if impl(ghc < 8.4)
if impl(ghc < 8.6)
hs-source-dirs: prelude
other-modules: Prelude
build-depends: base-compat >= 0.9

View file

@ -7,9 +7,6 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{- |
Module : Text.Pandoc.Readers.Odt.ContentReader
Copyright : Copyright (C) 2015 Martin Linnemann
@ -510,8 +507,7 @@ type InlineMatcher = ElementMatcher Inlines
type BlockMatcher = ElementMatcher Blocks
newtype FirstMatch a = FirstMatch (Alt Maybe a)
deriving (Monoid, Semigroup)
deriving instance Foldable FirstMatch
deriving (Foldable, Monoid, Semigroup)
firstMatch :: a -> FirstMatch a
firstMatch = FirstMatch . Alt . Just