-- |
-- Module      : Data.Functor.Combinator
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Functor combinators and tools (typeclasses and utiility functions) to
-- manipulate them.  This is the main "entrypoint" of the library.
--
-- Classes include:
--
-- *  'HFunctor' and 'HBifunctor', used to swap out the functors that the
--    combinators modify
-- *  'Interpret', 'Associative', 'Tensor', used to inject and interpret
-- functor values with respect to their combinators.
--
-- We have some helpful utility functions, as well, built on top of these
-- typeclasses.
--
-- The second half of this module exports the various useful functor
-- combinators that can modify functors to add extra functionality, or join
-- two functors together and mix them in different ways.  Use them to build
-- your final structure by combining simpler ones in composable ways!
--
-- See <https://blog.jle.im/entry/functor-combinatorpedia.html> and the
-- README for a tutorial and a rundown on each different functor
-- combinator.
module Data.Functor.Combinator (
  -- * Classes
  -- | A lot of type signatures are stated in terms of '~>'.  '~>'
  -- represents a "natural transformation" between two functors: a value of
  -- type @f '~>' g@ is a value of type 'f a -> g a@ that works for /any/
  -- @a@.
    type (~>)
  , type (<~>)
  -- ** Single Functors
  -- | Classes that deal with single-functor combinators, that enhance
  -- a single functor.
  , HFunctor(..)
  , Inject(..)
  , Interpret(..)
  , forI
  , iget, icollect, icollect1
  , iapply, ifanout, ifanout1
  , getI, collectI
  , AltConst(..)
  -- ** Multi-Functors
  -- | Classes that deal with two-functor combinators, that "mix" two
  -- functors together in some way.
  , HBifunctor(..)
  -- *** Associative
  , Associative(..)
  , SemigroupIn(..)
  , biget, biapply
  -- , biget, bicollect, bicollect1
  , (!*!)
  , (!+!)
  , (!$!)
  -- *** Tensor
  , Tensor(..)
  , MonoidIn(..)
  , nilLB, consLB
  , inL, inR
  , outL, outR
  -- * Combinators
  -- | Functor combinators
  -- ** Single
  , Coyoneda(..)
  , ListF(..)
  , NonEmptyF(..)
  , MaybeF(..)
  , MapF(..)
  , NEMapF(..)
  , Ap
  , Ap1(..)
  , Alt
  , Free
  , Free1
  , Lift
  , Step(..)
  , Steps(..)
  , ProxyF(..)
  , ConstF(..)
  , EnvT(..)
  , ReaderT(..)
  , Flagged(..)
  , IdentityT(..)
  , Void2
  , Final(..)
  , FreeOf(..)
  , ComposeT(..)
  -- ** Multi
  , Day(..)
  , (:*:)(..), prodOutL, prodOutR
  , (:+:)(..), V1
  , These1(..)
  , Night(..), Not(..), refuted
  , Comp(Comp, unComp)
  , LeftF(..)
  , RightF(..)
  -- ** Combinator Combinators
  , HLift(..)
  , HFree(..)
  -- * Util
  -- ** Natural Transformations
  , generalize
  , absorb
  -- ** Divisible
  , divideN
  , diviseN
  , concludeN
  , decideN
  , divideNRec
  , diviseNRec
  ) where

import           Control.Alternative.Free
import           Control.Applicative.Free
import           Control.Applicative.Lift
import           Control.Applicative.ListF
import           Control.Applicative.Step
import           Control.Comonad.Trans.Env
import           Control.Monad.Freer.Church
import           Control.Monad.Trans.Compose
import           Control.Monad.Trans.Identity
import           Control.Monad.Trans.Reader
import           Control.Natural
import           Control.Natural.IsoF
import           Data.Functor.Apply.Free
import           Data.Functor.Contravariant
import           Data.Functor.Contravariant.Conclude
import           Data.Functor.Contravariant.Decide
import           Data.Functor.Contravariant.Divise
import           Data.Functor.Contravariant.Divisible
import           Data.Functor.Coyoneda
import           Data.Functor.Day
import           Data.Functor.Invariant.Night
import           Data.Functor.These
import           Data.HBifunctor
import           Data.HBifunctor.Associative
import           Data.HBifunctor.Tensor
import           Data.HFunctor
import           Data.HFunctor.Final
import           Data.HFunctor.Internal
import           Data.HFunctor.Interpret
import           GHC.Generics

import qualified Data.SOP           as SOP
import qualified Data.Vinyl         as V
import qualified Data.Vinyl.Functor as V


