module Contravariant.Extras
(
  {-|
  @contrazip@ functions of multiple arities.
  -}
  module Contravariant.Extras.Contrazip,
  {-|
  @contrazipLifting@ functions of multiple arities.
  -}
  module Contravariant.Extras.ContrazipLifting,
  (>*<),
  contramany,
  Supplied(..),
)
where

import Contravariant.Extras.Prelude hiding ((<>))
import Contravariant.Extras.Contrazip
import Contravariant.Extras.ContrazipLifting
import Data.Functor.Contravariant.Divisible
import Data.Semigroup (Semigroup ((<>)))


-- |
-- An alias to 'divided'.
{-# INLINE (>*<) #-}
(>*<) :: Divisible f => f a -> f b -> f (a, b)
>*< :: forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
(>*<) =
  f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
divided

contramany :: Decidable f => f a -> f [a]
contramany :: forall (f :: * -> *) a. Decidable f => f a -> f [a]
contramany f a
f =
  f [a]
loop
  where
    loop :: f [a]
loop =
      ([a] -> Either (a, [a]) ()) -> f (a, [a]) -> f () -> f [a]
forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose [a] -> Either (a, [a]) ()
forall {a}. [a] -> Either (a, [a]) ()
chooser f (a, [a])
cons f ()
forall {f :: * -> *} {a}. Divisible f => f a
nil
      where
        chooser :: [a] -> Either (a, [a]) ()
chooser =
          \case
            a
head : [a]
tail ->
              (a, [a]) -> Either (a, [a]) ()
forall a b. a -> Either a b
Left (a
head, [a]
tail)
            [a]
_ ->
              () -> Either (a, [a]) ()
forall a b. b -> Either a b
Right ()
        cons :: f (a, [a])
cons =
          ((a, [a]) -> (a, [a])) -> f a -> f [a] -> f (a, [a])
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (a, [a]) -> (a, [a])
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id f a
f f [a]
loop
        nil :: f a
nil =
          f a
forall (f :: * -> *) a. Divisible f => f a
conquer

-- |
-- A combination of a divisible functor with some input for it.
-- Allows to use the 'Monoid' API for composition.
data Supplied divisible =
  forall input. Supplied (divisible input) input

instance Divisible divisible => Semigroup (Supplied divisible) where
  Supplied divisible input
divisible1 input
input1 <> :: Supplied divisible -> Supplied divisible -> Supplied divisible
<> Supplied divisible input
divisible2 input
input2 =
    divisible (input, input) -> (input, input) -> Supplied divisible
forall (divisible :: * -> *) input.
divisible input -> input -> Supplied divisible
Supplied divisible (input, input)
divisible3 (input, input)
input3
    where
      divisible3 :: divisible (input, input)
divisible3 =
        ((input, input) -> (input, input))
-> divisible input -> divisible input -> divisible (input, input)
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (input, input) -> (input, input)
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id divisible input
divisible1 divisible input
divisible2
      input3 :: (input, input)
input3 =
        (input
input1, input
input2)

instance Divisible divisible => Monoid (Supplied divisible) where
  mempty :: Supplied divisible
mempty =
    divisible () -> () -> Supplied divisible
forall (divisible :: * -> *) input.
divisible input -> input -> Supplied divisible
Supplied divisible ()
forall (f :: * -> *) a. Divisible f => f a
conquer ()
  mappend :: Supplied divisible -> Supplied divisible -> Supplied divisible
mappend =
    Supplied divisible -> Supplied divisible -> Supplied divisible
forall a. Semigroup a => a -> a -> a
(<>)