{-# LANGUAGE UndecidableInstances #-}
module Nix.Match
( match,
findMatches,
Matchable (..),
GMatchable (..),
WithHoles (..),
addHoles,
addHolesLoc,
isOptionalPath,
)
where
import Control.Category ((>>>))
import Control.Monad (void)
import Data.Data
import Data.Fix
import Data.Foldable
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe
import Data.Monoid hiding (All)
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Base (NonEmpty ((:|)))
import GHC.Generics
import Nix
data WithHoles t v
= Hole !v
| Term !(t (WithHoles t v))
deriving instance (Typeable t, Data (t (WithHoles t v)), Data v) => Data (WithHoles t v)
match :: Matchable t => WithHoles t v -> Fix t -> Maybe [(v, Fix t)]
match :: forall (t :: * -> *) v.
Matchable t =>
WithHoles t v -> Fix t -> Maybe [(v, Fix t)]
match = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Endo a -> a -> a
`appEndo` []) forall b c a1 a2. (b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.: forall {a}. WithHoles t a -> Fix t -> Maybe (Endo [(a, Fix t)])
go
where
go :: WithHoles t a -> Fix t -> Maybe (Endo [(a, Fix t)])
go = \case
Hole a
v -> \Fix t
t -> forall a. a -> Maybe a
Just (forall a. (a -> a) -> Endo a
Endo ((a
v, Fix t
t) forall a. a -> [a] -> [a]
:))
Term t (WithHoles t a)
s -> \(Fix t (Fix t)
t) -> do
t (WithHoles t a, Fix t)
m <- forall (t :: * -> *) a b.
Matchable t =>
t a -> t b -> Maybe (t (a, b))
zipMatchLeft t (WithHoles t a)
s t (Fix t)
t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry WithHoles t a -> Fix t -> Maybe (Endo [(a, Fix t)])
go) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ t (WithHoles t a, Fix t)
m
findMatches ::
Matchable t =>
WithHoles t v ->
Fix t ->
[(Fix t, [(v, Fix t)])]
findMatches :: forall (t :: * -> *) v.
Matchable t =>
WithHoles t v -> Fix t -> [(Fix t, [(v, Fix t)])]
findMatches WithHoles t v
needle Fix t
haystack =
[(Fix t
s, [(v, Fix t)]
r) | Fix t
s <- forall (f :: * -> *). Foldable f => Fix f -> [Fix f]
fixUniverse Fix t
haystack, Just [(v, Fix t)]
r <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) v.
Matchable t =>
WithHoles t v -> Fix t -> Maybe [(v, Fix t)]
match WithHoles t v
needle Fix t
s]
fixUniverse :: Foldable f => Fix f -> [Fix f]
fixUniverse :: forall (f :: * -> *). Foldable f => Fix f -> [Fix f]
fixUniverse Fix f
e = Fix f
e forall a. a -> [a] -> [a]
: (forall (f :: * -> *). Foldable f => Fix f -> [Fix f]
fixUniverse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall (f :: * -> *). Fix f -> f (Fix f)
unFix Fix f
e))
addHoles :: NExpr -> WithHoles NExprF VarName
addHoles :: NExpr -> WithHoles NExprF VarName
addHoles =
forall (f :: * -> *). Fix f -> f (Fix f)
unFix forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
NSynHole VarName
n -> forall (t :: * -> *) v. v -> WithHoles t v
Hole VarName
n
NExprF NExpr
e -> forall (t :: * -> *) v. t (WithHoles t v) -> WithHoles t v
Term forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NExpr -> WithHoles NExprF VarName
addHoles forall a b. (a -> b) -> a -> b
$ NExprF NExpr
e
addHolesLoc :: NExprLoc -> WithHoles NExprLocF VarName
addHolesLoc :: NExprLoc -> WithHoles (Compose (AnnUnit SrcSpan) NExprF) VarName
addHolesLoc =
forall (f :: * -> *). Fix f -> f (Fix f)
unFix forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
Compose (AnnUnit SrcSpan
_ (NSynHole VarName
n)) -> forall (t :: * -> *) v. v -> WithHoles t v
Hole VarName
n
Compose (AnnUnit SrcSpan) NExprF NExprLoc
e -> forall (t :: * -> *) v. t (WithHoles t v) -> WithHoles t v
Term forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NExprLoc -> WithHoles (Compose (AnnUnit SrcSpan) NExprF) VarName
addHolesLoc forall a b. (a -> b) -> a -> b
$ Compose (AnnUnit SrcSpan) NExprF NExprLoc
e
class Traversable t => Matchable t where
zipMatchLeft :: t a -> t b -> Maybe (t (a, b))
default zipMatchLeft ::
(Generic1 t, GMatchable (Rep1 t)) =>
t a ->
t b ->
Maybe (t (a, b))
zipMatchLeft t a
l t b
r = 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.
GMatchable t =>
t a -> t b -> Maybe (t (a, b))
gZipMatchLeft (forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 t a
l) (forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 t b
r)
zipMatchLeft2 ::
(Matchable f, Matchable t) => t (f a) -> t (f b) -> Maybe (t (f (a, b)))
zipMatchLeft2 :: forall (f :: * -> *) (t :: * -> *) a b.
(Matchable f, Matchable t) =>
t (f a) -> t (f b) -> Maybe (t (f (a, b)))
zipMatchLeft2 t (f a)
a t (f b)
b = forall (t :: * -> *) a b.
Matchable t =>
t a -> t b -> Maybe (t (a, b))
zipMatchLeft t (f a)
a t (f b)
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (t :: * -> *) a b.
Matchable t =>
t a -> t b -> Maybe (t (a, b))
zipMatchLeft)
instance Matchable NExprF where
zipMatchLeft :: forall a b. NExprF a -> NExprF b -> Maybe (NExprF (a, b))
zipMatchLeft (NSet Recursivity
_ [Binding a]
bs1) (NSet Recursivity
_ [Binding b]
bs2) = do
([Binding a]
bs1', [Binding b]
bs2') <- forall a b. [(a, b)] -> ([a], [b])
unzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q r.
[Binding q] -> [Binding r] -> Maybe [(Binding q, Binding r)]
reduceBindings [Binding a]
bs1 [Binding b]
bs2
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.
GMatchable t =>
t a -> t b -> Maybe (t (a, b))
gZipMatchLeft
(forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 (forall r. Recursivity -> [Binding r] -> NExprF r
NSet Recursivity
NonRecursive [Binding a]
bs1'))
(forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 (forall r. Recursivity -> [Binding r] -> NExprF r
NSet Recursivity
NonRecursive [Binding b]
bs2'))
zipMatchLeft (NLet [Binding a]
bs1 a
e1) (NLet [Binding b]
bs2 b
e2) = do
([Binding a]
bs1', [Binding b]
bs2') <- forall a b. [(a, b)] -> ([a], [b])
unzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q r.
[Binding q] -> [Binding r] -> Maybe [(Binding q, Binding r)]
reduceBindings [Binding a]
bs1 [Binding b]
bs2
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.
GMatchable t =>
t a -> t b -> Maybe (t (a, b))
gZipMatchLeft (forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 (forall r. [Binding r] -> r -> NExprF r
NLet [Binding a]
bs1' a
e1)) (forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 (forall r. [Binding r] -> r -> NExprF r
NLet [Binding b]
bs2' b
e2))
zipMatchLeft (NAbs (Param VarName
"_") a
e1) (NAbs Params b
_ b
e2) = do
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall r. Params r -> r -> NExprF r
NAbs (forall r. VarName -> Params r
Param VarName
"_") (a
e1, b
e2)
zipMatchLeft NExprF a
l NExprF b
r = 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.
GMatchable t =>
t a -> t b -> Maybe (t (a, b))
gZipMatchLeft (forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 NExprF a
l) (forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 NExprF b
r)
reduceBindings :: [Binding q] -> [Binding r] -> Maybe [(Binding q, Binding r)]
reduceBindings :: forall q r.
[Binding q] -> [Binding r] -> Maybe [(Binding q, Binding r)]
reduceBindings [Binding q]
needle [Binding r]
matchee =
let
isOptional :: Binding r -> Maybe (Binding r)
isOptional = \case
NamedVar NAttrPath r
p r
e SourcePos
l | Just NAttrPath r
p' <- forall r. NAttrPath r -> Maybe (NAttrPath r)
isOptionalPath NAttrPath r
p -> forall a. a -> Maybe a
Just (forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar NAttrPath r
p' r
e SourcePos
l)
Binding r
_ -> forall a. Maybe a
Nothing
getLHS :: Binding a -> Either (NonEmpty (NKeyName ())) (Maybe (), [VarName])
getLHS = \case
NamedVar NAttrPath a
p a
_ SourcePos
_ -> forall a b. a -> Either a b
Left (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Functor f => f a -> f ()
void NAttrPath a
p)
Inherit Maybe a
r [VarName]
ps SourcePos
_ -> forall a b. b -> Either a b
Right (forall (f :: * -> *) a. Functor f => f a -> f ()
void Maybe a
r, [VarName]
ps)
in forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ (Binding q
n',) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Binding r)
m
|
Binding q
n <- [Binding q]
needle,
let opt :: Maybe (Binding q)
opt = forall {r}. Binding r -> Maybe (Binding r)
isOptional Binding q
n
n' :: Binding q
n' = forall a. a -> Maybe a -> a
fromMaybe Binding q
n Maybe (Binding q)
opt
lhs :: Either (NonEmpty (NKeyName ())) (Maybe (), [VarName])
lhs = forall {a}.
Binding a -> Either (NonEmpty (NKeyName ())) (Maybe (), [VarName])
getLHS Binding q
n'
m :: Maybe (Binding r)
m = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Either (NonEmpty (NKeyName ())) (Maybe (), [VarName])
lhs forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}.
Binding a -> Either (NonEmpty (NKeyName ())) (Maybe (), [VarName])
getLHS) [Binding r]
matchee,
forall a. Maybe a -> Bool
isNothing Maybe (Binding q)
opt Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (Binding r)
m
]
isOptionalPath :: NAttrPath r -> Maybe (NAttrPath r)
isOptionalPath :: forall r. NAttrPath r -> Maybe (NAttrPath r)
isOptionalPath = \case
StaticKey (VarName Text
n) :| [] | Just (Char
'_', Text
t) <- Text -> Maybe (Char, Text)
T.uncons Text
n -> forall a. a -> Maybe a
Just (forall r. VarName -> NKeyName r
StaticKey (Text -> VarName
VarName Text
t) forall a. a -> [a] -> NonEmpty a
:| [])
DynamicKey (Plain (DoubleQuoted [Plain Text
n])) :| [NKeyName r]
rs
| Just (Char
'_', Text
t) <- Text -> Maybe (Char, Text)
T.uncons Text
n ->
forall a. a -> Maybe a
Just
(forall r. Antiquoted (NString r) r -> NKeyName r
DynamicKey (forall v r. v -> Antiquoted v r
Plain (forall r. [Antiquoted Text r] -> NString r
DoubleQuoted [forall v r. v -> Antiquoted v r
Plain Text
t])) forall a. a -> [a] -> NonEmpty a
:| [NKeyName r]
rs)
NAttrPath r
_ -> forall a. Maybe a
Nothing
instance Matchable NString
instance Matchable (Antiquoted Text)
instance Matchable Binding where
zipMatchLeft :: forall a b. Binding a -> Binding b -> Maybe (Binding (a, b))
zipMatchLeft (NamedVar NAttrPath a
p1 a
v1 SourcePos
_) (NamedVar NAttrPath b
p2 b
v2 SourcePos
l) = do
NonEmpty (NKeyName (a, b))
p <- forall (f :: * -> *) (t :: * -> *) a b.
(Matchable f, Matchable t) =>
t (f a) -> t (f b) -> Maybe (t (f (a, b)))
zipMatchLeft2 NAttrPath a
p1 NAttrPath b
p2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar NonEmpty (NKeyName (a, b))
p (a
v1, b
v2) SourcePos
l)
zipMatchLeft (Inherit Maybe a
x1 [VarName]
ys1 SourcePos
l) (Inherit Maybe b
x2 [VarName]
ys2 SourcePos
_)
| [VarName]
ys1 forall a. Eq a => a -> a -> Bool
== [VarName]
ys2 = do
Maybe (a, b)
x <- forall (t :: * -> *) a b.
Matchable t =>
t a -> t b -> Maybe (t (a, b))
zipMatchLeft Maybe a
x1 Maybe b
x2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall r. Maybe r -> [VarName] -> SourcePos -> Binding r
Inherit Maybe (a, b)
x [VarName]
ys1 SourcePos
l)
zipMatchLeft Binding a
_ Binding b
_ = forall a. Maybe a
Nothing
instance Matchable NKeyName where
zipMatchLeft :: forall a b. NKeyName a -> NKeyName b -> Maybe (NKeyName (a, b))
zipMatchLeft (StaticKey VarName
k1) (StaticKey VarName
k2) | VarName
k1 forall a. Eq a => a -> a -> Bool
== VarName
k2 = forall a. a -> Maybe a
Just (forall r. VarName -> NKeyName r
StaticKey VarName
k1)
zipMatchLeft (DynamicKey Antiquoted (NString a) a
EscapedNewline) (DynamicKey Antiquoted (NString b) b
EscapedNewline) =
forall a. a -> Maybe a
Just (forall r. Antiquoted (NString r) r -> NKeyName r
DynamicKey forall v r. Antiquoted v r
EscapedNewline)
zipMatchLeft (DynamicKey (Plain NString a
k1)) (DynamicKey (Plain NString b
k2)) = do
NString (a, b)
k <- forall (t :: * -> *) a b.
Matchable t =>
t a -> t b -> Maybe (t (a, b))
zipMatchLeft NString a
k1 NString b
k2
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall r. Antiquoted (NString r) r -> NKeyName r
DynamicKey (forall v r. v -> Antiquoted v r
Plain NString (a, b)
k)
zipMatchLeft (DynamicKey (Antiquoted a
k1)) (DynamicKey (Antiquoted b
k2)) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall r. Antiquoted (NString r) r -> NKeyName r
DynamicKey (forall v r. r -> Antiquoted v r
Antiquoted (a
k1, b
k2))
zipMatchLeft NKeyName a
_ NKeyName b
_ = forall a. Maybe a
Nothing
instance Matchable Params
instance Matchable (AnnUnit ann) where
zipMatchLeft :: forall a b.
AnnUnit ann a -> AnnUnit ann b -> Maybe (AnnUnit ann (a, b))
zipMatchLeft (AnnUnit ann
_ a
a1) (AnnUnit ann
ann2 b
a2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall ann expr. ann -> expr -> AnnUnit ann expr
AnnUnit ann
ann2 (a
a1, b
a2)
instance Matchable []
instance Matchable NonEmpty
instance Matchable Maybe
instance Eq a => Matchable ((,) a)
instance (Matchable f, Matchable g) => Matchable (Compose f g)
class (Traversable t, Generic1 t) => GMatchable t where
gZipMatchLeft :: t a -> t b -> Maybe (t (a, b))
instance GMatchable t => GMatchable (M1 m i t) where
gZipMatchLeft :: forall a b. M1 m i t a -> M1 m i t b -> Maybe (M1 m i t (a, b))
gZipMatchLeft (M1 t a
l) (M1 t b
r) = 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.
GMatchable t =>
t a -> t b -> Maybe (t (a, b))
gZipMatchLeft t a
l t b
r
instance GMatchable U1 where
gZipMatchLeft :: forall a b. U1 a -> U1 b -> Maybe (U1 (a, b))
gZipMatchLeft U1 a
_ U1 b
_ = forall a. a -> Maybe a
Just forall k (p :: k). U1 p
U1
instance Eq c => GMatchable (K1 m c) where
gZipMatchLeft :: forall a b. K1 m c a -> K1 m c b -> Maybe (K1 m c (a, b))
gZipMatchLeft (K1 c
l) (K1 c
r)
| c
l forall a. Eq a => a -> a -> Bool
== c
r = forall a. a -> Maybe a
Just (forall k i c (p :: k). c -> K1 i c p
K1 c
l)
| Bool
otherwise = forall a. Maybe a
Nothing
instance GMatchable Par1 where
gZipMatchLeft :: forall a b. Par1 a -> Par1 b -> Maybe (Par1 (a, b))
gZipMatchLeft (Par1 a
l) (Par1 b
r) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. p -> Par1 p
Par1 forall a b. (a -> b) -> a -> b
$ (a
l, b
r)
instance Matchable x => GMatchable (Rec1 x) where
gZipMatchLeft :: forall a b. Rec1 x a -> Rec1 x b -> Maybe (Rec1 x (a, b))
gZipMatchLeft (Rec1 x a
l) (Rec1 x b
r) = 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.
Matchable t =>
t a -> t b -> Maybe (t (a, b))
zipMatchLeft x a
l x b
r
instance (GMatchable l, GMatchable r) => GMatchable (l :+: r) where
gZipMatchLeft :: forall a b. (:+:) l r a -> (:+:) l r b -> Maybe ((:+:) l r (a, b))
gZipMatchLeft (L1 l a
l) (L1 l b
r) = 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.
GMatchable t =>
t a -> t b -> Maybe (t (a, b))
gZipMatchLeft l a
l l b
r
gZipMatchLeft (R1 r a
l) (R1 r b
r) = 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.
GMatchable t =>
t a -> t b -> Maybe (t (a, b))
gZipMatchLeft r a
l r b
r
gZipMatchLeft (:+:) l r a
_ (:+:) l r b
_ = forall a. Maybe a
Nothing
instance (GMatchable l, GMatchable r) => GMatchable (l :*: r) where
gZipMatchLeft :: forall a b. (:*:) l r a -> (:*:) l r b -> Maybe ((:*:) l r (a, b))
gZipMatchLeft (l a
l1 :*: r a
l2) (l b
r1 :*: r b
r2) =
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b.
GMatchable t =>
t a -> t b -> Maybe (t (a, b))
gZipMatchLeft l a
l1 l b
r1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) a b.
GMatchable t =>
t a -> t b -> Maybe (t (a, b))
gZipMatchLeft r a
l2 r b
r2
instance (Matchable a, GMatchable b) => GMatchable (a :.: b) where
gZipMatchLeft :: forall a b. (:.:) a b a -> (:.:) a b b -> Maybe ((:.:) a b (a, b))
gZipMatchLeft (Comp1 a (b a)
l) (Comp1 a (b b)
r) = do
a (b (a, b))
x <- forall (t :: * -> *) a b.
Matchable t =>
t a -> t b -> Maybe (t (a, b))
zipMatchLeft a (b a)
l a (b b)
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (t :: * -> *) a b.
GMatchable t =>
t a -> t b -> Maybe (t (a, b))
gZipMatchLeft)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 a (b (a, b))
x)
(.:) :: (b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.: :: forall b c a1 a2. (b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
(.:) = forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)