content: {-# LANGUAGE Safe #-}
  
  -- |
  -- Copyright   :  (c) Edward Kmett 2010-2021
  -- License     :  BSD-2-Clause OR Apache-2.0
  -- Maintainer  :  ekmett@gmail.com
  -- Stability   :  experimental
  -- Portability :  portable
  --
  -- Composition of contravariant functors.
  
  module Data.Functor.Contravariant.Compose
  ( Compose(..)
  , ComposeFC(..)
  , ComposeCF(..)
  ) where
  
  import Control.Arrow
  import Data.Functor.Contravariant
  import Data.Functor.Contravariant.Divisible
  
  -- | Composition of two contravariant functors
  newtype Compose f g a = Compose { getCompose :: f (g a) }
  
  instance (Contravariant f, Contravariant g) => Functor (Compose f g) where
    fmap f (Compose x) = Compose (contramap (contramap f) x)
  
  -- | Composition of covariant and contravariant functors
  newtype ComposeFC f g a = ComposeFC { getComposeFC :: f (g a) }
  
  instance (Functor f, Contravariant g) => Contravariant (ComposeFC f g) where
    contramap f (ComposeFC x) = ComposeFC (fmap (contramap f) x)
  
  instance (Functor f, Functor g) => Functor (ComposeFC f g) where
    fmap f (ComposeFC x) = ComposeFC (fmap (fmap f) x)
  
  instance (Applicative f, Divisible g) => Divisible (ComposeFC f g) where
    conquer = ComposeFC $ pure conquer
    divide abc (ComposeFC fb) (ComposeFC fc) = ComposeFC $ divide abc <$> fb <*> fc
  
  instance (Applicative f, Decidable g) => Decidable (ComposeFC f g) where
    lose f = ComposeFC $ pure (lose f)
    choose abc (ComposeFC fb) (ComposeFC fc) = ComposeFC $ choose abc <$> fb <*> fc
  
  -- | Composition of contravariant and covariant functors
  newtype ComposeCF f g a = ComposeCF { getComposeCF :: f (g a) }
  
  instance (Contravariant f, Functor g) => Contravariant (ComposeCF f g) where
    contramap f (ComposeCF x) = ComposeCF (contramap (fmap f) x)
  
  instance (Functor f, Functor g) => Functor (ComposeCF f g) where
    fmap f (ComposeCF x) = ComposeCF (fmap (fmap f) x)
  
  instance (Divisible f, Applicative g) => Divisible (ComposeCF f g) where
    conquer = ComposeCF conquer
    divide abc (ComposeCF fb) (ComposeCF fc) = ComposeCF $ divide (funzip . fmap abc) fb fc
  
  funzip :: Functor f => f (a, b) -> (f a, f b)
  funzip = fmap fst &&& fmap snd
  