{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.PolyMap
  ( PolyMap,
    empty,
    rnfHelper,
    lookup,
    lookupApply,
    lookupApplyAll,
    lookupConcat,
    alter,
    updateAll,
    insertWith,
    unionWith,
    union,
    zipWith',
    zipWith,
    zip,
    ap,
  )
where

import Data.Typeable
#if MIN_VERSION_base(4,11,0)
import Control.Applicative (Alternative ((<|>)), liftA2)
#elif MIN_VERSION_base(4,9,0)
import Control.Applicative (Alternative ((<|>)), liftA2)
import Data.Semigroup
#elif MIN_VERSION_base(4,8,0)
import Control.Applicative (Alternative ((<|>)), liftA2)
#else
import Control.Applicative (Applicative (..), Alternative ((<|>)), liftA2)
import Data.Monoid (Monoid (..))
#endif
import GHC.Exts (Constraint)
import Prelude hiding (lookup, zip, zipWith)

data PolyMap (c :: * -> Constraint) (f :: * -> *) (a :: *) where
  PMNil :: PolyMap c f a
  PMCons :: (Typeable p, c p) => f (p -> a) -> PolyMap c f a -> PolyMap c f a

instance Functor f => Functor (PolyMap c f) where
  fmap :: (a -> b) -> PolyMap c f a -> PolyMap c f b
fmap a -> b
_ PolyMap c f a
PMNil = PolyMap c f b
forall (c :: * -> Constraint) (f :: * -> *) a. PolyMap c f a
PMNil
  fmap a -> b
f (PMCons f (p -> a)
v PolyMap c f a
pm) = f (p -> b) -> PolyMap c f b -> PolyMap c f b
forall p (c :: * -> Constraint) (f :: * -> *) a.
(Typeable p, c p) =>
f (p -> a) -> PolyMap c f a -> PolyMap c f a
PMCons (((p -> a) -> p -> b) -> f (p -> a) -> f (p -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (p -> a) -> p -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) a -> b
f) f (p -> a)
v) ((a -> b) -> PolyMap c f a -> PolyMap c f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f PolyMap c f a
pm)

instance Alternative f => Semigroup (PolyMap c f a) where
  <> :: PolyMap c f a -> PolyMap c f a -> PolyMap c f a
(<>) = PolyMap c f a -> PolyMap c f a -> PolyMap c f a
forall (f :: * -> *) (c :: * -> Constraint) a.
Alternative f =>
PolyMap c f a -> PolyMap c f a -> PolyMap c f a
union

instance Alternative f => Monoid (PolyMap c f a) where
  mempty :: PolyMap c f a
mempty = PolyMap c f a
forall (c :: * -> Constraint) (f :: * -> *) a. PolyMap c f a
empty
  mappend :: PolyMap c f a -> PolyMap c f a -> PolyMap c f a
mappend = PolyMap c f a -> PolyMap c f a -> PolyMap c f a
forall a. Semigroup a => a -> a -> a
(<>)

empty :: PolyMap c f a
empty :: PolyMap c f a
empty = PolyMap c f a
forall (c :: * -> Constraint) (f :: * -> *) a. PolyMap c f a
PMNil

rnfHelper :: (forall p. c p => f (p -> a) -> ()) -> PolyMap c f a -> ()
rnfHelper :: (forall p. c p => f (p -> a) -> ()) -> PolyMap c f a -> ()
rnfHelper forall p. c p => f (p -> a) -> ()
_ PolyMap c f a
PMNil = ()
rnfHelper forall p. c p => f (p -> a) -> ()
h (PMCons f (p -> a)
v PolyMap c f a
pm) = f (p -> a) -> ()
forall p. c p => f (p -> a) -> ()
h f (p -> a)
v () -> () -> ()
`seq` (forall p. c p => f (p -> a) -> ()) -> PolyMap c f a -> ()
forall (c :: * -> Constraint) (f :: * -> *) a.
(forall p. c p => f (p -> a) -> ()) -> PolyMap c f a -> ()
rnfHelper forall p. c p => f (p -> a) -> ()
h PolyMap c f a
pm

