#ifdef MIN_VERSION_base
#define MINVER_base_48 MIN_VERSION_base(4,8,0)
#define MINVER_base_47 MIN_VERSION_base(4,7,0)
#else
#define MINVER_base_48 (__GLASGOW_HASKELL__ >= 710)
#define MINVER_base_47 (__GLASGOW_HASKELL__ >= 708)
#endif
module Distribution.Compat.Prelude (
module BasePrelude,
#if !MINVER_base_48
Applicative(..), (<$), (<$>),
Monoid(..),
#endif
Semigroup (..),
gmappend, gmempty,
Typeable,
Data,
Generic,
NFData (..), genericRnf,
Binary (..),
Alternative (..),
MonadPlus (..),
IsString (..),
IO, NoCallStackIO,
Map,
catMaybes, mapMaybe,
fromMaybe,
maybeToList, listToMaybe,
isNothing, isJust,
unfoldr,
isPrefixOf, isSuffixOf,
intercalate, intersperse,
sort, sortBy,
nub, nubBy,
Foldable, foldMap, foldr,
null, length,
find, foldl',
traverse_, for_,
any, all,
Traversable, traverse, sequenceA,
for,
first,
liftM, liftM2,
unless, when,
ap, void,
foldM, filterM,
isSpace, isDigit, isUpper, isAlpha, isAlphaNum,
chr, ord,
toLower, toUpper,
Word,
Word8, Word16, Word32, Word64,
Int8, Int16, Int32, Int64,
(<<>>),
) where
import Prelude as BasePrelude hiding
( IO, mapM, mapM_, sequence, null, length, foldr, any, all
#if MINVER_base_48
, Word
, Traversable, traverse, sequenceA
, Foldable, foldMap
#endif
)
#if !MINVER_base_48
import Control.Applicative (Applicative (..), (<$), (<$>))
import Distribution.Compat.Semigroup (Monoid (..))
#else
import Data.Foldable (length, null)
#endif
import Data.Foldable (Foldable (foldMap, foldr), find, foldl', for_, traverse_, any, all)
import Data.Traversable (Traversable (traverse, sequenceA), for)
import Control.Applicative (Alternative (..))
import Control.DeepSeq (NFData (..))
import Data.Data (Data)
import Data.Typeable (Typeable)
import Distribution.Compat.Binary (Binary (..))
import Distribution.Compat.Semigroup (Semigroup (..), gmappend, gmempty)
import GHC.Generics (Generic, Rep(..),
V1, U1(U1), K1(unK1), M1(unM1),
(:*:)((:*:)), (:+:)(L1,R1))
import Data.Map (Map)
import Control.Arrow (first)
import Control.Monad hiding (mapM)
import Data.Char
import Data.List (intercalate, intersperse, isPrefixOf,
isSuffixOf, nub, nubBy, sort, sortBy,
unfoldr)
import Data.Maybe
import Data.String (IsString (..))
import Data.Int
import Data.Word
import qualified Text.PrettyPrint as Disp
import qualified Prelude as OrigPrelude
import Distribution.Compat.Stack
type IO a = WithCallStack (OrigPrelude.IO a)
type NoCallStackIO a = OrigPrelude.IO a
(<<>>) :: Disp.Doc -> Disp.Doc -> Disp.Doc
(<<>>) = (Disp.<>)
#if !MINVER_base_48
null :: Foldable t => t a -> Bool
null = foldr (\_ _ -> False) True
length :: Foldable t => t a -> Int
length = foldl' (\c _ -> c+1) 0
#endif
genericRnf :: (Generic a, GNFData (Rep a)) => a -> ()
genericRnf = grnf . from
class GNFData f where
grnf :: f a -> ()
instance GNFData V1 where
grnf = error "Control.DeepSeq.rnf: uninhabited type"
instance GNFData U1 where
grnf U1 = ()
instance NFData a => GNFData (K1 i a) where
grnf = rnf . unK1
instance GNFData a => GNFData (M1 i c a) where
grnf = grnf . unM1
instance (GNFData a, GNFData b) => GNFData (a :*: b) where
grnf (x :*: y) = grnf x `seq` grnf y
instance (GNFData a, GNFData b) => GNFData (a :+: b) where
grnf (L1 x) = grnf x
grnf (R1 x) = grnf x