    {-# OPTIONS_GHC -fno-warn-orphans #-}
    {-# LANGUAGE MultiParamTypeClasses #-}

    -- |
    -- Module      : Data.Functor.ProductIsomorphic.Instances
    -- Copyright   : 2017 Kei Hibino
    -- License     : BSD3
    --
    -- Maintainer  : ex8k.hibino@gmail.com
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- This module defines functor instances morphed functions
    -- are restricted to products.
    module Data.Functor.ProductIsomorphic.Instances (
      WrappedFunctor (..),
      WrappedAlter (..),
      ) where

    import Data.Monoid (Monoid, mempty, (<>))
    import Control.Applicative
      ((<$>), Applicative, pure, (<*>),
       Alternative, empty, (<|>),
       Const (..))

    import Data.Functor.ProductIsomorphic.Class
      (ProductIsoFunctor(..), ProductIsoApplicative (..),
       ProductIsoAlternative (..), ProductIsoEmpty (..))

    instance ProductIsoFunctor (Const a) where
      _ |$| :: (a -> b) -> Const a a -> Const a b
    |$| Const a :: a
    a = a -> Const a b
    forall k a (b :: k). a -> Const a b
    Const a
    a
      {-# INLINABLE (|$|) #-}

    instance Monoid a => ProductIsoApplicative (Const a) where
      pureP :: a -> Const a a
    pureP _ = a -> Const a a
    forall k a (b :: k). a -> Const a b
    Const a
    forall a. Monoid a => a
    mempty
      {-# INLINABLE pureP #-}
      Const a :: a
    a |*| :: Const a (a -> b) -> Const a a -> Const a b
    |*| Const b :: a
    b = a -> Const a b
    forall k a (b :: k). a -> Const a b
    Const (a -> Const a b) -> a -> Const a b
    forall a b. (a -> b) -> a -> b
    $ a
    a a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    b
      {-# INLINABLE (|*|) #-}

    instance Monoid a => ProductIsoEmpty (Const a) () where
      pureE :: Const a ()
    pureE = () -> Const a ()
    forall (f :: * -> *) a.
    (ProductIsoApplicative f, ProductConstructor a) =>
    a -> f a
    pureP ()
      {-# INLINABLE pureE #-}
      peRight :: Const a (a, ()) -> Const a a
    peRight (Const a :: a
    a) = a -> Const a a
    forall k a (b :: k). a -> Const a b
    Const a
    a
      {-# INLINABLE peRight #-}
      peLeft :: Const a ((), a) -> Const a a
    peLeft (Const a :: a
    a) = a -> Const a a
    forall k a (b :: k). a -> Const a b
    Const a
    a
      {-# INLINABLE peLeft #-}

    -- | Wrapped functor type to make instances of product-iso functors.
    newtype WrappedFunctor f a = WrapFunctor { WrappedFunctor f a -> f a
    unwrapFunctor :: f a }

    instance Functor f => ProductIsoFunctor (WrappedFunctor f) where
      f :: a -> b
    f |$| :: (a -> b) -> WrappedFunctor f a -> WrappedFunctor f b
    |$| fa :: WrappedFunctor f a
    fa = f b -> WrappedFunctor f b
    forall (f :: * -> *) a. f a -> WrappedFunctor f a
    WrapFunctor (f b -> WrappedFunctor f b) -> f b -> WrappedFunctor f b
    forall a b. (a -> b) -> a -> b
    $ a -> b
    f (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WrappedFunctor f a -> f a
    forall (f :: * -> *) a. WrappedFunctor f a -> f a
    unwrapFunctor WrappedFunctor f a
    fa
      {-# INLINABLE (|$|) #-}

    instance Applicative f => ProductIsoApplicative (WrappedFunctor f) where
      pureP :: a -> WrappedFunctor f a
    pureP = f a -> WrappedFunctor f a
    forall (f :: * -> *) a. f a -> WrappedFunctor f a
    WrapFunctor (f a -> WrappedFunctor f a)
    -> (a -> f a) -> a -> WrappedFunctor f a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      {-# INLINABLE pureP #-}
      WrapFunctor ff :: f (a -> b)
    ff |*| :: WrappedFunctor f (a -> b)
    -> WrappedFunctor f a -> WrappedFunctor f b
    |*| WrapFunctor fa :: f a
    fa = f b -> WrappedFunctor f b
    forall (f :: * -> *) a. f a -> WrappedFunctor f a
    WrapFunctor (f b -> WrappedFunctor f b) -> f b -> WrappedFunctor f b
    forall a b. (a -> b) -> a -> b
    $ f (a -> b)
    ff f (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> f a
    fa
      {-# INLINABLE (|*|) #-}

    instance Alternative f => ProductIsoAlternative (WrappedFunctor f) where
      emptyP :: WrappedFunctor f a
    emptyP = f a -> WrappedFunctor f a
    forall (f :: * -> *) a. f a -> WrappedFunctor f a
    WrapFunctor f a
    forall (f :: * -> *) a. Alternative f => f a
    empty
      {-# INLINABLE emptyP #-}
      WrapFunctor fa1 :: f a
    fa1 ||| :: WrappedFunctor f a -> WrappedFunctor f a -> WrappedFunctor f a
    ||| WrapFunctor fa2 :: f a
    fa2 = f a -> WrappedFunctor f a
    forall (f :: * -> *) a. f a -> WrappedFunctor f a
    WrapFunctor (f a -> WrappedFunctor f a) -> f a -> WrappedFunctor f a
    forall a b. (a -> b) -> a -> b
    $ f a
    fa1 f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> f a
    fa2
      {-# INLINABLE (|||) #-}

    instance Applicative f => ProductIsoEmpty (WrappedFunctor f) () where
      pureE :: WrappedFunctor f ()
    pureE   = () -> WrappedFunctor f ()
    forall (f :: * -> *) a.
    (ProductIsoApplicative f, ProductConstructor a) =>
    a -> f a
    pureP ()
      {-# INLINABLE pureE #-}
      peRight :: WrappedFunctor f (a, ()) -> WrappedFunctor f a
    peRight = f a -> WrappedFunctor f a
    forall (f :: * -> *) a. f a -> WrappedFunctor f a
    WrapFunctor (f a -> WrappedFunctor f a)
    -> (WrappedFunctor f (a, ()) -> f a)
    -> WrappedFunctor f (a, ())
    -> WrappedFunctor f a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a, ()) -> a) -> f (a, ()) -> f a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a, ()) -> a
    forall a b. (a, b) -> a
    fst (f (a, ()) -> f a)
    -> (WrappedFunctor f (a, ()) -> f (a, ()))
    -> WrappedFunctor f (a, ())
    -> f a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WrappedFunctor f (a, ()) -> f (a, ())
    forall (f :: * -> *) a. WrappedFunctor f a -> f a
    unwrapFunctor
      {-# INLINABLE peRight #-}
      peLeft :: WrappedFunctor f ((), a) -> WrappedFunctor f a
    peLeft  = f a -> WrappedFunctor f a
    forall (f :: * -> *) a. f a -> WrappedFunctor f a
    WrapFunctor (f a -> WrappedFunctor f a)
    -> (WrappedFunctor f ((), a) -> f a)
    -> WrappedFunctor f ((), a)
    -> WrappedFunctor f a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (((), a) -> a) -> f ((), a) -> f a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((), a) -> a
    forall a b. (a, b) -> b
    snd (f ((), a) -> f a)
    -> (WrappedFunctor f ((), a) -> f ((), a))
    -> WrappedFunctor f ((), a)
    -> f a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WrappedFunctor f ((), a) -> f ((), a)
    forall (f :: * -> *) a. WrappedFunctor f a -> f a
    unwrapFunctor
      {-# INLINABLE peLeft #-}

    -- | Wrapped Const Alternative objects to make instances like Const functor.
    newtype WrappedAlter f a b = WrapAlter { WrappedAlter f a b -> Const (f a) b
    unWrapAlter :: Const (f a) b }

    instance ProductIsoFunctor (WrappedAlter f a) where
      _ |$| :: (a -> b) -> WrappedAlter f a a -> WrappedAlter f a b
    |$| WrapAlter (Const fa :: f a
    fa) = Const (f a) b -> WrappedAlter f a b
    forall (f :: * -> *) a b. Const (f a) b -> WrappedAlter f a b
    WrapAlter (Const (f a) b -> WrappedAlter f a b)
    -> Const (f a) b -> WrappedAlter f a b
    forall a b. (a -> b) -> a -> b
    $ f a -> Const (f a) b
    forall k a (b :: k). a -> Const a b
    Const f a
    fa
      {-# INLINABLE (|$|) #-}

    instance Alternative f => ProductIsoApplicative (WrappedAlter f a) where
      pureP :: a -> WrappedAlter f a a
    pureP _ = Const (f a) a -> WrappedAlter f a a
    forall (f :: * -> *) a b. Const (f a) b -> WrappedAlter f a b
    WrapAlter (Const (f a) a -> WrappedAlter f a a)
    -> Const (f a) a -> WrappedAlter f a a
    forall a b. (a -> b) -> a -> b
    $ f a -> Const (f a) a
    forall k a (b :: k). a -> Const a b
    Const f a
    forall (f :: * -> *) a. Alternative f => f a
    empty
      {-# INLINABLE pureP #-}
      WrapAlter (Const a :: f a
    a) |*| :: WrappedAlter f a (a -> b)
    -> WrappedAlter f a a -> WrappedAlter f a b
    |*| WrapAlter (Const b :: f a
    b) = Const (f a) b -> WrappedAlter f a b
    forall (f :: * -> *) a b. Const (f a) b -> WrappedAlter f a b
    WrapAlter (Const (f a) b -> WrappedAlter f a b)
    -> Const (f a) b -> WrappedAlter f a b
    forall a b. (a -> b) -> a -> b
    $ f a -> Const (f a) b
    forall k a (b :: k). a -> Const a b
    Const (f a -> Const (f a) b) -> f a -> Const (f a) b
    forall a b. (a -> b) -> a -> b
    $ f a
    a f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> f a
    b
      {-# INLINABLE (|*|) #-}

    instance Alternative f => ProductIsoEmpty (WrappedAlter f a) () where
      pureE :: WrappedAlter f a ()
    pureE   = () -> WrappedAlter f a ()
    forall (f :: * -> *) a.
    (ProductIsoApplicative f, ProductConstructor a) =>
    a -> f a
    pureP ()
      {-# INLINABLE pureE #-}
      peRight :: WrappedAlter f a (a, ()) -> WrappedAlter f a a
    peRight = Const (f a) a -> WrappedAlter f a a
    forall (f :: * -> *) a b. Const (f a) b -> WrappedAlter f a b
    WrapAlter (Const (f a) a -> WrappedAlter f a a)
    -> (WrappedAlter f a (a, ()) -> Const (f a) a)
    -> WrappedAlter f a (a, ())
    -> WrappedAlter f a a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a, ()) -> a) -> Const (f a) (a, ()) -> Const (f a) a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a, ()) -> a
    forall a b. (a, b) -> a
    fst (Const (f a) (a, ()) -> Const (f a) a)
    -> (WrappedAlter f a (a, ()) -> Const (f a) (a, ()))
    -> WrappedAlter f a (a, ())
    -> Const (f a) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WrappedAlter f a (a, ()) -> Const (f a) (a, ())
    forall (f :: * -> *) a b. WrappedAlter f a b -> Const (f a) b
    unWrapAlter
      {-# INLINABLE peRight #-}
      peLeft :: WrappedAlter f a ((), a) -> WrappedAlter f a a
    peLeft  = Const (f a) a -> WrappedAlter f a a
    forall (f :: * -> *) a b. Const (f a) b -> WrappedAlter f a b
    WrapAlter (Const (f a) a -> WrappedAlter f a a)
    -> (WrappedAlter f a ((), a) -> Const (f a) a)
    -> WrappedAlter f a ((), a)
    -> WrappedAlter f a a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (((), a) -> a) -> Const (f a) ((), a) -> Const (f a) a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((), a) -> a
    forall a b. (a, b) -> b
    snd (Const (f a) ((), a) -> Const (f a) a)
    -> (WrappedAlter f a ((), a) -> Const (f a) ((), a))
    -> WrappedAlter f a ((), a)
    -> Const (f a) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WrappedAlter f a ((), a) -> Const (f a) ((), a)
    forall (f :: * -> *) a b. WrappedAlter f a b -> Const (f a) b
    unWrapAlter