{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GADTs, DefaultSignatures #-}
{-# LANGUAGE ConstraintKinds #-}


-- |

-- 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

    Applicative1, amap1

    -- * Generalized

  , ApplicativeG(..), amapG'
  , ApplicationG(..), apType
  , ApplicativeGDual1, ApplicativeGBi

  )
  where

import Control.Monad (fmap)

import Data.List (map)
import Data.Maybe

import OAlg.Data.Dualisable
import OAlg.Data.Either
import OAlg.Data.X

--------------------------------------------------------------------------------

-- ApplicativeG -


-- | generalized application.

class ApplicativeG t a b where
  -- | application.

  amapG :: a x y -> b (t x) (t y)

--------------------------------------------------------------------------------

-- ApplicativeG - Instances -


instance ApplicativeG X (->) (->)  where amapG :: forall x y. (x -> y) -> X x -> X y
amapG = (x -> y) -> X x -> X y
forall x y. (x -> y) -> X x -> X y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
instance ApplicativeG [] (->) (->) where amapG :: forall x y. (x -> y) -> [x] -> [y]
amapG = (x -> y) -> [x] -> [y]
forall x y. (x -> y) -> [x] -> [y]
map
instance ApplicativeG Maybe (->) (->) where amapG :: forall x y. (x -> y) -> Maybe x -> Maybe y
amapG = (x -> y) -> Maybe x -> Maybe y
forall x y. (x -> y) -> Maybe x -> Maybe y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance (ApplicativeG t f c, ApplicativeG t g c) => ApplicativeG t (Either2 f g) c where
  amapG :: forall x y. Either2 f g x y -> c (t x) (t y)
amapG (Left2 f x y
f)  = f x y -> c (t x) (t y)
forall x y. f x y -> c (t x) (t y)
forall (t :: * -> *) (a :: * -> * -> *) (b :: * -> * -> *) x y.
ApplicativeG t a b =>
a x y -> b (t x) (t y)
amapG f x y
f
  amapG (Right2 g x y
g) = g x y -> c (t x) (t y)
forall x y. g x y -> c (t x) (t y)
forall (t :: * -> *) (a :: * -> * -> *) (b :: * -> * -> *) x y.
ApplicativeG t a b =>
a x y -> b (t x) (t y)
amapG g x y
g
  
--------------------------------------------------------------------------------

-- amapG' -


-- | prefixing a proxy.

amapG' :: ApplicativeG t a b => q t a b -> a x y -> b (t x) (t y)
amapG' :: forall (t :: * -> *) (a :: * -> * -> *) (b :: * -> * -> *)
       (q :: (* -> *) -> (* -> * -> *) -> (* -> * -> *) -> *) x y.
ApplicativeG t a b =>
q t a b -> a x y -> b (t x) (t y)
amapG' q t a b
_ = a x y -> b (t x) (t y)
forall x y. a x y -> b (t x) (t y)
forall (t :: * -> *) (a :: * -> * -> *) (b :: * -> * -> *) x y.
ApplicativeG t a b =>
a x y -> b (t x) (t y)
amapG

--------------------------------------------------------------------------------

-- ApplicationG -


-- | attest of being 'ApplicativeG'.

data ApplicationG t a b where
  ApplicationG :: ApplicativeG t a b => ApplicationG t a b

--------------------------------------------------------------------------------

-- apType -


-- | application to @(->)@ based on @__t__@,

apType :: ApplicativeG t h (->) => ApplicationG t h (->)
apType :: forall (t :: * -> *) (h :: * -> * -> *).
ApplicativeG t h (->) =>
ApplicationG t h (->)
apType = ApplicationG t h (->)
forall (t :: * -> *) (a :: * -> * -> *) (b :: * -> * -> *).
ApplicativeG t a b =>
ApplicationG t a b
ApplicationG

--------------------------------------------------------------------------------

-- Applicative1 -


-- | representable @__h__@s according to @__f__@.

type Applicative1 h f = ApplicativeG f h (->)

--------------------------------------------------------------------------------

-- amap1 -


-- | representation of @__h__@ in @('->')@ according to @__f__@.

amap1 :: Applicative1 h f => h x y -> f x -> f y
amap1 :: forall (h :: * -> * -> *) (f :: * -> *) x y.
Applicative1 h f =>
h x y -> f x -> f y
amap1 = h x y -> f x -> f y
forall x y. h x y -> f x -> f y
forall (t :: * -> *) (a :: * -> * -> *) (b :: * -> * -> *) x y.
ApplicativeG t a b =>
a x y -> b (t x) (t y)
amapG

--------------------------------------------------------------------------------

-- ApplicativeGDual1 -


-- | helper class to avoid undecidable instances.

class ApplicativeG (Dual1 d) h c => ApplicativeGDual1 d h c

--------------------------------------------------------------------------------

-- ApplicativeGBi -


-- | constraint for bi-applicative.

type ApplicativeGBi d h c
  = ( ApplicativeG d h c
    , ApplicativeGDual1 d h c
    )