-- |
-- Module      :   Grisette.Unified.Lib.Control.Applicative
-- Copyright   :   (c) Sirui Lu 2024
-- License     :   BSD-3-Clause (see the LICENSE file)
--
-- Maintainer  :   siruilu@cs.washington.edu
-- Stability   :   Experimental
-- Portability :   GHC only
module Grisette.Unified.Lib.Control.Applicative
  ( -- * Applicative Functors
    mrgPureWithStrategy,
    mrgPure,
    (.<*>),
    mrgLiftA2,
    (.*>),
    (.<*),

    -- * Alternatives
    mrgEmpty,
    (.<|>),
    mrgSome,
    mrgMany,

    -- * Utility functions
    (.<$>),
    (.<$),
    (.<**>),
    mrgLiftA,
    mrgLiftA3,
    mrgOptional,
    mrgAsum,
  )
where

import Control.Applicative (Alternative (empty, (<|>)), (<**>))
import Data.Functor (void)
import Grisette.Internal.Core.Data.Class.Mergeable
  ( Mergeable (rootStrategy),
    MergingStrategy,
  )
import Grisette.Internal.Core.Data.Class.TryMerge
  ( TryMerge,
    mrgSingleWithStrategy,
    tryMerge,
  )
import Grisette.Lib.Data.Functor ((.<$), (.<$>))

-- | Alias for 'mrgSingleWithStrategy'.
mrgPureWithStrategy ::
  (TryMerge m, Applicative m) => MergingStrategy a -> a -> m a
