{-# LANGUAGE Trustworthy #-}
module Data.Crosswalk (
Crosswalk (..),
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
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)
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
(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
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)