(original) (raw)

{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE Trustworthy #-}

module Data.Functor.Compose ( Compose(..), ) where

import Data.Functor.Classes

import Control.Applicative import Data.Coerce (coerce) import Data.Data (Data) import Data.Foldable (Foldable(foldMap)) import Data.Traversable (Traversable(traverse)) import GHC.Generics (Generic, Generic1) import Text.Read (Read(..), readListDefault, readListPrecDefault)

infixr 9 [Compose](Data.Functor.Compose.html#Compose)

newtype Compose f g a = Compose { getCompose :: f (g a) } deriving ( Data
, Generic
, Generic1 )

instance (Eq1 f, Eq1 g) => Eq1 (Compose f g) where liftEq eq (Compose x) (Compose y) = liftEq (liftEq eq) x y

instance (Ord1 f, Ord1 g) => Ord1 (Compose f g) where liftCompare comp (Compose x) (Compose y) = liftCompare (liftCompare comp) x y

instance (Read1 f, Read1 g) => Read1 (Compose f g) where liftReadPrec rp rl = readData $ readUnaryWith (liftReadPrec rp' rl') "Compose" Compose where rp' = liftReadPrec rp rl rl' = liftReadListPrec rp rl

[liftReadListPrec](Data.Functor.Classes.html#liftReadListPrec) = [liftReadListPrecDefault](Data.Functor.Classes.html#liftReadListPrecDefault)
[liftReadList](Data.Functor.Classes.html#liftReadList)     = [liftReadListDefault](Data.Functor.Classes.html#liftReadListDefault)

instance (Show1 f, Show1 g) => Show1 (Compose f g) where liftShowsPrec sp sl d (Compose x) = showsUnaryWith (liftShowsPrec sp' sl') "Compose" d x where sp' = liftShowsPrec sp sl sl' = liftShowList sp sl

instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1

instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where compare = compare1

instance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where readPrec = readPrec1

[readListPrec](GHC.Read.html#readListPrec) = [readListPrecDefault](GHC.Read.html#readListPrecDefault)
[readList](GHC.Read.html#readList)     = [readListDefault](GHC.Read.html#readListDefault)

instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where showsPrec = showsPrec1

instance (Functor f, Functor g) => Functor (Compose f g) where fmap f (Compose x) = Compose (fmap (fmap f) x)

instance (Foldable f, Foldable g) => Foldable (Compose f g) where foldMap f (Compose t) = foldMap (foldMap f) t

instance (Traversable f, Traversable g) => Traversable (Compose f g) where traverse f (Compose t) = Compose <$> traverse (traverse f) t

instance (Applicative f, Applicative g) => Applicative (Compose f g) where pure x = Compose (pure (pure x)) Compose f <*> Compose x = Compose (liftA2 (<*>) f x) liftA2 f (Compose x) (Compose y) = Compose (liftA2 (liftA2 f) x y)

instance (Alternative f, Applicative g) => Alternative (Compose f g) where empty = Compose empty (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a)) :: forall a . Compose f g a -> Compose f g a -> Compose f g a