{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveFunctor #-}
module Data.Matchable(
Matchable(..),
zipzipMatch,
fmapRecovered,
eqDefault,
liftEqDefault,
Matchable'(), genericZipMatchWith,
) where
import Control.Applicative
import Data.Functor.Classes
import Data.Maybe (fromMaybe, isJust)
import Data.Foldable
import Data.Functor.Identity
import Data.Functor.Compose
import Data.Functor.Product
import Data.Functor.Sum
import Data.Tagged
import Data.Proxy
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import Data.IntMap.Lazy (IntMap)
import qualified Data.IntMap.Lazy as IntMap
import qualified Data.IntMap.Merge.Lazy as IntMap
import Data.Tree (Tree)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Data.Hashable (Hashable)
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HashMap
import GHC.Generics
class (Eq1 t, Functor t) => Matchable t where
zipMatch :: t a -> t b -> Maybe (t (a,b))
zipMatch = forall (t :: * -> *) a b c.
Matchable t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall a. a -> Maybe a
Just)
zipMatchWith :: (a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
{-# MINIMAL zipMatchWith #-}
zipzipMatch
:: (Matchable t, Matchable u)
=> t (u a)
-> t (u b)
-> Maybe (t (u (a, b)))
zipzipMatch :: forall (t :: * -> *) (u :: * -> *) a b.
(Matchable t, Matchable u) =>
t (u a) -> t (u b) -> Maybe (t (u (a, b)))
zipzipMatch = forall (t :: * -> *) a b c.
Matchable t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith forall (t :: * -> *) a b.
Matchable t =>
t a -> t b -> Maybe (t (a, b))
zipMatch
fmapRecovered :: (Matchable t) => (a -> b) -> t a -> t b
fmapRecovered :: forall (t :: * -> *) a b. Matchable t => (a -> b) -> t a -> t b
fmapRecovered a -> b
f t a
ta =
forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Law-violating Matchable instance") forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b c.
Matchable t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith (\a
a a
_ -> forall a. a -> Maybe a
Just (a -> b
f a
a)) t a
ta t a
ta
eqDefault :: (Matchable t, Eq a) => t a -> t a -> Bool
eqDefault :: forall (t :: * -> *) a. (Matchable t, Eq a) => t a -> t a -> Bool
eqDefault = forall (t :: * -> *) a b.
Matchable t =>
(a -> b -> Bool) -> t a -> t b -> Bool
liftEqDefault forall a. Eq a => a -> a -> Bool
(==)
liftEqDefault :: (Matchable t) => (a -> b -> Bool) -> t a -> t b -> Bool
liftEqDefault :: forall (t :: * -> *) a b.
Matchable t =>
(a -> b -> Bool) -> t a -> t b -> Bool
liftEqDefault a -> b -> Bool
eq t a
tx t b
ty =
let u :: a -> b -> Maybe ()
u a
x b
y = if a
x a -> b -> Bool
`eq` b
y then forall a. a -> Maybe a
Just () else forall a. Maybe a
Nothing
in forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b c.
Matchable t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith a -> b -> Maybe ()
u t a
tx t b
ty
instance Matchable Identity where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c)
-> Identity a -> Identity b -> Maybe (Identity c)
zipMatchWith = forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
instance (Eq k) => Matchable (Const k) where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c) -> Const k a -> Const k b -> Maybe (Const k c)
zipMatchWith = forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
instance (Matchable f, Matchable g) => Matchable (Product f g) where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c)
-> Product f g a -> Product f g b -> Maybe (Product f g c)
zipMatchWith = forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
instance (Matchable f, Matchable g) => Matchable (Sum f g) where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c) -> Sum f g a -> Sum f g b -> Maybe (Sum f g c)
zipMatchWith = forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
instance (Matchable f, Matchable g) => Matchable (Compose f g) where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c)
-> Compose f g a -> Compose f g b -> Maybe (Compose f g c)
zipMatchWith = forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
instance Matchable Proxy where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c) -> Proxy a -> Proxy b -> Maybe (Proxy c)
zipMatchWith a -> b -> Maybe c
_ Proxy a
_ Proxy b
_ = forall a. a -> Maybe a
Just forall {k} (t :: k). Proxy t
Proxy
instance Matchable (Tagged t) where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c)
-> Tagged t a -> Tagged t b -> Maybe (Tagged t c)
zipMatchWith = forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
instance Matchable Maybe where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c) -> Maybe a -> Maybe b -> Maybe (Maybe c)
zipMatchWith = forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
instance Matchable [] where
zipMatchWith :: forall a b c. (a -> b -> Maybe c) -> [a] -> [b] -> Maybe [c]
zipMatchWith = forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
instance Matchable NonEmpty where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c)
-> NonEmpty a -> NonEmpty b -> Maybe (NonEmpty c)
zipMatchWith = forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
instance (Eq e) => Matchable ((,) e) where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c) -> (e, a) -> (e, b) -> Maybe (e, c)
zipMatchWith = forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
instance (Eq e) => Matchable (Either e) where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c)
-> Either e a -> Either e b -> Maybe (Either e c)
zipMatchWith = forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
instance Matchable Seq where
zipMatch :: forall a b. Seq a -> Seq b -> Maybe (Seq (a, b))
zipMatch Seq a
as Seq b
bs
| forall a. Seq a -> Int
Seq.length Seq a
as forall a. Eq a => a -> a -> Bool
== forall a. Seq a -> Int
Seq.length Seq b
bs = forall a. a -> Maybe a
Just (forall a b. Seq a -> Seq b -> Seq (a, b)
Seq.zip Seq a
as Seq b
bs)
| Bool
otherwise = forall a. Maybe a
Nothing
zipMatchWith :: forall a b c.
(a -> b -> Maybe c) -> Seq a -> Seq b -> Maybe (Seq c)
zipMatchWith a -> b -> Maybe c
u Seq a
as Seq b
bs
| forall a. Seq a -> Int
Seq.length Seq a
as forall a. Eq a => a -> a -> Bool
== forall a. Seq a -> Int
Seq.length Seq b
bs = forall (f :: * -> *) a b c.
Traversable f =>
(a -> b -> Maybe c) -> f a -> [b] -> Maybe (f c)
unsafeFillIn a -> b -> Maybe c
u Seq a
as (forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Seq b
bs)
| Bool
otherwise = forall a. Maybe a
Nothing
instance (Eq k) => Matchable (Map k) where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c) -> Map k a -> Map k b -> Maybe (Map k c)
zipMatchWith a -> b -> Maybe c
u Map k a
as Map k b
bs
| forall k a. Map k a -> Int
Map.size Map k a
as forall a. Eq a => a -> a -> Bool
== forall k a. Map k a -> Int
Map.size Map k b
bs =
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) a b c.
Matchable t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith (forall (t :: * -> *) a b c.
Matchable t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith a -> b -> Maybe c
u) (forall k a. Map k a -> [(k, a)]
Map.toAscList Map k a
as) (forall k a. Map k a -> [(k, a)]
Map.toAscList Map k b
bs)
| Bool
otherwise = forall a. Maybe a
Nothing
instance Matchable IntMap where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c) -> IntMap a -> IntMap b -> Maybe (IntMap c)
zipMatchWith a -> b -> Maybe c
u IntMap a
as IntMap b
bs
| forall a. IntMap a -> Int
IntMap.size IntMap a
as forall a. Eq a => a -> a -> Bool
== forall a. IntMap a -> Int
IntMap.size IntMap b
bs = IntMap a -> IntMap b -> Maybe (IntMap c)
merger IntMap a
as IntMap b
bs
| Bool
otherwise = forall a. Maybe a
Nothing
where
miss :: WhenMissing Maybe x y
miss = forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> f y) -> WhenMissing f x y
IntMap.traverseMissing (\Int
_ x
_ -> forall a. Maybe a
Nothing)
merger :: IntMap a -> IntMap b -> Maybe (IntMap c)
merger = forall (f :: * -> *) a c b.
Applicative f =>
WhenMissing f a c
-> WhenMissing f b c
-> WhenMatched f a b c
-> IntMap a
-> IntMap b
-> f (IntMap c)
IntMap.mergeA forall {x} {y}. WhenMissing Maybe x y
miss forall {x} {y}. WhenMissing Maybe x y
miss (forall (f :: * -> *) x y z.
Applicative f =>
(Int -> x -> y -> f z) -> WhenMatched f x y z
IntMap.zipWithAMatched (forall a b. a -> b -> a
const a -> b -> Maybe c
u))
instance Matchable Tree where
zipMatchWith :: forall a b c.
(a -> b -> Maybe c) -> Tree a -> Tree b -> Maybe (Tree c)
zipMatchWith = forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
instance Matchable Vector where
zipMatch :: forall a b. Vector a -> Vector b -> Maybe (Vector (a, b))
zipMatch Vector a
as Vector b
bs
| forall a. Vector a -> Int
Vector.length Vector a
as forall a. Eq a => a -> a -> Bool
== forall a. Vector a -> Int
Vector.length Vector b
bs = forall a. a -> Maybe a
Just (forall a b. Vector a -> Vector b -> Vector (a, b)
Vector.zip Vector a
as Vector b
bs)
| Bool
otherwise = forall a. Maybe a
Nothing
zipMatchWith :: forall a b c.
(a -> b -> Maybe c) -> Vector a -> Vector b -> Maybe (Vector c)
zipMatchWith a -> b -> Maybe c
u Vector a
as Vector b
bs
| forall a. Vector a -> Int
Vector.length Vector a
as forall a. Eq a => a -> a -> Bool
== forall a. Vector a -> Int
Vector.length Vector b
bs = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)
Vector.zipWithM a -> b -> Maybe c
u Vector a
as Vector b
bs
| Bool
otherwise = forall a. Maybe a
Nothing
instance (Eq k, Hashable k) => Matchable (HashMap k) where
zipMatch :: forall a b. HashMap k a -> HashMap k b -> Maybe (HashMap k (a, b))
zipMatch HashMap k a
as HashMap k b
bs
| forall k v. HashMap k v -> Int
HashMap.size HashMap k a
as forall a. Eq a => a -> a -> Bool
== forall k v. HashMap k v -> Int
HashMap.size HashMap k b
bs =
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.traverseWithKey (\k
k a
a -> (,) a
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
k HashMap k b
bs) HashMap k a
as
| Bool
otherwise = forall a. Maybe a
Nothing
zipMatchWith :: forall a b c.
(a -> b -> Maybe c)
-> HashMap k a -> HashMap k b -> Maybe (HashMap k c)
zipMatchWith a -> b -> Maybe c
u HashMap k a
as HashMap k b
bs
| forall k v. HashMap k v -> Int
HashMap.size HashMap k a
as forall a. Eq a => a -> a -> Bool
== forall k v. HashMap k v -> Int
HashMap.size HashMap k b
bs =
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.traverseWithKey (\k
k a
a -> a -> b -> Maybe c
u a
a forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
k HashMap k b
bs) HashMap k a
as
| Bool
otherwise = forall a. Maybe a
Nothing
class Matchable' t where
zipMatchWith' :: (a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith
:: (Generic1 t, Matchable' (Rep1 t))
=> (a -> b -> Maybe c)
-> t a
-> t b
-> Maybe (t c)
genericZipMatchWith :: forall (t :: * -> *) a b c.
(Generic1 t, Matchable' (Rep1 t)) =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
genericZipMatchWith a -> b -> Maybe c
u t a
ta t b
tb = forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b c.
Matchable' t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith' a -> b -> Maybe c
u (forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 t a
ta) (forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 t b
tb)
{-# INLINABLE genericZipMatchWith #-}
instance Matchable' V1 where
{-# INLINABLE zipMatchWith' #-}
zipMatchWith' :: forall a b c. (a -> b -> Maybe c) -> V1 a -> V1 b -> Maybe (V1 c)
zipMatchWith' a -> b -> Maybe c
_ V1 a
a V1 b
_ = case V1 a
a of { }
instance Matchable' U1 where
{-# INLINABLE zipMatchWith' #-}
zipMatchWith' :: forall a b c. (a -> b -> Maybe c) -> U1 a -> U1 b -> Maybe (U1 c)
zipMatchWith' a -> b -> Maybe c
_ U1 a
_ U1 b
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 p
U1
instance Matchable' Par1 where
{-# INLINABLE zipMatchWith' #-}
zipMatchWith' :: forall a b c.
(a -> b -> Maybe c) -> Par1 a -> Par1 b -> Maybe (Par1 c)
zipMatchWith' a -> b -> Maybe c
u (Par1 a
a) (Par1 b
b) = forall p. p -> Par1 p
Par1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> b -> Maybe c
u a
a b
b
instance Matchable f => Matchable' (Rec1 f) where
{-# INLINABLE zipMatchWith' #-}
zipMatchWith' :: forall a b c.
(a -> b -> Maybe c) -> Rec1 f a -> Rec1 f b -> Maybe (Rec1 f c)
zipMatchWith' a -> b -> Maybe c
u (Rec1 f a
fa) (Rec1 f b
fb) = forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b c.
Matchable t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith a -> b -> Maybe c
u f a
fa f b
fb
instance (Eq c) => Matchable' (K1 i c) where
{-# INLINABLE zipMatchWith' #-}
zipMatchWith' :: forall a b c.
(a -> b -> Maybe c) -> K1 i c a -> K1 i c b -> Maybe (K1 i c c)
zipMatchWith' a -> b -> Maybe c
_ (K1 c
ca) (K1 c
cb)
= if c
ca forall a. Eq a => a -> a -> Bool
== c
cb then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k i c (p :: k). c -> K1 i c p
K1 c
ca) else forall (f :: * -> *) a. Alternative f => f a
empty
instance Matchable' f => Matchable' (M1 i c f) where
{-# INLINABLE zipMatchWith' #-}
zipMatchWith' :: forall a b c.
(a -> b -> Maybe c)
-> M1 i c f a -> M1 i c f b -> Maybe (M1 i c f c)
zipMatchWith' a -> b -> Maybe c
u (M1 f a
fa) (M1 f b
fb) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b c.
Matchable' t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith' a -> b -> Maybe c
u f a
fa f b
fb
instance (Matchable' f, Matchable' g) => Matchable' (f :+: g) where
{-# INLINABLE zipMatchWith' #-}
zipMatchWith' :: forall a b c.
(a -> b -> Maybe c)
-> (:+:) f g a -> (:+:) f g b -> Maybe ((:+:) f g c)
zipMatchWith' a -> b -> Maybe c
u (L1 f a
fa) (L1 f b
fb) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b c.
Matchable' t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith' a -> b -> Maybe c
u f a
fa f b
fb
zipMatchWith' a -> b -> Maybe c
u (R1 g a
ga) (R1 g b
gb) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b c.
Matchable' t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith' a -> b -> Maybe c
u g a
ga g b
gb
zipMatchWith' a -> b -> Maybe c
_ (:+:) f g a
_ (:+:) f g b
_ = forall (f :: * -> *) a. Alternative f => f a
empty
instance (Matchable' f, Matchable' g) => Matchable' (f :*: g) where
{-# INLINABLE zipMatchWith' #-}
zipMatchWith' :: forall a b c.
(a -> b -> Maybe c)
-> (:*:) f g a -> (:*:) f g b -> Maybe ((:*:) f g c)
zipMatchWith' a -> b -> Maybe c
u (f a
fa :*: g a
ga) (f b
fb :*: g b
gb) =
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (forall (t :: * -> *) a b c.
Matchable' t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith' a -> b -> Maybe c
u f a
fa f b
fb) (forall (t :: * -> *) a b c.
Matchable' t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith' a -> b -> Maybe c
u g a
ga g b
gb)
instance (Matchable f, Matchable' g) => Matchable' (f :.: g) where
{-# INLINABLE zipMatchWith' #-}
zipMatchWith' :: forall a b c.
(a -> b -> Maybe c)
-> (:.:) f g a -> (:.:) f g b -> Maybe ((:.:) f g c)
zipMatchWith' a -> b -> Maybe c
u (Comp1 f (g a)
fga) (Comp1 f (g b)
fgb) =
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b c.
Matchable t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith (forall (t :: * -> *) a b c.
Matchable' t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith' a -> b -> Maybe c
u) f (g a)
fga f (g b)
fgb
unsafeFillIn :: (Traversable f) => (a -> b -> Maybe c) -> f a -> [b] -> Maybe (f c)
unsafeFillIn :: forall (f :: * -> *) a b c.
Traversable f =>
(a -> b -> Maybe c) -> f a -> [b] -> Maybe (f c)
unsafeFillIn a -> b -> Maybe c
u f a
as [b]
bs = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. FillIn b a -> [b] -> Maybe (a, [b])
runFillIn (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> Maybe c) -> a -> FillIn b c
useOne a -> b -> Maybe c
u) f a
as) [b]
bs
newtype FillIn b a = FillIn { forall b a. FillIn b a -> [b] -> Maybe (a, [b])
runFillIn :: [b] -> Maybe (a, [b]) }
deriving (forall a b. a -> FillIn b b -> FillIn b a
forall a b. (a -> b) -> FillIn b a -> FillIn b b
forall b a b. a -> FillIn b b -> FillIn b a
forall b a b. (a -> b) -> FillIn b a -> FillIn b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FillIn b b -> FillIn b a
$c<$ :: forall b a b. a -> FillIn b b -> FillIn b a
fmap :: forall a b. (a -> b) -> FillIn b a -> FillIn b b
$cfmap :: forall b a b. (a -> b) -> FillIn b a -> FillIn b b
Functor)
instance Applicative (FillIn b) where
pure :: forall a. a -> FillIn b a
pure a
a = forall b a. ([b] -> Maybe (a, [b])) -> FillIn b a
FillIn forall a b. (a -> b) -> a -> b
$ \[b]
bs -> forall a. a -> Maybe a
Just (a
a, [b]
bs)
FillIn [b] -> Maybe (a -> b, [b])
fx <*> :: forall a b. FillIn b (a -> b) -> FillIn b a -> FillIn b b
<*> FillIn [b] -> Maybe (a, [b])
fy = forall b a. ([b] -> Maybe (a, [b])) -> FillIn b a
FillIn forall a b. (a -> b) -> a -> b
$ \[b]
bs ->
[b] -> Maybe (a -> b, [b])
fx [b]
bs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a -> b
x, [b]
bs') ->
[b] -> Maybe (a, [b])
fy [b]
bs' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
y, [b]
bs'') -> forall a. a -> Maybe a
Just (a -> b
x a
y, [b]
bs'')
useOne :: (a -> b -> Maybe c) -> a -> FillIn b c
useOne :: forall a b c. (a -> b -> Maybe c) -> a -> FillIn b c
useOne a -> b -> Maybe c
u a
a = forall b a. ([b] -> Maybe (a, [b])) -> FillIn b a
FillIn forall a b. (a -> b) -> a -> b
$ \[b]
bs -> case [b]
bs of
[] -> forall a. Maybe a
Nothing
(b
b:[b]
bs') -> a -> b -> Maybe c
u a
a b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \c
c -> forall a. a -> Maybe a
Just (c
c, [b]
bs')