{-# LANGUAGE BangPatterns, CPP, DerivingStrategies, DerivingVia         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, MultiWayIf, StandaloneDeriving #-}
{-# LANGUAGE TypeOperators                                              #-}
module Control.Subcategory.Semialign
  ( CSemialign(..), CAlign(..),
    csalign, cpadZip, cpadZipWith
  ) where
import           Control.Applicative                  (ZipList)
import           Control.Monad                        (forM_)
import           Control.Monad.ST.Strict              (runST)
import           Control.Subcategory.Functor
import           Control.Subcategory.Wrapper.Internal
import           Data.Bifunctor                       (Bifunctor (bimap))
import           Data.Coerce
import           Data.Containers
import           Data.Functor.Compose                 (Compose (..))
import           Data.Functor.Identity                (Identity)
import qualified Data.Functor.Product                 as SOP
import           Data.Hashable                        (Hashable)
import           Data.HashMap.Strict                  (HashMap)
import           Data.IntMap.Strict                   (IntMap)
import qualified Data.IntSet                          as IS
import           Data.List.NonEmpty                   (NonEmpty)
import           Data.Map                             (Map)
import           Data.MonoTraversable
import qualified Data.Primitive.Array                 as A
import qualified Data.Primitive.PrimArray             as PA
import qualified Data.Primitive.SmallArray            as SA
import           Data.Proxy                           (Proxy)
import           Data.Semialign
#if !MIN_VERSION_base(4,16,0)
import           Data.Semigroup                       (Option (..))
#endif
import           Data.Sequence                        (Seq)
import qualified Data.Sequences                       as MT
import           Data.These                           (These (..), fromThese,
                                                       mergeThese)
import           Data.Tree                            (Tree)
import qualified Data.Vector                          as V
import qualified Data.Vector.Primitive                as P
import qualified Data.Vector.Storable                 as S
import qualified Data.Vector.Unboxed                  as U
import           GHC.Generics                         ((:*:) (..), (:.:) (..))

class CFunctor f => CSemialign f where
  {-# MINIMAL calignWith #-}
  calignWith
    :: (Dom f a, Dom f b, Dom f c)
    => (These a b -> c) -> f a -> f b -> f c
  calign
    :: (Dom f a, Dom f b, Dom f (These a b))
    => f a -> f b -> f (These a b)
  {-# INLINE [1] calign #-}
  calign = forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith forall a. a -> a
id

instance Semialign f => CSemialign (WrapFunctor f) where
  calignWith :: forall a b c.
(Dom (WrapFunctor f) a, Dom (WrapFunctor f) b,
 Dom (WrapFunctor f) c) =>
(These a b -> c)
-> WrapFunctor f a -> WrapFunctor f b -> WrapFunctor f c
calignWith = forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith
  {-# INLINE [1] calignWith #-}
  calign :: forall a b.
(Dom (WrapFunctor f) a, Dom (WrapFunctor f) b,
 Dom (WrapFunctor f) (These a b)) =>
WrapFunctor f a -> WrapFunctor f b -> WrapFunctor f (These a b)
calign = forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align
  {-# INLINE [1] calign #-}

instance {-# OVERLAPPING #-}  CSemialign (WrapMono IS.IntSet) where
  calignWith :: forall a b c.
(Dom (WrapMono IntSet) a, Dom (WrapMono IntSet) b,
 Dom (WrapMono IntSet) c) =>
(These a b -> c)
-> WrapMono IntSet a -> WrapMono IntSet b -> WrapMono IntSet c
calignWith These a b -> c
f = forall mono r.
(Coercible (WrapMono mono (Element mono)) mono => r) -> r
withMonoCoercible @IS.IntSet forall a b. (a -> b) -> a -> b
$
    coerce :: forall a b. Coercible a b => a -> b
coerce @(IS.IntSet -> IS.IntSet -> IS.IntSet) forall a b. (a -> b) -> a -> b
$ \ IntSet
l IntSet
r ->
    let ints :: IntSet
ints = IntSet
l IntSet -> IntSet -> IntSet
`IS.intersection` IntSet
r
    in forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IS.unions
          [ (Int -> Int) -> IntSet -> IntSet
IS.map (These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> These a b
This) IntSet
l
          , (Int -> Int) -> IntSet -> IntSet
IS.map (These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> These a b
That) IntSet
r
          , (Int -> Int) -> IntSet -> IntSet
IS.map (\Int
x -> These a b -> c
f forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> These a b
These Int
x Int
x) IntSet
ints
          ]
  {-# INLINE [1] calignWith #-}

class CSemialign f => CAlign f where
  cnil :: Dom f a => f a

instance Align f => CAlign (WrapFunctor f) where
  cnil :: forall a. Dom (WrapFunctor f) a => WrapFunctor f a
cnil = forall (f :: * -> *) a. f a -> WrapFunctor f a
WrapFunctor forall (f :: * -> *) a. Align f => f a
nil
  {-# INLINE [1] cnil #-}

deriving via WrapFunctor [] instance CSemialign []
deriving via WrapFunctor [] instance CAlign []
deriving via WrapFunctor Maybe instance CSemialign Maybe
deriving via WrapFunctor Maybe instance CAlign Maybe
#if !MIN_VERSION_base(4,16,0)
#if MIN_VERSION_semialign(1,1,0)
deriving via WrapFunctor Option instance CSemialign Option
deriving via WrapFunctor Option instance CAlign Option
#else
deriving newtype instance CSemialign Option
deriving newtype instance CAlign Option
#endif
#endif

deriving via WrapFunctor ZipList instance CSemialign ZipList
deriving via WrapFunctor ZipList instance CAlign ZipList
deriving via WrapFunctor Identity instance CSemialign Identity
deriving via WrapFunctor NonEmpty instance CSemialign NonEmpty
deriving via WrapFunctor IntMap instance CSemialign IntMap
deriving via WrapFunctor IntMap instance CAlign IntMap
deriving via WrapFunctor Tree instance CSemialign Tree
deriving via WrapFunctor Seq instance CSemialign Seq
deriving via WrapFunctor Seq instance CAlign Seq
deriving via WrapFunctor V.Vector instance CSemialign V.Vector
deriving via WrapFunctor V.Vector instance CAlign V.Vector
deriving via WrapFunctor Proxy instance CSemialign Proxy
deriving via WrapFunctor Proxy instance CAlign Proxy
deriving via WrapFunctor (Map k) instance Ord k => CSemialign (Map k)
deriving via WrapFunctor (Map k) instance Ord k => CAlign (Map k)
deriving via WrapFunctor (HashMap k)
  instance (Eq k, Hashable k) => CSemialign (HashMap k)
deriving via WrapFunctor (HashMap k)
  instance (Eq k, Hashable k) => CAlign (HashMap k)
deriving via WrapFunctor ((->) s) instance CSemialign ((->) s)

instance (CSemialign f, CSemialign g) => CSemialign (SOP.Product f g) where
  calign :: forall a b.
(Dom (Product f g) a, Dom (Product f g) b,
 Dom (Product f g) (These a b)) =>
Product f g a -> Product f g b -> Product f g (These a b)
calign (SOP.Pair f a
a g a
b) (SOP.Pair f b
c g b
d) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair (forall (f :: * -> *) a b.
(CSemialign f, Dom f a, Dom f b, Dom f (These a b)) =>
f a -> f b -> f (These a b)
calign f a
a f b
c) (forall (f :: * -> *) a b.
(CSemialign f, Dom f a, Dom f b, Dom f (These a b)) =>
f a -> f b -> f (These a b)
calign g a
b g b
d)
  {-# INLINE [1] calign #-}
  calignWith :: forall a b c.
(Dom (Product f g) a, Dom (Product f g) b, Dom (Product f g) c) =>
(These a b -> c) -> Product f g a -> Product f g b -> Product f g c
calignWith These a b -> c
f (SOP.Pair f a
a g a
b) (SOP.Pair f b
c g b
d) =
    forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair (forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith These a b -> c
f f a
a f b
c) (forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith These a b -> c
f g a
b g b
d)
  {-# INLINE [1] calignWith #-}

instance (CAlign f, CAlign g) => CAlign (SOP.Product f g) where
  cnil :: forall a. Dom (Product f g) a => Product f g a
cnil = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair forall (f :: * -> *) a. (CAlign f, Dom f a) => f a
cnil forall (f :: * -> *) a. (CAlign f, Dom f a) => f a
cnil
  {-# INLINE [1] cnil #-}

instance (CSemialign f, CSemialign g) => CSemialign (f :*: g) where
  calign :: forall a b.
(Dom (f :*: g) a, Dom (f :*: g) b, Dom (f :*: g) (These a b)) =>
(:*:) f g a -> (:*:) f g b -> (:*:) f g (These a b)
calign ((:*:) f a
a g a
b) ((:*:) f b
c g b
d) = forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (forall (f :: * -> *) a b.
(CSemialign f, Dom f a, Dom f b, Dom f (These a b)) =>
f a -> f b -> f (These a b)
calign f a
a f b
c) (forall (f :: * -> *) a b.
(CSemialign f, Dom f a, Dom f b, Dom f (These a b)) =>
f a -> f b -> f (These a b)
calign g a
b g b
d)
  {-# INLINE [1] calign #-}
  calignWith :: forall a b c.
(Dom (f :*: g) a, Dom (f :*: g) b, Dom (f :*: g) c) =>
(These a b -> c) -> (:*:) f g a -> (:*:) f g b -> (:*:) f g c
calignWith These a b -> c
f ((:*:) f a
a g a
b) ((:*:) f b
c g b
d) =
    forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith These a b -> c
f f a
a f b
c) (forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith These a b -> c
f g a
b g b
d)
  {-# INLINE [1] calignWith #-}

instance (CAlign f, CAlign g) => CAlign (f :*: g) where
  cnil :: forall a. Dom (f :*: g) a => (:*:) f g a
cnil = forall (f :: * -> *) a. (CAlign f, Dom f a) => f a
cnil forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (f :: * -> *) a. (CAlign f, Dom f a) => f a
cnil
  {-# INLINE [1] cnil #-}

instance (CSemialign f, CSemialign g) => CSemialign (Compose f g) where
  calignWith :: forall a b c.
(Dom (Compose f g) a, Dom (Compose f g) b, Dom (Compose f g) c) =>
(These a b -> c) -> Compose f g a -> Compose f g b -> Compose f g c
calignWith These a b -> c
f (Compose f (g a)
x) (Compose f (g b)
y) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith These (g a) (g b) -> g c
g f (g a)
x f (g b)
y)
    where
      g :: These (g a) (g b) -> g c
g (This g a
ga)     = forall (f :: * -> *) a b.
(CFunctor f, Dom f a, Dom f b) =>
(a -> b) -> f a -> f b
cmap (These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> These a b
This) g a
ga
      g (That g b
gb)     = forall (f :: * -> *) a b.
(CFunctor f, Dom f a, Dom f b) =>
(a -> b) -> f a -> f b
cmap (These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> These a b
That) g b
gb
      g (These g a
ga g b
gb) = forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith These a b -> c
f g a
ga g b
gb
  {-# INLINE [1] calignWith #-}

instance (CAlign f, CSemialign g) => CAlign (Compose f g) where
  cnil :: forall a. Dom (Compose f g) a => Compose f g a
cnil = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (f :: * -> *) a. (CAlign f, Dom f a) => f a
cnil
  {-# INLINE [1] cnil #-}

instance (CSemialign f, CSemialign g) => CSemialign ((:.:) f g) where
  calignWith :: forall a b c.
(Dom (f :.: g) a, Dom (f :.: g) b, Dom (f :.: g) c) =>
(These a b -> c) -> (:.:) f g a -> (:.:) f g b -> (:.:) f g c
calignWith These a b -> c
f (Comp1 f (g a)
x) (Comp1 f (g b)
y) = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith These (g a) (g b) -> g c
g f (g a)
x f (g b)
y)
    where
      g :: These (g a) (g b) -> g c
g (This g a
ga)     = forall (f :: * -> *) a b.
(CFunctor f, Dom f a, Dom f b) =>
(a -> b) -> f a -> f b
cmap (These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> These a b
This) g a
ga
      g (That g b
gb)     = forall (f :: * -> *) a b.
(CFunctor f, Dom f a, Dom f b) =>
(a -> b) -> f a -> f b
cmap (These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> These a b
That) g b
gb
      g (These g a
ga g b
gb) = forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith These a b -> c
f g a
ga g b
gb
  {-# INLINE [1] calignWith #-}

instance (CAlign f, CSemialign g) => CAlign ((:.:) f g) where
  cnil :: forall a. Dom (f :.: g) a => (:.:) f g a
cnil = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 forall (f :: * -> *) a. (CAlign f, Dom f a) => f a
cnil
  {-# INLINE [1] cnil #-}

instance CSemialign U.Vector where
  calignWith :: forall a b c.
(Dom Vector a, Dom Vector b, Dom Vector c) =>
(These a b -> c) -> Vector a -> Vector b -> Vector c
calignWith = forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(These a b -> c) -> v a -> v b -> v c
alignVectorWith
  {-# INLINE [1] calignWith #-}

instance CAlign U.Vector where
  cnil :: forall a. Dom Vector a => Vector a
cnil = forall a. Unbox a => Vector a
U.empty
  {-# INLINE [1] cnil #-}

instance CSemialign S.Vector where
  calignWith :: forall a b c.
(Dom Vector a, Dom Vector b, Dom Vector c) =>
(These a b -> c) -> Vector a -> Vector b -> Vector c
calignWith = forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(These a b -> c) -> v a -> v b -> v c
alignVectorWith
  {-# INLINE [1] calignWith #-}

instance CAlign S.Vector where
  cnil :: forall a. Dom Vector a => Vector a
cnil = forall a. Storable a => Vector a
S.empty
  {-# INLINE [1] cnil #-}

instance CSemialign P.Vector where
  calignWith :: forall a b c.
(Dom Vector a, Dom Vector b, Dom Vector c) =>
(These a b -> c) -> Vector a -> Vector b -> Vector c
calignWith = forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(These a b -> c) -> v a -> v b -> v c
alignVectorWith
  {-# INLINE [1] calignWith #-}

instance CAlign P.Vector where
  cnil :: forall a. Dom Vector a => Vector a
cnil = forall a. Prim a => Vector a
P.empty
  {-# INLINE [1] cnil #-}

instance CSemialign SA.SmallArray where
  calignWith :: forall a b c.
(Dom SmallArray a, Dom SmallArray b, Dom SmallArray c) =>
(These a b -> c) -> SmallArray a -> SmallArray b -> SmallArray c
calignWith These a b -> c
f SmallArray a
l SmallArray b
r = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    let !lenL :: Int
lenL = forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
l
        !lenR :: Int
lenR = forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
r
        (Bool
isLftShort, Int
thresh, Int
len)
          | Int
lenL forall a. Ord a => a -> a -> Bool
< Int
lenR = (Bool
True, Int
lenL, Int
lenR)
          | Bool
otherwise = (Bool
False, Int
lenR, Int
lenL)
    SmallMutableArray s c
sa <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
SA.newSmallArray Int
len (forall a. HasCallStack => [Char] -> a
error [Char]
"Uninitialised element")
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
lenforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \Int
n ->
      if  | Int
n forall a. Eq a => a -> a -> Bool
== Int
len -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Int
n forall a. Ord a => a -> a -> Bool
< Int
thresh ->
            forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
SA.writeSmallArray SmallMutableArray s c
sa Int
n
            forall a b. (a -> b) -> a -> b
$ These a b -> c
f forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> These a b
These
              (forall a. SmallArray a -> Int -> a
SA.indexSmallArray SmallArray a
l Int
n)
              (forall a. SmallArray a -> Int -> a
SA.indexSmallArray SmallArray b
r Int
n)
          | Bool
isLftShort ->
            forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
SA.writeSmallArray SmallMutableArray s c
sa Int
n
            forall a b. (a -> b) -> a -> b
$ These a b -> c
f forall a b. (a -> b) -> a -> b
$ forall a b. b -> These a b
That forall a b. (a -> b) -> a -> b
$ forall a. SmallArray a -> Int -> a
SA.indexSmallArray SmallArray b
r Int
n
          | Bool
otherwise ->
            forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
SA.writeSmallArray SmallMutableArray s c
sa Int
n
            forall a b. (a -> b) -> a -> b
$ These a b -> c
f forall a b. (a -> b) -> a -> b
$ forall a b. a -> These a b
This forall a b. (a -> b) -> a -> b
$ forall a. SmallArray a -> Int -> a
SA.indexSmallArray SmallArray a
l Int
n
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
SA.unsafeFreezeSmallArray SmallMutableArray s c
sa
  {-# INLINE [1] calignWith #-}

instance CAlign SA.SmallArray where
  cnil :: forall a. Dom SmallArray a => SmallArray a
cnil = forall a. Int -> [a] -> SmallArray a
SA.smallArrayFromListN Int
0 []
  {-# INLINE [1] cnil #-}

instance CSemialign A.Array where
  calignWith :: forall a b c.
(Dom Array a, Dom Array b, Dom Array c) =>
(These a b -> c) -> Array a -> Array b -> Array c
calignWith These a b -> c
f Array a
l Array b
r = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    let !lenL :: Int
lenL = forall (t :: * -> *) a. Foldable t => t a -> Int
length Array a
l
        !lenR :: Int
lenR = forall (t :: * -> *) a. Foldable t => t a -> Int
length Array b
r
        (Bool
isLftShort, Int
thresh, Int
len)
          | Int
lenL forall a. Ord a => a -> a -> Bool
< Int
lenR = (Bool
True, Int
lenL, Int
lenR)
          | Bool
otherwise = (Bool
False, Int
lenR, Int
lenL)
    MutableArray s c
sa <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
A.newArray Int
len (forall a. HasCallStack => [Char] -> a
error [Char]
"Uninitialised element")
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
lenforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \Int
n ->
      if  | Int
n forall a. Eq a => a -> a -> Bool
== Int
len -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Int
n forall a. Ord a => a -> a -> Bool
< Int
thresh ->
            forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
A.writeArray MutableArray s c
sa Int
n
            forall a b. (a -> b) -> a -> b
$ These a b -> c
f forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> These a b
These
              (forall a. Array a -> Int -> a
A.indexArray Array a
l Int
n)
              (forall a. Array a -> Int -> a
A.indexArray Array b
r Int
n)
          | Bool
isLftShort ->
            forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
A.writeArray MutableArray s c
sa Int
n
            forall a b. (a -> b) -> a -> b
$ These a b -> c
f forall a b. (a -> b) -> a -> b
$ forall a b. b -> These a b
That forall a b. (a -> b) -> a -> b
$ forall a. Array a -> Int -> a
A.indexArray Array b
r Int
n
          | Bool
otherwise ->
            forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
A.writeArray MutableArray s c
sa Int
n
            forall a b. (a -> b) -> a -> b
$ These a b -> c
f forall a b. (a -> b) -> a -> b
$ forall a b. a -> These a b
This forall a b. (a -> b) -> a -> b
$ forall a. Array a -> Int -> a
A.indexArray Array a
l Int
n
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
A.unsafeFreezeArray MutableArray s c
sa
  {-# INLINE [1] calignWith #-}

instance CAlign A.Array where
  cnil :: forall a. Dom Array a => Array a
cnil = forall l. IsList l => Int -> [Item l] -> l
A.fromListN Int
0 []
  {-# INLINE [1] cnil #-}

instance CSemialign PA.PrimArray where
  calignWith :: forall a b c.
(Dom PrimArray a, Dom PrimArray b, Dom PrimArray c) =>
(These a b -> c) -> PrimArray a -> PrimArray b -> PrimArray c
calignWith These a b -> c
f PrimArray a
l PrimArray b
r = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    let !lenL :: Int
lenL = forall a. Prim a => PrimArray a -> Int
PA.sizeofPrimArray PrimArray a
l
        !lenR :: Int
lenR = forall a. Prim a => PrimArray a -> Int
PA.sizeofPrimArray PrimArray b
r
        (Bool
isLftShort, Int
thresh, Int
len)
          | Int
lenL forall a. Ord a => a -> a -> Bool
< Int
lenR = (Bool
True, Int
lenL, Int
lenR)
          | Bool
otherwise = (Bool
False, Int
lenR, Int
lenL)
    MutablePrimArray s c
sa <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
PA.newPrimArray Int
len
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
lenforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \Int
n ->
      if  | Int
n forall a. Eq a => a -> a -> Bool
== Int
len -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Int
n forall a. Ord a => a -> a -> Bool
< Int
thresh ->
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PA.writePrimArray MutablePrimArray s c
sa Int
n
            forall a b. (a -> b) -> a -> b
$ These a b -> c
f forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> These a b
These
              (forall a. Prim a => PrimArray a -> Int -> a
PA.indexPrimArray PrimArray a
l Int
n)
              (forall a. Prim a => PrimArray a -> Int -> a
PA.indexPrimArray PrimArray b
r Int
n)
          | Bool
isLftShort ->
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PA.writePrimArray MutablePrimArray s c
sa Int
n
            forall a b. (a -> b) -> a -> b
$ These a b -> c
f forall a b. (a -> b) -> a -> b
$ forall a b. b -> These a b
That forall a b. (a -> b) -> a -> b
$ forall a. Prim a => PrimArray a -> Int -> a
PA.indexPrimArray PrimArray b
r Int
n
          | Bool
otherwise ->
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PA.writePrimArray MutablePrimArray s c
sa Int
n
            forall a b. (a -> b) -> a -> b
$ These a b -> c
f forall a b. (a -> b) -> a -> b
$ forall a b. a -> These a b
This forall a b. (a -> b) -> a -> b
$ forall a. Prim a => PrimArray a -> Int -> a
PA.indexPrimArray PrimArray a
l Int
n
    forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
PA.unsafeFreezePrimArray MutablePrimArray s c
sa
  {-# INLINE [1] calignWith #-}

instance CAlign PA.PrimArray where
  cnil :: forall a. Dom PrimArray a => PrimArray a
cnil = forall a. Prim a => Int -> [a] -> PrimArray a
PA.primArrayFromListN Int
0 []
  {-# INLINE [1] cnil #-}

instance (MT.IsSequence mono, MonoZip mono)
  => CSemialign (WrapMono mono) where
  calignWith :: forall a b c.
(Dom (WrapMono mono) a, Dom (WrapMono mono) b,
 Dom (WrapMono mono) c) =>
(These a b -> c)
-> WrapMono mono a -> WrapMono mono b -> WrapMono mono c
calignWith These a b -> c
f = coerce :: forall a b. Coercible a b => a -> b
coerce mono -> mono -> mono
go
    where
      go :: mono -> mono -> mono
      go :: mono -> mono -> mono
go mono
ls mono
rs
        | Int
lenL forall a. Eq a => a -> a -> Bool
== Int
lenR = forall mono.
MonoZip mono =>
(Element mono -> Element mono -> Element mono)
-> mono -> mono -> mono
ozipWith (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> These a b
These) mono
ls mono
rs
        | Int
lenL forall a. Ord a => a -> a -> Bool
< Int
lenR  =
            forall mono.
MonoZip mono =>
(Element mono -> Element mono -> Element mono)
-> mono -> mono -> mono
ozipWith (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> These a b
These) mono
ls mono
rs
            forall a. Semigroup a => a -> a -> a
<> forall mono.
MonoFunctor mono =>
(Element mono -> Element mono) -> mono -> mono
omap (These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> These a b
That) (forall seq. IsSequence seq => Index seq -> seq -> seq
MT.drop (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lenL) mono
rs)
        | Bool
otherwise  =
            forall mono.
MonoZip mono =>
(Element mono -> Element mono -> Element mono)
-> mono -> mono -> mono
ozipWith (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> These a b
These) mono
ls mono
rs
            forall a. Semigroup a => a -> a -> a
<> forall mono.
MonoFunctor mono =>
(Element mono -> Element mono) -> mono -> mono
omap (These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> These a b
This) (forall seq. IsSequence seq => Index seq -> seq -> seq
MT.drop (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lenL) mono
ls)
        where lenL :: Int
lenL = forall mono. MonoFoldable mono => mono -> Int
olength mono
ls
              lenR :: Int
lenR = forall mono. MonoFoldable mono => mono -> Int
olength mono
rs

instance (MT.IsSequence mono, MonoZip mono)
  => CAlign (WrapMono mono) where
  cnil :: forall a. Dom (WrapMono mono) a => WrapMono mono a
cnil = forall b mono.
(b ~ Element mono, b ~ Element mono) =>
mono -> WrapMono mono b
WrapMono forall a. Monoid a => a
mempty

csalign :: (CSemialign f, Dom f a, Semigroup a)
  => f a -> f a -> f a
{-# INLINE [1] csalign #-}
csalign :: forall (f :: * -> *) a.
(CSemialign f, Dom f a, Semigroup a) =>
f a -> f a -> f a
csalign = forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> These a a -> a
mergeThese forall a. Semigroup a => a -> a -> a
(<>)

cpadZip
  :: (CSemialign f, Dom f a, Dom f b, Dom f (Maybe a, Maybe b))
  => f a -> f b -> f (Maybe a, Maybe b)
{-# INLINE [1] cpadZip #-}
cpadZip :: forall (f :: * -> *) a b.
(CSemialign f, Dom f a, Dom f b, Dom f (Maybe a, Maybe b)) =>
f a -> f b -> f (Maybe a, Maybe b)
cpadZip = forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith (forall a b. a -> b -> These a b -> (a, b)
fromThese forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. a -> Maybe a
Just forall a. a -> Maybe a
Just)

cpadZipWith
  :: (CSemialign f, Dom f a, Dom f b, Dom f c)
  => (Maybe a -> Maybe b -> c)
  -> f a -> f b -> f c
{-# INLINE [1] cpadZipWith #-}
cpadZipWith :: forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(Maybe a -> Maybe b -> c) -> f a -> f b -> f c
cpadZipWith Maybe a -> Maybe b -> c
f = forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith forall a b. (a -> b) -> a -> b
$
  forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe a -> Maybe b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> These a b -> (a, b)
fromThese forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. a -> Maybe a
Just forall a. a -> Maybe a
Just