    {-# LANGUAGE Trustworthy #-}
    module Data.Crosswalk (
        -- * Crosswalk
        Crosswalk (..),
        -- * Bicrosswalk
        Bicrosswalk (..),
        ) where

    import Control.Applicative   (pure, (<$>))
    import Data.Bifoldable       (Bifoldable (..))
    import Data.Bifunctor        (Bifunctor (..))
    import Data.Foldable         (Foldable (..))
    import Data.Functor.Compose  (Compose (..))
    import Data.Functor.Identity (Identity (..))
    import Data.Vector.Generic   (Vector)
    import Prelude               (Either (..), Functor (fmap), Maybe (..), id, (.))

    import qualified Data.Sequence       as Seq
    import qualified Data.Vector         as V
    import qualified Data.Vector.Generic as VG

    import Data.Align
    import Data.These

    -- --------------------------------------------------------------------------
    -- | Foldable functors supporting traversal through an alignable
    --   functor.
    --
    --   Minimal definition: @crosswalk@ or @sequenceL@.
    --
    --   Laws:
    --
    -- @
    -- crosswalk (const nil) = const nil
    -- crosswalk f = sequenceL . fmap f
    -- @
    class (Functor t, Foldable t) => Crosswalk t where
        crosswalk :: (Align f) => (a -> f b) -> t a -> f (t b)
        crosswalk a -> f b
    f = t (f b) -> f (t b)
    forall (t :: * -> *) (f :: * -> *) a.
    (Crosswalk t, Align f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Align f => t (f a) -> f (t a)
    sequenceL (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

        sequenceL :: (Align f) => t (f a) -> f (t a)
        sequenceL = (f a -> f a) -> t (f a) -> f (t a)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Crosswalk t, Align f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b. Align f => (a -> f b) -> t a -> f (t b)
    crosswalk f a -> f a
    forall a. a -> a
    id

        {-# MINIMAL crosswalk | sequenceL #-}

    instance Crosswalk Identity where
        crosswalk :: forall (f :: * -> *) a b.
    Align f =>
    (a -> f b) -> Identity a -> f (Identity b)
    crosswalk a -> f b
    f (Identity a
    a) = (b -> Identity b) -> f b -> f (Identity b)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap b -> Identity b
    forall a. a -> Identity a
    Identity (a -> f b
    f a
    a)

    instance Crosswalk Maybe where
        crosswalk :: forall (f :: * -> *) a b.
    Align f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    crosswalk a -> f b
    _ Maybe a
    Nothing = f (Maybe b)
    forall a. f a
    forall (f :: * -> *) a. Align f => f a
    nil
        crosswalk a -> f b
    f (Just a
    a) = b -> Maybe b
    forall a. a -> Maybe a
    Just (b -> Maybe b) -> f b -> f (Maybe b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f b
    f a
    a

    instance Crosswalk [] where
        crosswalk :: forall (f :: * -> *) a b. Align f => (a -> f b) -> [a] -> f [b]
    crosswalk a -> f b
    _ [] = f [b]
    forall a. f a
    forall (f :: * -> *) a. Align f => f a
    nil
        crosswalk a -> f b
    f (a
    x:[a]
    xs) = (These b [b] -> [b]) -> f b -> f [b] -> f [b]
    forall a b c. (These a b -> c) -> f a -> f b -> f c
    forall (f :: * -> *) a b c.
    Semialign f =>
    (These a b -> c) -> f a -> f b -> f c
    alignWith These b [b] -> [b]
    forall {a}. These a [a] -> [a]
    cons (a -> f b
    f a
    x) ((a -> f b) -> [a] -> f [b]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Crosswalk t, Align f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b. Align f => (a -> f b) -> [a] -> f [b]
    crosswalk a -> f b
    f [a]
    xs)
          where cons :: These a [a] -> [a]
    cons = (a -> [a])
    -> ([a] -> [a]) -> (a -> [a] -> [a]) -> These a [a] -> [a]
    forall a c b.
    (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
    these a -> [a]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [a] -> [a]
    forall a. a -> a
    id (:)

    instance Crosswalk Seq.Seq where
        crosswalk :: forall (f :: * -> *) a b.
    Align f =>
    (a -> f b) -> Seq a -> f (Seq b)
    crosswalk a -> f b
    f = (a -> f (Seq b) -> f (Seq b)) -> f (Seq b) -> Seq a -> f (Seq b)
    forall a b. (a -> b -> b) -> b -> Seq a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((These b (Seq b) -> Seq b) -> f b -> f (Seq b) -> f (Seq b)
    forall a b c. (These a b -> c) -> f a -> f b -> f c
    forall (f :: * -> *) a b c.
    Semialign f =>
    (These a b -> c) -> f a -> f b -> f c
    alignWith These b (Seq b) -> Seq b
    forall {a}. These a (Seq a) -> Seq a
    cons (f b -> f (Seq b) -> f (Seq b))
    -> (a -> f b) -> a -> f (Seq b) -> f (Seq b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> f b
    f) f (Seq b)
    forall a. f a
    forall (f :: * -> *) a. Align f => f a
    nil where
            cons :: These a (Seq a) -> Seq a
    cons = (a -> Seq a)
    -> (Seq a -> Seq a)
    -> (a -> Seq a -> Seq a)
    -> These a (Seq a)
    -> Seq a
    forall a c b.
    (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
    these a -> Seq a
    forall a. a -> Seq a
    Seq.singleton Seq a -> Seq a
    forall a. a -> a
    id a -> Seq a -> Seq a
    forall a. a -> Seq a -> Seq a
    (Seq.<|)

    instance Crosswalk (These a) where
        crosswalk :: forall (f :: * -> *) a b.
    Align f =>
    (a -> f b) -> These a a -> f (These a b)
    crosswalk a -> f b
    _ (This a
    _) = f (These a b)
    forall a. f a
    forall (f :: * -> *) a. Align f => f a
    nil
        crosswalk a -> f b
    f (That a
    x) = b -> These a b
    forall a b. b -> These a b
    That (b -> These a b) -> f b -> f (These a b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f b
    f a
    x
        crosswalk a -> f b
    f (These a
    a a
    x) = a -> b -> These a b
    forall a b. a -> b -> These a b
    These a
    a (b -> These a b) -> f b -> f (These a b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f b
    f a
    x

    crosswalkVector :: (Vector v a, Vector v b, Align f)
        => (a -> f b) -> v a -> f (v b)
    crosswalkVector :: forall (v :: * -> *) a b (f :: * -> *).
    (Vector v a, Vector v b, Align f) =>
    (a -> f b) -> v a -> f (v b)
    crosswalkVector a -> f b
    f = ([b] -> v b) -> f [b] -> f (v b)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [b] -> v b
    forall (v :: * -> *) a. Vector v a => [a] -> v a
    VG.fromList (f [b] -> f (v b)) -> (v a -> f [b]) -> v a -> f (v b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> f [b] -> f [b]) -> f [b] -> v a -> f [b]
    forall (v :: * -> *) a b.
    Vector v a =>
    (a -> b -> b) -> b -> v a -> b
    VG.foldr ((These b [b] -> [b]) -> f b -> f [b] -> f [b]
    forall a b c. (These a b -> c) -> f a -> f b -> f c
    forall (f :: * -> *) a b c.
    Semialign f =>
    (These a b -> c) -> f a -> f b -> f c
    alignWith These b [b] -> [b]
    forall {a}. These a [a] -> [a]
    cons (f b -> f [b] -> f [b]) -> (a -> f b) -> a -> f [b] -> f [b]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> f b
    f) f [b]
    forall a. f a
    forall (f :: * -> *) a. Align f => f a
    nil where
        cons :: These a [a] -> [a]
    cons = (a -> [a])
    -> ([a] -> [a]) -> (a -> [a] -> [a]) -> These a [a] -> [a]
    forall a c b.
    (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
    these a -> [a]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [a] -> [a]
    forall a. a -> a
    id (:)

    instance Crosswalk V.Vector where
        crosswalk :: forall (f :: * -> *) a b.
    Align f =>
    (a -> f b) -> Vector a -> f (Vector b)
    crosswalk = (a -> f b) -> Vector a -> f (Vector b)
    forall (v :: * -> *) a b (f :: * -> *).
    (Vector v a, Vector v b, Align f) =>
    (a -> f b) -> v a -> f (v b)
    crosswalkVector

    instance Crosswalk ((,) a) where
        crosswalk :: forall (f :: * -> *) a b.
    Align f =>
    (a -> f b) -> (a, a) -> f (a, b)
    crosswalk a -> f b
    fun (a
    a, a
    x) = (b -> (a, b)) -> f b -> f (a, b)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((,) a
    a) (a -> f b
    fun a
    x)

    -- can't (shouldn't) do longer tuples until there are Functor and Foldable
    -- instances for them

    instance (Crosswalk f, Crosswalk g) => Crosswalk (Compose f g) where
        crosswalk :: forall (f :: * -> *) a b.
    Align f =>
    (a -> f b) -> Compose f g a -> f (Compose f g b)
    crosswalk a -> f b
    f
            = (f (g b) -> Compose f g b) -> f (f (g b)) -> f (Compose f g b)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap f (g b) -> Compose f g b
    forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
    f (g a) -> Compose f g a
    Compose -- can't coerce: maybe the Align-able thing has role nominal
            (f (f (g b)) -> f (Compose f g b))
    -> (Compose f g a -> f (f (g b)))
    -> Compose f g a
    -> f (Compose f g b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (g a -> f (g b)) -> f (g a) -> f (f (g b))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Crosswalk t, Align f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b. Align f => (a -> f b) -> f a -> f (f b)
    crosswalk ((a -> f b) -> g a -> f (g b)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Crosswalk t, Align f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b. Align f => (a -> f b) -> g a -> f (g b)
    crosswalk a -> f b
    f)
            (f (g a) -> f (f (g b)))
    -> (Compose f g a -> f (g a)) -> Compose f g a -> f (f (g b))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Compose f g a -> f (g a)
    forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
    Compose f g a -> f (g a)
    getCompose

    -- --------------------------------------------------------------------------
    -- | Bifoldable bifunctors supporting traversal through an alignable
    --   functor.
    --
    --   Minimal definition: @bicrosswalk@ or @bisequenceL@.
    --
    --   Laws:
    --
    -- @
    -- bicrosswalk (const empty) (const empty) = const empty
    -- bicrosswalk f g = bisequenceL . bimap f g
    -- @
    class (Bifunctor t, Bifoldable t) => Bicrosswalk t where
        bicrosswalk :: (Align f) => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
        bicrosswalk a -> f c
    f b -> f d
    g = t (f c) (f d) -> f (t c d)
    forall (f :: * -> *) a b. Align f => t (f a) (f b) -> f (t a b)
    forall (t :: * -> * -> *) (f :: * -> *) a b.
    (Bicrosswalk t, Align f) =>
    t (f a) (f b) -> f (t a b)
    bisequenceL (t (f c) (f d) -> f (t c d))
    -> (t a b -> t (f c) (f d)) -> t a b -> f (t c d)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> f c) -> (b -> f d) -> t a b -> t (f c) (f d)
    forall a b c d. (a -> b) -> (c -> d) -> t a c -> t b d
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap a -> f c
    f b -> f d
    g

        bisequenceL :: (Align f) => t (f a) (f b) -> f (t a b)
        bisequenceL = (f a -> f a) -> (f b -> f b) -> t (f a) (f b) -> f (t a b)
    forall (f :: * -> *) a c b d.
    Align f =>
    (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
    forall (t :: * -> * -> *) (f :: * -> *) a c b d.
    (Bicrosswalk t, Align f) =>
    (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
    bicrosswalk f a -> f a
    forall a. a -> a
    id f b -> f b
    forall a. a -> a
    id

        {-# MINIMAL bicrosswalk | bisequenceL #-}

    instance Bicrosswalk Either where
        bicrosswalk :: forall (f :: * -> *) a c b d.
    Align f =>
    (a -> f c) -> (b -> f d) -> Either a b -> f (Either c d)
    bicrosswalk a -> f c
    f b -> f d
    _ (Left a
    x)  = c -> Either c d
    forall a b. a -> Either a b
    Left  (c -> Either c d) -> f c -> f (Either c d)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f c
    f a
    x
        bicrosswalk a -> f c
    _ b -> f d
    g (Right b
    x) = d -> Either c d
    forall a b. b -> Either a b
    Right (d -> Either c d) -> f d -> f (Either c d)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> b -> f d
    g b
    x

    instance Bicrosswalk These where
        bicrosswalk :: forall (f :: * -> *) a c b d.
    Align f =>
    (a -> f c) -> (b -> f d) -> These a b -> f (These c d)
    bicrosswalk a -> f c
    f b -> f d
    _ (This a
    x) = c -> These c d
    forall a b. a -> These a b
    This (c -> These c d) -> f c -> f (These c d)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f c
    f a
    x
        bicrosswalk a -> f c
    _ b -> f d
    g (That b
    x) = d -> These c d
    forall a b. b -> These a b
    That (d -> These c d) -> f d -> f (These c d)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> b -> f d
    g b
    x
        bicrosswalk a -> f c
    f b -> f d
    g (These a
    x b
    y) = f c -> f d -> f (These c d)
    forall a b. f a -> f b -> f (These a b)
    forall (f :: * -> *) a b.
    Semialign f =>
    f a -> f b -> f (These a b)
    align (a -> f c
    f a
    x) (b -> f d
    g b
    y)