-- | Convenient helper function to build up a 'Divisible' by providing
-- each component of it.  This makes it much easier to build up longer
-- chains as opposed to nested calls to 'divide' and manually peeling off
-- tuples one-by-one.
--
-- For example, if you had a data type
--
-- @
-- data MyType = MT Int Bool String
-- @
--
-- and a contravariant consumer @Builder@ (representing, say, a way to
-- serialize an item, where @intBuilder :: Builder Int@ is a serializer of
-- 'Int's), then you could assemble a serializer a @MyType@ using:
--
-- @
-- contramap (\(MyType x y z) -> I x :* I y :* I z :* Nil) $
--   divideN $ intBuilderj
--          :* boolBuilder
--          :* stringBuilder
--          :* Nil
-- @
--
-- Some notes on usefulness depending on how many components you have:
--
-- *    If you have 0 components, use 'conquer'.
-- *    If you have 1 component, use 'inject' directly.
-- *    If you have 2 components, use 'divide' directly.
-- *    If you have 3 or more components, these combinators may be useful;
--      otherwise you'd need to manually peel off tuples one-by-one.
--
-- @since 0.3.0.0
divideN
    :: Divisible f
    => SOP.NP f as
    -> f (SOP.NP SOP.I as)
divideN :: NP f as -> f (NP I as)
divideN = \case
    SOP.Nil     -> f (NP I as)
forall (f :: * -> *) a. Divisible f => f a
conquer
    x :: f x
x SOP.:* xs :: NP f xs
xs -> (NP I as -> (x, NP I xs)) -> f x -> f (NP I xs) -> f (NP I as)
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide
      (\case SOP.I y SOP.:* ys :: NP I xs
ys -> (x
y, NP I xs
NP I xs
ys))
      f x
x
      (NP f xs -> f (NP I xs)
forall (f :: * -> *) (as :: [*]).
Divisible f =>
NP f as -> f (NP I as)
divideN NP f xs
xs)

-- | A version of 'divideN' defined to work with 'V.XRec', which can
-- syntactically cleaner because you don't have to manually wrap/unwrap
-- 'SOP.I's.
--
-- Using the example for 'divideN':
--
-- @
-- data MyType = MT Int Bool String
--
-- contramap (\(MyType x y z) -> x ::& y ::& z ::& Nil) $
--   divideNRec $ intBuilderj
--             :& boolBuilder
--             :& stringBuilder
--             :& RNil
-- @
--
-- @since 0.3.0.0
divideNRec
    :: Divisible f
    => V.Rec f as
    -> f (V.XRec V.Identity as)
divideNRec :: Rec f as -> f (XRec Identity as)
divideNRec = \case
    V.RNil    -> f (XRec Identity as)
forall (f :: * -> *) a. Divisible f => f a
conquer
    x :: f r
x V.:& xs :: Rec f rs
xs -> (XRec Identity (r : rs) -> (r, XRec Identity rs))
-> f r -> f (XRec Identity rs) -> f (XRec Identity (r : rs))
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide
      (\case z :: HKD Identity r
z V.::& zs :: XRec Identity rs
zs -> (r
HKD Identity r
z, XRec Identity rs
zs))
      f r
x
      (Rec f rs -> f (XRec Identity rs)
forall (f :: * -> *) (as :: [*]).
Divisible f =>
Rec f as -> f (XRec Identity as)
divideNRec Rec f rs
xs)

