{-# LANGUAGE CPP #-}
{-# 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 f :: a -> f b
f = t (f b) -> f (t b)
forall (t :: * -> *) (f :: * -> *) a.
(Crosswalk t, 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 (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)
crosswalk f a -> f a
forall a. a -> a
id
#if __GLASGOW_HASKELL__ >= 707
{-# MINIMAL crosswalk | sequenceL #-}
#endif
instance Crosswalk Identity where
crosswalk :: (a -> f b) -> Identity a -> f (Identity b)
crosswalk f :: a -> f b
f (Identity a :: a
a) = (b -> Identity b) -> f b -> f (Identity 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 :: (a -> f b) -> Maybe a -> f (Maybe b)
crosswalk _ Nothing = f (Maybe b)
forall (f :: * -> *) a. Align f => f a
nil
crosswalk f :: a -> f b
f (Just a :: 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 :: (a -> f b) -> [a] -> f [b]
crosswalk _ [] = f [b]
forall (f :: * -> *) a. Align f => f a
nil
crosswalk f :: a -> f b
f (x :: a
x:xs :: [a]
xs) = (These b [b] -> [b]) -> f b -> f [b] -> f [b]
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)
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 (f :: * -> *) a. Applicative f => a -> f a
pure [a] -> [a]
forall a. a -> a
id (:)
instance Crosswalk Seq.Seq where
crosswalk :: (a -> f b) -> Seq a -> f (Seq b)
crosswalk f :: a -> f b
f = (a -> f (Seq b) -> f (Seq b)) -> f (Seq b) -> Seq a -> f (Seq 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 (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 (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 :: (a -> f b) -> These a a -> f (These a b)
crosswalk _ (This _) = f (These a b)
forall (f :: * -> *) a. Align f => f a
nil
crosswalk f :: a -> f b
f (That x :: 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 f :: a -> f b
f (These a :: a
a x :: 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 :: (a -> f b) -> v a -> f (v b)
crosswalkVector f :: a -> f b
f = ([b] -> v b) -> f [b] -> f (v 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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure [a] -> [a]
forall a. a -> a
id (:)
instance Crosswalk V.Vector where
crosswalk :: (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 :: (a -> f b) -> (a, a) -> f (a, b)
crosswalk fun :: a -> f b
fun (a :: a
a, x :: a
x) = (b -> (a, b)) -> f b -> f (a, 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 :: (a -> f b) -> Compose f g a -> f (Compose f g b)
crosswalk f :: a -> f b
f
= (f (g b) -> Compose f g b) -> f (f (g b)) -> f (Compose f g 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)
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)
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 (f :: k1 -> *) k2 (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 f :: a -> f c
f g :: b -> f d
g = t (f c) (f d) -> f (t c d)
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 (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 (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
#if __GLASGOW_HASKELL__ >= 707
{-# MINIMAL bicrosswalk | bisequenceL #-}
#endif
instance Bicrosswalk Either where
bicrosswalk :: (a -> f c) -> (b -> f d) -> Either a b -> f (Either c d)
bicrosswalk f :: a -> f c
f _ (Left x :: 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 _ g :: b -> f d
g (Right x :: 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 :: (a -> f c) -> (b -> f d) -> These a b -> f (These c d)
bicrosswalk f :: a -> f c
f _ (This x :: 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 _ g :: b -> f d
g (That x :: 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 f :: a -> f c
f g :: b -> f d
g (These x :: a
x y :: b
y) = f c -> f d -> f (These c d)
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)