{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Fresnel.Functor.Traversed
( -- * Traversed functor
  runTraversed
, Traversed(..)
) where

import Data.Functor (void)

-- Traversed functor

runTraversed :: Functor f => Traversed f a -> f ()
runTraversed :: forall (f :: * -> *) a. Functor f => Traversed f a -> f ()
runTraversed (Traversed f a
fa) = f a -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f a
fa

newtype Traversed f a = Traversed (f a)
  deriving (Functor (Traversed f)
Functor (Traversed f) =>
(forall a. a -> Traversed f a)
-> (forall a b.
    Traversed f (a -> b) -> Traversed f a -> Traversed f b)
-> (forall a b c.
    (a -> b -> c) -> Traversed f a -> Traversed f b -> Traversed f c)
-> (forall a b. Traversed f a -> Traversed f b -> Traversed f b)
-> (forall a b. Traversed f a -> Traversed f b -> Traversed f a)
-> Applicative (Traversed f)
forall a. a -> Traversed f a
forall a b. Traversed f a -> Traversed f b -> Traversed f a
forall a b. Traversed f a -> Traversed f b -> Traversed f b
forall a b. Traversed f (a -> b) -> Traversed f a -> Traversed f b
forall a b c.
(a -> b -> c) -> Traversed f a -> Traversed f b -> Traversed f c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (f :: * -> *). Applicative f => Functor (Traversed f)
forall (f :: * -> *) a. Applicative f => a -> Traversed f a
forall (f :: * -> *) a b.
Applicative f =>
Traversed f a -> Traversed f b -> Traversed f a
forall (f :: * -> *) a b.
Applicative f =>
Traversed f a -> Traversed f b -> Traversed f b
forall (f :: * -> *) a b.
Applicative f =>
Traversed f (a -> b) -> Traversed f a -> Traversed f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> Traversed f a -> Traversed f b -> Traversed f c
$cpure :: forall (f :: * -> *) a. Applicative f => a -> Traversed f a
pure :: forall a. a -> Traversed f a
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
Traversed f (a -> b) -> Traversed f a -> Traversed f b
<*> :: forall a b. Traversed f (a -> b) -> Traversed f a -> Traversed f b
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> Traversed f a -> Traversed f b -> Traversed f c
liftA2 :: forall a b c.
(a -> b -> c) -> Traversed f a -> Traversed f b -> Traversed f c
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
Traversed f a -> Traversed f b -> Traversed f b
*> :: forall a b. Traversed f a -> Traversed f b -> Traversed f b
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
Traversed f a -> Traversed f b -> Traversed f a
<* :: forall a b. Traversed f a -> Traversed f b -> Traversed f a
Applicative, (forall a b. (a -> b) -> Traversed f a -> Traversed f b)
-> (forall a b. a -> Traversed f b -> Traversed f a)
-> Functor (Traversed f)
forall a b. a -> Traversed f b -> Traversed f a
forall a b. (a -> b) -> Traversed f a -> Traversed f b
forall (f :: * -> *) a b.
Functor f =>
a -> Traversed f b -> Traversed f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Traversed f a -> Traversed f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Traversed f a -> Traversed f b
fmap :: forall a b. (a -> b) -> Traversed f a -> Traversed f b
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> Traversed f b -> Traversed f a
<$ :: forall a b. a -> Traversed f b -> Traversed f a
Functor)

instance Applicative f => Semigroup (Traversed f a) where
  Traversed f a
a1 <> :: Traversed f a -> Traversed f a -> Traversed f a
<> Traversed f a
a2 = f a -> Traversed f a
forall (f :: * -> *) a. f a -> Traversed f a
Traversed (f a
a1 f a -> f a -> f a
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a
a2)

instance Applicative f => Monoid (Traversed f a) where
  mempty :: Traversed f a
mempty = f a -> Traversed f a
forall (f :: * -> *) a. f a -> Traversed f a
Traversed (a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Traversed.mempty: value used"))