-- | A version of 'divideNRec' that works for non-empty records, and so only
-- requires a 'Divise' constraint.
--
-- @since 0.3.0.0
diviseNRec
    :: Divise f
    => V.Rec f (a ': as)
    -> f (V.XRec V.Identity (a ': as))
diviseNRec :: Rec f (a : as) -> f (XRec Identity (a : as))
diviseNRec = \case
    x :: f r
x V.:& xs :: Rec f rs
xs -> case Rec f rs
xs of
      V.RNil   -> (XRec Identity (a : as) -> r) -> f r -> f (XRec Identity (a : as))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\case z :: HKD Identity a
z V.::& _ -> r
HKD Identity a
z) f r
x
      _ V.:& _ -> (XRec Identity (a : r : rs) -> (r, XRec Identity (r : rs)))
-> f r
-> f (XRec Identity (r : rs))
-> f (XRec Identity (a : r : rs))
forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise
        (\case z :: HKD Identity a
z V.::& zs :: XRec Identity (r : rs)
zs -> (r
HKD Identity a
z,XRec Identity (r : rs)
zs))
        f r
x
        (Rec f (r : rs) -> f (XRec Identity (r : rs))
forall (f :: * -> *) a (as :: [*]).
Divise f =>
Rec f (a : as) -> f (XRec Identity (a : as))
diviseNRec Rec f rs
Rec f (r : rs)
xs)

-- | A version of 'divideN' that works for non-empty 'SOP.NP', and so only
-- requires a 'Divise' constraint.
diviseN
    :: Divise f
    => SOP.NP f (a ': as)
    -> f (SOP.NP SOP.I (a ': as))
diviseN :: NP f (a : as) -> f (NP I (a : as))
diviseN = \case
    x :: f x
x SOP.:* xs :: NP f xs
xs -> case NP f xs
xs of
      SOP.Nil    -> (NP I (x : as) -> x) -> f x -> f (NP I (x : as))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (I x -> x
forall a. I a -> a
SOP.unI (I x -> x) -> (NP I (x : as) -> I x) -> NP I (x : as) -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP I (x : as) -> I x
forall k (f :: k -> *) (x :: k) (xs :: [k]). NP f (x : xs) -> f x
SOP.hd) f x
x
      _ SOP.:* _ -> (NP I (a : as) -> (x, NP I (x : xs)))
-> f x -> f (NP I (x : xs)) -> f (NP I (a : as))
forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise
        (\case SOP.I z SOP.:* zs :: NP I xs
zs -> (x
z, NP I xs
NP I (x : xs)
zs))
        f x
x
        (NP f (x : xs) -> f (NP I (x : xs))
forall (f :: * -> *) a (as :: [*]).
Divise f =>
NP f (a : as) -> f (NP I (a : as))
diviseN NP f xs
NP f (x : xs)
xs)

-- | Convenient helper function to build up a 'Conclude' by providing
-- each component of it.  This makes it much easier to build up longer
-- chains as opposed to nested calls to 'decide' and manually peeling off
-- eithers one-by-one.
--
-- For example, if you had a data type
--
-- @
-- data MyType = MTI Int | MTB Bool | MTS String
-- @
--
-- and a contravariant consumer @Builder@ (representing, say, a way to
-- serialize an item, where @intBuilder :: Builder Int@ is a serializer of
-- 'Int's), then you could assemble a serializer a @MyType@ using:
--
-- @
-- contramap (\case MTI x -> Z (I x); MTB y -> S (Z (I y)); MTS z -> S (S (Z (I z)))) $
--   concludeN $ intBuilder
--            :* boolBuilder
--            :* stringBuilder
--            :* Nil
-- @
--
-- Some notes on usefulness depending on how many components you have:
--
-- *    If you have 0 components, use 'conclude'.
-- *    If you have 1 component, use 'inject' directly.
-- *    If you have 2 components, use 'decide' directly.
-- *    If you have 3 or more components, these combinators may be useful;
--      otherwise you'd need to manually peel off eithers one-by-one.
--
-- @since 0.3.0.0
concludeN
    :: Conclude f
    => SOP.NP f as
    -> f (SOP.NS SOP.I as)
concludeN :: NP f as -> f (NS I as)
concludeN = \case
    SOP.Nil     -> (NS I as -> Void) -> f (NS I as)
forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude (\case {})
    x :: f x
x SOP.:* xs :: NP f xs
xs -> (NS I as -> Either x (NS I xs))
-> f x -> f (NS I xs) -> f (NS I as)
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide
      (\case SOP.Z y :: I x
y  -> x -> Either x (NS I xs)
forall a b. a -> Either a b
Left (I x -> x
forall a. I a -> a
SOP.unI I x
I x
y); SOP.S ys :: NS I xs
ys -> NS I xs -> Either x (NS I xs)
forall a b. b -> Either a b
Right NS I xs
ys)
      f x
x
      (NP f xs -> f (NS I xs)
forall (f :: * -> *) (as :: [*]).
Conclude f =>
NP f as -> f (NS I as)
concludeN NP f xs
xs)

-- | A version of 'concludeN' that works for non-empty 'SOP.NP'/'SOP.NS',
-- and so only requires a 'Decide' constraint.
--
-- @since 0.3.0.0
decideN
    :: Decide f
    => SOP.NP f (a ': as)
    -> f (SOP.NS SOP.I (a ': as))
decideN :: NP f (a : as) -> f (NS I (a : as))
decideN = \case
    x :: f x
x SOP.:* xs :: NP f xs
xs -> case NP f xs
xs of
      SOP.Nil    -> (NS I '[x] -> x) -> f x -> f (NS I '[x])
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (I x -> x
forall a. I a -> a
SOP.unI (I x -> x) -> (NS I '[x] -> I x) -> NS I '[x] -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS I '[x] -> I x
forall k (f :: k -> *) (x :: k). NS f '[x] -> f x
SOP.unZ) f x
x
      _ SOP.:* _ -> (NS I (a : as) -> Either x (NS I (x : xs)))
-> f x -> f (NS I (x : xs)) -> f (NS I (a : as))
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide
        (\case SOP.Z z :: I x
z -> x -> Either x (NS I (x : xs))
forall a b. a -> Either a b
Left (I x -> x
forall a. I a -> a
SOP.unI I x
I x
z); SOP.S zs :: NS I xs
zs -> NS I xs -> Either x (NS I xs)
forall a b. b -> Either a b
Right NS I xs
zs)
        f x
x
        (NP f (x : xs) -> f (NS I (x : xs))
forall (f :: * -> *) a (as :: [*]).
Decide f =>
NP f (a : as) -> f (NS I (a : as))
decideN NP f xs
NP f (x : xs)
xs)