module Control.Functor.Utils
    ( Pure (pure')
    , TraversableF (traverseF, sequenceF)
    , traverseEither
    , sequenceEither
    )
where

import Control.Monad.Identity (Identity)

-- | Like 'Applicative', but without @<*>@.
--   For any instance of both 'Applicative' and 'Pure', it should hold
--   @pure' = pure@.
class (Functor f) => Pure f where
    pure' :: a -> f a

instance Pure Identity where
    pure' :: forall a. a -> Identity a
pure' = a -> Identity a
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Pure (Either e) where
    pure' :: forall a. a -> Either e a
pure' = a -> Either e a
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | A variant of 'Data.Traversable.Traversable' with weaker constraints.
--
--   In particular, 'traverseF' and 'sequenceF' weaken the 'Applicative'
--   constraint to a 'Functor' constraint.
--
--   Among the type class constraints, the 'Functor' constraint is obvious,
--   for 'fmap' can be implemented using 'traverseF'.
--   The 'Foldable' constraint, however, which is present for
--   'Data.Traversable.Traversable', is debatable, and was removed for
--   convenience.
--
--   It is debatable whether the class and function names are fitting.
class (Functor t) => TraversableF t where
    {-# MINIMAL traverseF | sequenceF #-}

    -- | Like 'Data.Traversable.traverse', but with weaker constraints.
    traverseF :: (Functor f) => (a -> f b) -> t a -> f (t b)
    traverseF a -> f b
f = t (f b) -> f (t b)
forall (t :: * -> *) (f :: * -> *) a.
(TraversableF t, Functor f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Functor f => t (f a) -> f (t a)
sequenceF (t (f b) -> f (t b)) -> (t a -> t (f b)) -> t a -> f (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> t a -> t (f b)
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> f b
f

    -- | Like 'Data.Traversable.sequenceA', but with weaker constraints.
    sequenceF :: (Functor f) => t (f a) -> f (t a)
    sequenceF = (f a -> f a) -> t (f a) -> f (t a)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableF t, Functor f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b. Functor f => (a -> f b) -> t a -> f (t b)
traverseF f a -> f a
forall a. a -> a
id

-- | Like 'Data.Traversable.traverse' and 'traverseF', for 'Either e', and
--   with constraint in between.
--   This could also defined via a corresponding type class, but we'd only
--   need this one instance.
traverseEither :: (Pure f) => (a -> f b) -> Either e a -> f (Either e b)
traverseEither :: forall (f :: * -> *) a b e.
Pure f =>
(a -> f b) -> Either e a -> f (Either e b)
traverseEither a -> f b
_ (Left e
e) = e -> Either e b
forall a b. a -> Either a b
Left (e -> Either e b) -> f e -> f (Either e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> f e
forall a. a -> f a
forall (f :: * -> *) a. Pure f => a -> f a
pure' e
e
traverseEither a -> f b
f (Right a
x) = b -> Either e b
forall e a. a -> Either e a
Right (b -> Either e b) -> f b -> f (Either e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

-- | Variant of 'Data.Traversable.sequenceA', like 'traverseEither' is a
--   variant of 'Data.Traversable.traverse'.
sequenceEither :: (Pure f) => Either e (f a) -> f (Either e a)
sequenceEither :: forall (f :: * -> *) e a.
Pure f =>
Either e (f a) -> f (Either e a)
sequenceEither = (f a -> f a) -> Either e (f a) -> f (Either e a)
forall (f :: * -> *) a b e.
Pure f =>
(a -> f b) -> Either e a -> f (Either e b)
traverseEither f a -> f a
forall a. a -> a
id