content: {-# LANGUAGE RankNTypes #-}
  module Fresnel.Profunctor.Traversing1
  ( Traversing1(..)
    -- ** Profunctor from Traversing1
  , dimapTraversing1
  , lmapTraversing1
  , rmapTraversing1
    -- ** Strong from Traversing1
  , firstTraversing1
  , secondTraversing1
  ) where
  
  import Control.Arrow (Kleisli(..))
  import Data.Functor.Apply
  import Data.Functor.Const
  import Data.Functor.Identity
  import Data.Profunctor (Forget(..), Star(..), Strong)
  import Data.Profunctor.Unsafe ((#.))
  import Fresnel.Profunctor.OptionalStar (OptionalStar(..))
  
  class Strong p => Traversing1 p where
    wander1 :: (forall f . Apply f => (a -> f b) -> (s -> f t)) -> (p a b -> p s t)
  
  instance Traversing1 (->) where
    wander1 f g = runIdentity . f (Identity . g)
  
  instance Monad m => Traversing1 (Kleisli m) where
    wander1 f (Kleisli k) = Kleisli (unwrapApplicative . f (WrapApplicative . k))
  
  instance Semigroup r => Traversing1 (Forget r) where
    wander1 f (Forget k) = Forget (getConst #. f (Const #. k))
  
  instance Applicative f => Traversing1 (Star f) where
    wander1 f (Star k) = Star (unwrapApplicative . f (WrapApplicative . k))
  
  instance Apply f => Traversing1 (OptionalStar f) where
    wander1 f (OptionalStar k) = OptionalStar (\ k' -> k (\ p -> k' p . f))
  
  
  -- Profunctor from Traversing1
  
  dimapTraversing1 :: Traversing1 p => (a' -> a) -> (b -> b') -> (p a b -> p a' b')
  dimapTraversing1 f g = wander1 (\ k -> fmap g . k . f)
  
  lmapTraversing1 :: Traversing1 p => (a' -> a) -> (p a b -> p a' b)
  lmapTraversing1 f = wander1 (. f)
  
  rmapTraversing1 :: Traversing1 p => (b -> b') -> (p a b -> p a b')
  rmapTraversing1 f = wander1 (fmap f .)
  
  
  -- Strong from Traversing1
  
  
  firstTraversing1 :: Traversing1 p => p a b -> p (a, c) (b, c)
  firstTraversing1 = wander1 (\ k (a, c) -> flip (,) c <$> k a)
  
  secondTraversing1 :: Traversing1 p => p a b -> p (c, a) (c, b)
  secondTraversing1 = wander1 (\ k (c, a) -> (,) c <$> k a)
  