mrgPureWithStrategy :: forall (m :: * -> *) a.
(TryMerge m, Applicative m) =>
MergingStrategy a -> a -> m a
mrgPureWithStrategy = MergingStrategy a -> a -> m a
forall (m :: * -> *) a.
(TryMerge m, Applicative m) =>
MergingStrategy a -> a -> m a
mrgSingleWithStrategy
{-# INLINE mrgPureWithStrategy #-}

-- | Alias for 'Grisette.Core.mrgSingle'.
mrgPure :: (TryMerge m, Applicative m, Mergeable a) => a -> m a
mrgPure :: forall (m :: * -> *) a.
(TryMerge m, Applicative m, Mergeable a) =>
a -> m a
mrgPure = MergingStrategy a -> a -> m a
forall (m :: * -> *) a.
(TryMerge m, Applicative m) =>
MergingStrategy a -> a -> m a
mrgPureWithStrategy MergingStrategy a
forall a. Mergeable a => MergingStrategy a
rootStrategy
{-# INLINE mrgPure #-}

infixl 4 .<*>

-- | '<*>' with 'MergingStrategy' knowledge propagation.
(.<*>) ::
  (Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
  f (a -> b) ->
  f a ->
  f b
f (a -> b)
f .<*> :: forall (f :: * -> *) a b.
(Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
f (a -> b) -> f a -> f b
.<*> f a
a = f b -> f b
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (f b -> f b) -> f b -> f b
forall a b. (a -> b) -> a -> b
$ f (a -> b) -> f (a -> b)
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge f (a -> b)
f f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a -> f a
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge f a
a
{-# INLINE (.<*>) #-}

-- | 'liftA2' with 'MergingStrategy' knowledge propagation.
mrgLiftA2 ::
  (Applicative f, TryMerge f, Mergeable a, Mergeable b, Mergeable c) =>
  (a -> b -> c) ->
  f a ->
  f b ->
  f c
mrgLiftA2 :: forall (f :: * -> *) a b c.
(Applicative f, TryMerge f, Mergeable a, Mergeable b,
 Mergeable c) =>
(a -> b -> c) -> f a -> f b -> f c
mrgLiftA2 a -> b -> c
f f a
a f b
b = a -> b -> c
f (a -> b -> c) -> f a -> f (b -> c)
forall (f :: * -> *) a b.
(TryMerge f, Mergeable a, Mergeable b, Functor f) =>
(a -> b) -> f a -> f b
.<$> f a
a f (b -> c) -> f b -> f c
forall (f :: * -> *) a b.
(Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
f (a -> b) -> f a -> f b
.<*> f b -> f b
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge f b
b
{-# INLINE mrgLiftA2 #-}

infixl 4 .*>

-- | '*>' with 'MergingStrategy' knowledge propagation.
(.*>) ::
  (Applicative f, TryMerge f, Mergeable a, Mergeable b) => f a -> f b -> f b
f a
a .*> :: forall (f :: * -> *) a b.
(Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
f a -> f b -> f b
.*> f b
b = f b -> f b
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (f b -> f b) -> f b -> f b
forall a b. (a -> b) -> a -> b
$ f () -> f ()
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (f a -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f a
a) f () -> f b -> f b
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f b -> f b
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge f b
b
{-# INLINE (.*>) #-}

infixl 4 .<*

-- | '<*' with 'MergingStrategy' knowledge propagation.
(.<*) ::
  (Applicative f, TryMerge f, Mergeable a, Mergeable b) => f a -> f b -> f a
f a
a .<* :: forall (f :: * -> *) a b.
(Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
f a -> f b -> f a
.<* f b
b = f a -> f a
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (f a -> f a) -> f a -> f a
forall a b. (a -> b) -> a -> b
$ f a -> f a
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge f a
a f a -> f () -> f a
forall a b. f a -> f b -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f () -> f ()
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (f b -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f b
b)
{-# INLINE (.<*) #-}

-- | 'empty' with 'MergingStrategy' knowledge propagation.
mrgEmpty :: (Alternative f, TryMerge f, Mergeable a) => f a
mrgEmpty :: forall (f :: * -> *) a.
(Alternative f, TryMerge f, Mergeable a) =>
f a
mrgEmpty = f a -> f a
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge f a
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE mrgEmpty #-}

infixl 3 .<|>

-- | '<|>' with 'MergingStrategy' knowledge propagation.
(.<|>) :: (Alternative f, TryMerge f, Mergeable a) => f a -> f a -> f a
f a
a .<|> :: forall (f :: * -> *) a.
(Alternative f, TryMerge f, Mergeable a) =>
f a -> f a -> f a
.<|> f a
b = f a -> f a
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (f a -> f a) -> f a -> f a
forall a b. (a -> b) -> a -> b
$ f a -> f a
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge f a
a f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a -> f a
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge f a
b
{-# INLINE (.<|>) #-}

-- | 'Control.Applicative.some' with 'MergingStrategy' knowledge propagation.
mrgSome :: (Alternative f, TryMerge f, Mergeable a) => f a -> f [a]
mrgSome :: forall (f :: * -> *) a.
(Alternative f, TryMerge f, Mergeable a) =>
f a -> f [a]
mrgSome f a
v = f [a]
some_v
  where
    many_v :: f [a]
many_v = f [a]
some_v f [a] -> f [a] -> f [a]
forall (f :: * -> *) a.
(Alternative f, TryMerge f, Mergeable a) =>
f a -> f a -> f a
.<|> [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    some_v :: f [a]
some_v = (a -> [a] -> [a]) -> f a -> f [a] -> f [a]
forall (f :: * -> *) a b c.
(Applicative f, TryMerge f, Mergeable a, Mergeable b,
 Mergeable c) =>
(a -> b -> c) -> f a -> f b -> f c
mrgLiftA2 (:) f a
v f [a]
many_v
{-# INLINE mrgSome #-}

-- | 'Control.Applicative.many' with 'MergingStrategy' knowledge propagation.
mrgMany :: (Alternative f, TryMerge f, Mergeable a) => f a -> f [a]
mrgMany :: forall (f :: * -> *) a.
(Alternative f, TryMerge f, Mergeable a) =>
f a -> f [a]
mrgMany f a
v = f [a]
many_v
  where
    many_v :: f [a]
many_v = f [a]
some_v f [a] -> f [a] -> f [a]
forall (f :: * -> *) a.
(Alternative f, TryMerge f, Mergeable a) =>
f a -> f a -> f a
.<|> [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    some_v :: f [a]
some_v = (a -> [a] -> [a]) -> f a -> f [a] -> f [a]
forall (f :: * -> *) a b c.
(Applicative f, TryMerge f, Mergeable a, Mergeable b,
 Mergeable c) =>
(a -> b -> c) -> f a -> f b -> f c
mrgLiftA2 (:) f a
v f [a]
many_v
{-# INLINE mrgMany #-}

infixl 4 .<**>

-- | 'Control.Applicative.<**>' with 'MergingStrategy' knowledge propagation.
(.<**>) ::
  (Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
  f a ->
  f (a -> b) ->
  f b
f a
a .<**> :: forall (f :: * -> *) a b.
(Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
f a -> f (a -> b) -> f b
.<**> f (a -> b)
f = f b -> f b
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge (f b -> f b) -> f b -> f b
forall a b. (a -> b) -> a -> b
$ f a -> f a
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge f a
a f a -> f (a -> b) -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> f (a -> b) -> f (a -> b)
forall (m :: * -> *) a. (TryMerge m, Mergeable a) => m a -> m a
tryMerge f (a -> b)
f
{-# INLINE (.<**>) #-}

-- | 'Control.Applicative.liftA' with 'MergingStrategy' knowledge propagation.
mrgLiftA ::
  (Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
  (a -> b) ->
  f a ->
  f b
mrgLiftA :: forall (f :: * -> *) a b.
(Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
(a -> b) -> f a -> f b
mrgLiftA a -> b
f f a
a = (a -> b) -> f (a -> b)
forall (m :: * -> *) a.
(TryMerge m, Applicative m, Mergeable a) =>
a -> m a
mrgPure a -> b
f f (a -> b) -> f a -> f b
forall (f :: * -> *) a b.
(Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
f (a -> b) -> f a -> f b
.<*> f a
a
{-# INLINE mrgLiftA #-}

-- | 'Control.Applicative.liftA3' with 'MergingStrategy' knowledge propagation.
mrgLiftA3 ::
  ( Applicative f,
    TryMerge f,
    Mergeable a,
    Mergeable b,
    Mergeable c,
    Mergeable d
  ) =>
  (a -> b -> c -> d) ->
  f a ->
  f b ->
  f c ->
  f d
mrgLiftA3 :: forall (f :: * -> *) a b c d.
(Applicative f, TryMerge f, Mergeable a, Mergeable b, Mergeable c,
 Mergeable d) =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
mrgLiftA3 a -> b -> c -> d
f f a
a f b
b f c
c = (a -> b -> c -> d) -> f (a -> b -> c -> d)
forall (m :: * -> *) a.
(TryMerge m, Applicative m, Mergeable a) =>
a -> m a
mrgPure a -> b -> c -> d
f f (a -> b -> c -> d) -> f a -> f (b -> c -> d)
forall (f :: * -> *) a b.
(Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
f (a -> b) -> f a -> f b
.<*> f a
a f (b -> c -> d) -> f b -> f (c -> d)
forall (f :: * -> *) a b.
(Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
f (a -> b) -> f a -> f b
.<*> f b
b f (c -> d) -> f c -> f d
forall (f :: * -> *) a b.
(Applicative f, TryMerge f, Mergeable a, Mergeable b) =>
f (a -> b) -> f a -> f b
.<*> f c
c
{-# INLINE mrgLiftA3 #-}

-- | 'Control.Applicative.optional' with 'MergingStrategy' knowledge propagation.
mrgOptional ::
  (Alternative f, TryMerge f, Mergeable a) =>
  f a ->
  f (Maybe a)
mrgOptional :: forall (f :: * -> *) a.
(Alternative f, TryMerge f, Mergeable a) =>
f a -> f (Maybe a)
mrgOptional f a
v = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> f a -> f (Maybe a)
forall (f :: * -> *) a b.
(TryMerge f, Mergeable a, Mergeable b, Functor f) =>
(a -> b) -> f a -> f b
.<$> f a
v f (Maybe a) -> f (Maybe a) -> f (Maybe a)
forall (f :: * -> *) a.
(Alternative f, TryMerge f, Mergeable a) =>
f a -> f a -> f a
.<|> Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
{-# INLINE mrgOptional #-}

-- | 'Control.Applicative.asum' with 'MergingStrategy' knowledge propagation.
mrgAsum ::
  (Alternative f, TryMerge f, Mergeable a, Foldable t) => t (f a) -> f a
mrgAsum :: forall (f :: * -> *) a (t :: * -> *).
(Alternative f, TryMerge f, Mergeable a, Foldable t) =>
t (f a) -> f a
mrgAsum = (f a -> f a -> f a) -> f a -> t (f a) -> f a
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr f a -> f a -> f a
forall (f :: * -> *) a.
(Alternative f, TryMerge f, Mergeable a) =>
f a -> f a -> f a
(.<|>) f a
forall (f :: * -> *) a.
(Alternative f, TryMerge f, Mergeable a) =>
f a
mrgEmpty
{-# INLINE mrgAsum #-}