{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : OAlg.Category.Applicative
-- Description : application on values.
-- Copyright   : (c) Erich Gut
-- License     : BSD3
-- Maintainer  : zerich.gut@gmail.com
--
-- application on values.
module OAlg.Category.Applicative
  ( 
    -- * Applicative
    Applicative(..), ($)
  , Applicative1(..)
  )
  where

import Control.Monad (Functor(..))

import OAlg.Data.Either

--------------------------------------------------------------------------------
-- Applicative -
  
-- | family of types having a representation in @(->)@.
class Applicative h where
  -- | application.
  amap :: h a b -> a -> b

instance Applicative (->) where
  amap :: forall a b. (a -> b) -> a -> b
amap a -> b
h = a -> b
h  

--------------------------------------------------------------------------------
-- ($)
  
infixr 0 $

-- | right associative application on values.
($) :: Applicative h => h a b -> a -> b
$ :: forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
($) = forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
amap

instance (Applicative f, Applicative g) => Applicative (Either2 f g) where
  amap :: forall a b. Either2 f g a b -> a -> b
amap (Left2 f a b
f)  = forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
amap f a b
f
  amap (Right2 g a b
g) = forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
amap g a b
g

--------------------------------------------------------------------------------
-- Applicative1 -

-- | family of types having a representation in @f a -> f b@.
class Applicative1 h f where
  -- | application.
  amap1 :: h a b -> f a -> f b

instance Functor f => Applicative1 (->) f where
  amap1 :: forall a b. (a -> b) -> f a -> f b
amap1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap