{-# 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