lookup ::
  Typeable p =>
  PolyMap c f a ->
  Maybe (f (p -> a))
lookup :: PolyMap c f a -> Maybe (f (p -> a))
lookup PolyMap c f a
PMNil = Maybe (f (p -> a))
forall a. Maybe a
Nothing
lookup (PMCons f (p -> a)
w PolyMap c f a
polyMap') =
  case f (p -> a) -> Maybe (f (p -> a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 f (p -> a)
w of
    Just f (p -> a)
w' -> f (p -> a) -> Maybe (f (p -> a))
forall a. a -> Maybe a
Just f (p -> a)
w'
    Maybe (f (p -> a))
Nothing -> PolyMap c f a -> Maybe (f (p -> a))
forall p (c :: * -> Constraint) (f :: * -> *) a.
Typeable p =>
PolyMap c f a -> Maybe (f (p -> a))
lookup PolyMap c f a
polyMap'

lookupApply ::
  (Typeable p, Functor f) =>
  p ->
  PolyMap c f a ->
  Maybe (f a)
lookupApply :: p -> PolyMap c f a -> Maybe (f a)
lookupApply p
_ PolyMap c f a
PMNil = Maybe (f a)
forall a. Maybe a
Nothing
lookupApply p
p (PMCons f (p -> a)
w PolyMap c f a
polyMap') =
  case f (p -> a) -> Maybe (f (p -> a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 f (p -> a)
w of
    Just f (p -> a)
w' -> f a -> Maybe (f a)
forall a. a -> Maybe a
Just (((p -> a) -> a) -> f (p -> a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((p -> a) -> p -> a
forall a b. (a -> b) -> a -> b
$ p
p) f (p -> a)
w')
    Maybe (f (p -> a))
Nothing -> p -> PolyMap c f a -> Maybe (f a)
forall p (f :: * -> *) (c :: * -> Constraint) a.
(Typeable p, Functor f) =>
p -> PolyMap c f a -> Maybe (f a)
lookupApply p
p PolyMap c f a
polyMap'

lookupApplyAll ::
  Functor f =>
  (forall p. c p => Maybe p) ->
  PolyMap c f a ->
  [f a]
lookupApplyAll :: (forall p. c p => Maybe p) -> PolyMap c f a -> [f a]
lookupApplyAll forall p. c p => Maybe p
maybeGet PolyMap c f a
polyMap =
  case PolyMap c f a
polyMap of
    PolyMap c f a
PMNil -> []
    PMCons f (p -> a)
w PolyMap c f a
polyMap' ->
      let rest :: [f a]
rest = (forall p. c p => Maybe p) -> PolyMap c f a -> [f a]
forall (f :: * -> *) (c :: * -> Constraint) a.
Functor f =>
(forall p. c p => Maybe p) -> PolyMap c f a -> [f a]
lookupApplyAll forall p. c p => Maybe p
maybeGet PolyMap c f a
polyMap'
       in case Maybe p
forall p. c p => Maybe p
maybeGet of
            Maybe p
Nothing -> [f a]
rest
            Just p
p -> (((p -> a) -> a) -> f (p -> a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((p -> a) -> p -> a
forall a b. (a -> b) -> a -> b
$ p
p) f (p -> a)
w) f a -> [f a] -> [f a]
forall a. a -> [a] -> [a]
: [f a]
rest

lookupConcat ::
  (Monoid m, Functor f) =>
  (forall p. c p => Maybe p) ->
  (forall p. c p => p -> f (p -> a) -> m) ->
  PolyMap c f a ->
  m
lookupConcat :: (forall p. c p => Maybe p)
-> (forall p. c p => p -> f (p -> a) -> m) -> PolyMap c f a -> m
lookupConcat forall p. c p => Maybe p
maybeGet forall p. c p => p -> f (p -> a) -> m
comp PolyMap c f a
polyMap =
  case PolyMap c f a
polyMap of
    PolyMap c f a
PMNil -> m
forall a. Monoid a => a
mempty
    PMCons f (p -> a)
w PolyMap c f a
polyMap' ->
      let rest :: m
rest = (forall p. c p => Maybe p)
-> (forall p. c p => p -> f (p -> a) -> m) -> PolyMap c f a -> m
forall m (f :: * -> *) (c :: * -> Constraint) a.
(Monoid m, Functor f) =>
(forall p. c p => Maybe p)
-> (forall p. c p => p -> f (p -> a) -> m) -> PolyMap c f a -> m
lookupConcat forall p. c p => Maybe p
maybeGet forall p. c p => p -> f (p -> a) -> m
comp PolyMap c f a
polyMap'
       in case Maybe p
forall p. c p => Maybe p
maybeGet of
            Maybe p
Nothing -> m
rest
            Just p
p -> p -> f (p -> a) -> m
forall p. c p => p -> f (p -> a) -> m
comp p
p f (p -> a)
w m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` m
rest

maybeInsertHere ::
  (c p, Typeable p) =>
  Maybe (f (p -> a)) ->
  PolyMap c f a ->
  PolyMap c f a
maybeInsertHere :: Maybe (f (p -> a)) -> PolyMap c f a -> PolyMap c f a
maybeInsertHere = (PolyMap c f a -> PolyMap c f a)
-> (f (p -> a) -> PolyMap c f a -> PolyMap c f a)
-> Maybe (f (p -> a))
-> PolyMap c f a
-> PolyMap c f a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PolyMap c f a -> PolyMap c f a
forall a. a -> a
id f (p -> a) -> PolyMap c f a -> PolyMap c f a
forall p (c :: * -> Constraint) (f :: * -> *) a.
(Typeable p, c p) =>
f (p -> a) -> PolyMap c f a -> PolyMap c f a
PMCons

alter ::
  (Typeable p, c p) =>
  (Maybe (f (p -> a)) -> Maybe (f (p -> a))) ->
  PolyMap c f a ->
  PolyMap c f a
alter :: (Maybe (f (p -> a)) -> Maybe (f (p -> a)))
-> PolyMap c f a -> PolyMap c f a
alter (Maybe (f (p -> a)) -> Maybe (f (p -> a))
g :: Maybe (f (p -> a)) -> Maybe (f (p -> a))) PolyMap c f a
polyMap =
  case PolyMap c f a
polyMap of
    PolyMap c f a
PMNil -> PolyMap c f a -> PolyMap c f a
insertHere PolyMap c f a
forall (c :: * -> Constraint) (f :: * -> *) a. PolyMap c f a
PMNil
    PMCons (f (p -> a)
w :: f (q -> a)) PolyMap c f a
polyMap' ->
      case f (p -> a) -> Maybe (f (p -> a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 f (p -> a)
w of
        Just f (p -> a)
w' ->
          case Maybe (f (p -> a)) -> Maybe (f (p -> a))
g (f (p -> a) -> Maybe (f (p -> a))
forall a. a -> Maybe a
Just f (p -> a)
w') of
            Just f (p -> a)
w'' -> f (p -> a) -> PolyMap c f a -> PolyMap c f a
forall p (c :: * -> Constraint) (f :: * -> *) a.
(Typeable p, c p) =>
f (p -> a) -> PolyMap c f a -> PolyMap c f a
PMCons f (p -> a)
w'' PolyMap c f a
polyMap'
            Maybe (f (p -> a))
Nothing -> PolyMap c f a
polyMap'
        Maybe (f (p -> a))
Nothing ->
          if p -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (p
forall a. HasCallStack => a
undefined :: p) TypeRep -> TypeRep -> Bool
forall a. Ord a => a -> a -> Bool
< p -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (p
forall a. HasCallStack => a
undefined :: q)
            then PolyMap c f a -> PolyMap c f a
insertHere PolyMap c f a
polyMap
            else f (p -> a) -> PolyMap c f a -> PolyMap c f a
forall p (c :: * -> Constraint) (f :: * -> *) a.
(Typeable p, c p) =>
f (p -> a) -> PolyMap c f a -> PolyMap c f a
PMCons f (p -> a)
w ((Maybe (f (p -> a)) -> Maybe (f (p -> a)))
-> PolyMap c f a -> PolyMap c f a
forall p (c :: * -> Constraint) (f :: * -> *) a.
(Typeable p, c p) =>
(Maybe (f (p -> a)) -> Maybe (f (p -> a)))
-> PolyMap c f a -> PolyMap c f a
alter Maybe (f (p -> a)) -> Maybe (f (p -> a))
g PolyMap c f a
polyMap')
  where
    insertHere :: PolyMap c f a -> PolyMap c f a
insertHere = (PolyMap c f a -> PolyMap c f a)
-> (f (p -> a) -> PolyMap c f a -> PolyMap c f a)
-> Maybe (f (p -> a))
-> PolyMap c f a
-> PolyMap c f a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PolyMap c f a -> PolyMap c f a
forall a. a -> a
id f (p -> a) -> PolyMap c f a -> PolyMap c f a
forall p (c :: * -> Constraint) (f :: * -> *) a.
(Typeable p, c p) =>
f (p -> a) -> PolyMap c f a -> PolyMap c f a
PMCons (Maybe (f (p -> a)) -> Maybe (f (p -> a))
g Maybe (f (p -> a))
forall a. Maybe a
Nothing)

updateAll ::
  (forall p. c p => f (p -> a) -> g (p -> b)) ->
  PolyMap c f a ->
  PolyMap c g b
updateAll :: (forall p. c p => f (p -> a) -> g (p -> b))
-> PolyMap c f a -> PolyMap c g b
updateAll forall p. c p => f (p -> a) -> g (p -> b)
_ PolyMap c f a
PMNil = PolyMap c g b
forall (c :: * -> Constraint) (f :: * -> *) a. PolyMap c f a
PMNil
updateAll forall p. c p => f (p -> a) -> g (p -> b)
f (PMCons f (p -> a)
v PolyMap c f a
pm) = g (p -> b) -> PolyMap c g b -> PolyMap c g b
forall p (c :: * -> Constraint) (f :: * -> *) a.
(Typeable p, c p) =>
f (p -> a) -> PolyMap c f a -> PolyMap c f a
PMCons (f (p -> a) -> g (p -> b)
forall p. c p => f (p -> a) -> g (p -> b)
f f (p -> a)
v) ((forall p. c p => f (p -> a) -> g (p -> b))
-> PolyMap c f a -> PolyMap c g b
forall (c :: * -> Constraint) (f :: * -> *) a (g :: * -> *) b.
(forall p. c p => f (p -> a) -> g (p -> b))
-> PolyMap c f a -> PolyMap c g b
updateAll forall p. c p => f (p -> a) -> g (p -> b)
f PolyMap c f a
pm)

insertWith ::
  (Typeable p, c p) =>
  (f (p -> a) -> f (p -> a) -> f (p -> a)) ->
  f (p -> a) ->
  PolyMap c f a ->
  PolyMap c f a
insertWith :: (f (p -> a) -> f (p -> a) -> f (p -> a))
-> f (p -> a) -> PolyMap c f a -> PolyMap c f a
insertWith f (p -> a) -> f (p -> a) -> f (p -> a)
combine f (p -> a)
val = (Maybe (f (p -> a)) -> Maybe (f (p -> a)))
-> PolyMap c f a -> PolyMap c f a
forall p (c :: * -> Constraint) (f :: * -> *) a.
(Typeable p, c p) =>
(Maybe (f (p -> a)) -> Maybe (f (p -> a)))
-> PolyMap c f a -> PolyMap c f a
alter (f (p -> a) -> Maybe (f (p -> a))
forall a. a -> Maybe a
Just (f (p -> a) -> Maybe (f (p -> a)))
-> (Maybe (f (p -> a)) -> f (p -> a))
-> Maybe (f (p -> a))
-> Maybe (f (p -> a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (p -> a)
-> (f (p -> a) -> f (p -> a)) -> Maybe (f (p -> a)) -> f (p -> a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f (p -> a)
val (f (p -> a) -> f (p -> a) -> f (p -> a)
combine f (p -> a)
val))

unionWith ::
  (forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a)) ->
  PolyMap c f a ->
  PolyMap c f a ->
  PolyMap c f a
unionWith :: (forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a))
-> PolyMap c f a -> PolyMap c f a -> PolyMap c f a
unionWith forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a)
_ PolyMap c f a
PMNil PolyMap c f a
pm2 = PolyMap c f a
pm2
unionWith forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a)
_ PolyMap c f a
pm1 PolyMap c f a
PMNil = PolyMap c f a
pm1
unionWith
  forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a)
combine
  pm1 :: PolyMap c f a
pm1@(PMCons (f (p -> a)
v :: f (p -> a)) PolyMap c f a
pm1')
  pm2 :: PolyMap c f a
pm2@(PMCons (f (p -> a)
w :: f (q -> a)) PolyMap c f a
pm2') =
    case f (p -> a) -> Maybe (f (p -> a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 f (p -> a)
v of
      Just f (p -> a)
v' -> f (p -> a) -> PolyMap c f a -> PolyMap c f a
forall p (c :: * -> Constraint) (f :: * -> *) a.
(Typeable p, c p) =>
f (p -> a) -> PolyMap c f a -> PolyMap c f a
PMCons (f (p -> a) -> f (p -> a) -> f (p -> a)
forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a)
combine f (p -> a)
v' f (p -> a)
w) ((forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a))
-> PolyMap c f a -> PolyMap c f a -> PolyMap c f a
forall (c :: * -> Constraint) (f :: * -> *) a.
(forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a))
-> PolyMap c f a -> PolyMap c f a -> PolyMap c f a
unionWith forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a)
combine PolyMap c f a
pm1' PolyMap c f a
pm2')
      Maybe (f (p -> a))
Nothing ->
        if p -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (p
forall a. HasCallStack => a
undefined :: p) TypeRep -> TypeRep -> Bool
forall a. Ord a => a -> a -> Bool
< p -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (p
forall a. HasCallStack => a
undefined :: q)
          then f (p -> a) -> PolyMap c f a -> PolyMap c f a
forall p (c :: * -> Constraint) (f :: * -> *) a.
(Typeable p, c p) =>
f (p -> a) -> PolyMap c f a -> PolyMap c f a
PMCons f (p -> a)
v ((forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a))
-> PolyMap c f a -> PolyMap c f a -> PolyMap c f a
forall (c :: * -> Constraint) (f :: * -> *) a.
(forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a))
-> PolyMap c f a -> PolyMap c f a -> PolyMap c f a
unionWith forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a)
combine PolyMap c f a
pm1' PolyMap c f a
pm2)
          else f (p -> a) -> PolyMap c f a -> PolyMap c f a
forall p (c :: * -> Constraint) (f :: * -> *) a.
(Typeable p, c p) =>
f (p -> a) -> PolyMap c f a -> PolyMap c f a
PMCons f (p -> a)
w ((forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a))
-> PolyMap c f a -> PolyMap c f a -> PolyMap c f a
forall (c :: * -> Constraint) (f :: * -> *) a.
(forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a))
-> PolyMap c f a -> PolyMap c f a -> PolyMap c f a
unionWith forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a)
combine PolyMap c f a
pm1 PolyMap c f a
pm2')

union ::
  Alternative f =>
  PolyMap c f a ->
  PolyMap c f a ->
  PolyMap c f a
union :: PolyMap c f a -> PolyMap c f a -> PolyMap c f a
union = (forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a))
-> PolyMap c f a -> PolyMap c f a -> PolyMap c f a
forall (c :: * -> Constraint) (f :: * -> *) a.
(forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a))
-> PolyMap c f a -> PolyMap c f a -> PolyMap c f a
unionWith forall p. c p => f (p -> a) -> f (p -> a) -> f (p -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

zipWith' ::
  (forall p. c p => Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))) ->
  PolyMap c f a ->
  PolyMap c f b ->
  PolyMap c f d
zipWith' :: (forall p.
 c p =>
 Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d)))
-> PolyMap c f a -> PolyMap c f b -> PolyMap c f d
zipWith' forall p.
c p =>
Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))
f = PolyMap c f a -> PolyMap c f b -> PolyMap c f d
go
  where
    go :: PolyMap c f a -> PolyMap c f b -> PolyMap c f d
go PolyMap c f a
PMNil PolyMap c f b
PMNil = PolyMap c f d
forall (c :: * -> Constraint) (f :: * -> *) a. PolyMap c f a
PMNil
    go PolyMap c f a
PMNil (PMCons f (p -> b)
w PolyMap c f b
pm2') = Maybe (f (p -> d)) -> PolyMap c f d -> PolyMap c f d
forall (c :: * -> Constraint) p (f :: * -> *) a.
(c p, Typeable p) =>
Maybe (f (p -> a)) -> PolyMap c f a -> PolyMap c f a
maybeInsertHere (Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))
forall p.
c p =>
Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))
f Maybe (f (p -> a))
forall a. Maybe a
Nothing (f (p -> b) -> Maybe (f (p -> b))
forall a. a -> Maybe a
Just f (p -> b)
w)) (PolyMap c f a -> PolyMap c f b -> PolyMap c f d
go PolyMap c f a
forall (c :: * -> Constraint) (f :: * -> *) a. PolyMap c f a
PMNil PolyMap c f b
pm2')
    go (PMCons f (p -> a)
v PolyMap c f a
pm1') PolyMap c f b
PMNil = Maybe (f (p -> d)) -> PolyMap c f d -> PolyMap c f d
forall (c :: * -> Constraint) p (f :: * -> *) a.
(c p, Typeable p) =>
Maybe (f (p -> a)) -> PolyMap c f a -> PolyMap c f a
maybeInsertHere (Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))
forall p.
c p =>
Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))
f (f (p -> a) -> Maybe (f (p -> a))
forall a. a -> Maybe a
Just f (p -> a)
v) Maybe (f (p -> b))
forall a. Maybe a
Nothing) (PolyMap c f a -> PolyMap c f b -> PolyMap c f d
go PolyMap c f a
pm1' PolyMap c f b
forall (c :: * -> Constraint) (f :: * -> *) a. PolyMap c f a
PMNil)
    go pm1 :: PolyMap c f a
pm1@(PMCons (f (p -> a)
v :: f (p -> a)) PolyMap c f a
pm1') pm2 :: PolyMap c f b
pm2@(PMCons (w :: f (q -> b)) PolyMap c f b
pm2') =
      case f (p -> a) -> Maybe (f (p -> a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 f (p -> a)
v of
        Just f (p -> a)
v' -> Maybe (f (p -> d)) -> PolyMap c f d -> PolyMap c f d
forall (c :: * -> Constraint) p (f :: * -> *) a.
(c p, Typeable p) =>
Maybe (f (p -> a)) -> PolyMap c f a -> PolyMap c f a
maybeInsertHere (Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))
forall p.
c p =>
Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))
f (f (p -> a) -> Maybe (f (p -> a))
forall a. a -> Maybe a
Just f (p -> a)
v') (f (p -> b) -> Maybe (f (p -> b))
forall a. a -> Maybe a
Just f (p -> b)
w)) (PolyMap c f a -> PolyMap c f b -> PolyMap c f d
go PolyMap c f a
pm1 PolyMap c f b
pm2)
        Maybe (f (p -> a))
Nothing ->
          if p -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (p
forall a. HasCallStack => a
undefined :: p) TypeRep -> TypeRep -> Bool
forall a. Ord a => a -> a -> Bool
< p -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (p
forall a. HasCallStack => a
undefined :: q)
            then Maybe (f (p -> d)) -> PolyMap c f d -> PolyMap c f d
forall (c :: * -> Constraint) p (f :: * -> *) a.
(c p, Typeable p) =>
Maybe (f (p -> a)) -> PolyMap c f a -> PolyMap c f a
maybeInsertHere (Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))
forall p.
c p =>
Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))
f (f (p -> a) -> Maybe (f (p -> a))
forall a. a -> Maybe a
Just f (p -> a)
v) Maybe (f (p -> b))
forall a. Maybe a
Nothing) (PolyMap c f a -> PolyMap c f b -> PolyMap c f d
go PolyMap c f a
pm1' PolyMap c f b
pm2)
            else Maybe (f (p -> d)) -> PolyMap c f d -> PolyMap c f d
forall (c :: * -> Constraint) p (f :: * -> *) a.
(c p, Typeable p) =>
Maybe (f (p -> a)) -> PolyMap c f a -> PolyMap c f a
maybeInsertHere (Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))
forall p.
c p =>
Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))
f Maybe (f (p -> a))
forall a. Maybe a
Nothing (f (p -> b) -> Maybe (f (p -> b))
forall a. a -> Maybe a
Just f (p -> b)
w)) (PolyMap c f a -> PolyMap c f b -> PolyMap c f d
go PolyMap c f a
pm1 PolyMap c f b
pm2')

zipWith ::
  Applicative f =>
  (a -> b -> d) ->
  PolyMap c f a ->
  PolyMap c f b ->
  PolyMap c f d
zipWith :: (a -> b -> d) -> PolyMap c f a -> PolyMap c f b -> PolyMap c f d
zipWith a -> b -> d
f = (forall p.
 c p =>
 Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d)))
-> PolyMap c f a -> PolyMap c f b -> PolyMap c f d
forall (c :: * -> Constraint) (f :: * -> *) a b d.
(forall p.
 c p =>
 Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d)))
-> PolyMap c f a -> PolyMap c f b -> PolyMap c f d
zipWith' ((forall p.
  c p =>
  Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d)))
 -> PolyMap c f a -> PolyMap c f b -> PolyMap c f d)
-> (forall p.
    c p =>
    Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d)))
-> PolyMap c f a
-> PolyMap c f b
-> PolyMap c f d
forall a b. (a -> b) -> a -> b
$ (f (p -> a) -> f (p -> b) -> f (p -> d))
-> Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((f (p -> a) -> f (p -> b) -> f (p -> d))
 -> Maybe (f (p -> a)) -> Maybe (f (p -> b)) -> Maybe (f (p -> d)))
-> (f (p -> a) -> f (p -> b) -> f (p -> d))
-> Maybe (f (p -> a))
-> Maybe (f (p -> b))
-> Maybe (f (p -> d))
forall a b. (a -> b) -> a -> b
$ ((p -> a) -> (p -> b) -> p -> d)
-> f (p -> a) -> f (p -> b) -> f (p -> d)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (((p -> a) -> (p -> b) -> p -> d)
 -> f (p -> a) -> f (p -> b) -> f (p -> d))
-> ((p -> a) -> (p -> b) -> p -> d)
-> f (p -> a)
-> f (p -> b)
-> f (p -> d)
forall a b. (a -> b) -> a -> b
$ \p -> a
a p -> b
b p
p -> a -> b -> d
f (p -> a
a p
p) (p -> b
b p
p)

zip ::
  Applicative f =>
  PolyMap c f a ->
  PolyMap c f b ->
  PolyMap c f (a, b)
zip :: PolyMap c f a -> PolyMap c f b -> PolyMap c f (a, b)
zip = (a -> b -> (a, b))
-> PolyMap c f a -> PolyMap c f b -> PolyMap c f (a, b)
forall (f :: * -> *) a b d (c :: * -> Constraint).
Applicative f =>
(a -> b -> d) -> PolyMap c f a -> PolyMap c f b -> PolyMap c f d
zipWith (,)

ap ::
  Applicative f =>
  PolyMap c f (a -> b) ->
  PolyMap c f a ->
  PolyMap c f b
ap :: PolyMap c f (a -> b) -> PolyMap c f a -> PolyMap c f b
ap = ((a -> b) -> a -> b)
-> PolyMap c f (a -> b) -> PolyMap c f a -> PolyMap c f b
forall (f :: * -> *) a b d (c :: * -> Constraint).
Applicative f =>
(a -> b -> d) -> PolyMap c f a -> PolyMap c f b -> PolyMap c f d
zipWith (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)