{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# LANGUAGE Safe, CPP, BangPatterns, GADTs, ViewPatterns, PatternSynonyms #-}
{-# LANGUAGE ConstraintKinds, DefaultSignatures #-}

#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE QuantifiedConstraints, RankNTypes #-}
#endif

{- |
    Module      :  SDP.LinearM
    Copyright   :  (c) Andrey Mulik 2019-2021
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC extensions)
    
    "SDP.LinearM" is a module that provides 'BorderedM' and 'LinearM' classes.
-}
module SDP.LinearM
(
  -- * Exports
  module SDP.Linear,
  
  -- * BorderedM class
  BorderedM (..), BorderedM1, BorderedM2,
  
  -- * LinearM class
  LinearM (..), LinearM1, LinearM2, pattern (:+=), pattern (:=+), pattern (:~=),
  
#if __GLASGOW_HASKELL__ >= 806
  -- ** Rank 2 quantified constraints
  -- | GHC 8.6.1+ only
  BorderedM', BorderedM'', LinearM', LinearM'',
#endif
  
  -- ** SplitM class
  SplitM (..), SplitM1
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.Linear
import SDP.Map

import Data.Property hiding ( set )
import Data.Typeable

default ()

infixl 5 !#>

--------------------------------------------------------------------------------

-- | 'BorderedM' is 'Bordered' version for mutable data structures.
class (Monad m, Index i) => BorderedM m b i | b -> m, b -> i
  where
    {-# MINIMAL (getBounds|getLower, getUpper) #-}
    
    -- | 'getBounds' returns 'bounds' of mutable data structure.
    getBounds :: b -> m (i, i)
    getBounds b
es = (i -> i -> (i, i)) -> m i -> m i -> m (i, i)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (b -> m i
forall (m :: * -> *) b i. BorderedM m b i => b -> m i
getLower b
es) (b -> m i
forall (m :: * -> *) b i. BorderedM m b i => b -> m i
getUpper b
es)
    
    -- | 'getLower' returns 'lower' bound of mutable data structure.
    getLower :: b -> m i
    getLower =  m (i, i) -> m i
forall (f :: * -> *) a b. Functor f => f (a, b) -> f a
fsts (m (i, i) -> m i) -> (b -> m (i, i)) -> b -> m i
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> m (i, i)
forall (m :: * -> *) b i. BorderedM m b i => b -> m (i, i)
getBounds
    
    -- | 'getUpper' returns 'upper' bound of mutable data structure.
    getUpper :: b -> m i
    getUpper =  m (i, i) -> m i
forall (f :: * -> *) a b. Functor f => f (a, b) -> f b
snds (m (i, i) -> m i) -> (b -> m (i, i)) -> b -> m i
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> m (i, i)
forall (m :: * -> *) b i. BorderedM m b i => b -> m (i, i)
getBounds
    
    -- | 'getSizeOf' returns 'size' of mutable data structure.
    getSizeOf :: b -> m Int
    getSizeOf =  ((i, i) -> Int) -> m (i, i) -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i, i) -> Int
forall i. Index i => (i, i) -> Int
size (m (i, i) -> m Int) -> (b -> m (i, i)) -> b -> m Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> m (i, i)
forall (m :: * -> *) b i. BorderedM m b i => b -> m (i, i)
getBounds
    
    -- | 'getSizesOf' returns 'sizes' of mutable data structure.
    getSizesOf :: b -> m [Int]
    getSizesOf =  ((i, i) -> [Int]) -> m (i, i) -> m [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i, i) -> [Int]
forall i. Index i => (i, i) -> [Int]
sizes (m (i, i) -> m [Int]) -> (b -> m (i, i)) -> b -> m [Int]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> m (i, i)
forall (m :: * -> *) b i. BorderedM m b i => b -> m (i, i)
getBounds
    
    -- | 'nowIndexIn' is 'indexIn' version for mutable structures.
    nowIndexIn :: b -> i -> m Bool
    nowIndexIn b
es i
i = ((i, i) -> i -> Bool) -> i -> (i, i) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
inRange i
i ((i, i) -> Bool) -> m (i, i) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> m (i, i)
forall (m :: * -> *) b i. BorderedM m b i => b -> m (i, i)
getBounds b
es
    
    -- | 'getOffsetOf' is 'offsetOf' version for mutable structures.
    getOffsetOf :: b -> i -> m Int
    getOffsetOf b
es i
i = ((i, i) -> i -> Int) -> i -> (i, i) -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i, i) -> i -> Int
forall i. Index i => (i, i) -> i -> Int
offset i
i ((i, i) -> Int) -> m (i, i) -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> m (i, i)
forall (m :: * -> *) b i. BorderedM m b i => b -> m (i, i)
getBounds b
es
    
    -- | 'getIndexOf' is 'indexOf' version for mutable structures.
    getIndexOf :: b -> Int -> m i
    getIndexOf b
es Int
i = ((i, i) -> Int -> i) -> Int -> (i, i) -> i
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i, i) -> Int -> i
forall i. Index i => (i, i) -> Int -> i
index Int
i ((i, i) -> i) -> m (i, i) -> m i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> m (i, i)
forall (m :: * -> *) b i. BorderedM m b i => b -> m (i, i)
getBounds b
es
    
    -- | 'getIndices' returns 'indices' of mutable data structure.
    getIndices :: b -> m [i]
    getIndices =  ((i, i) -> [i]) -> m (i, i) -> m [i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i, i) -> [i]
forall i. Index i => (i, i) -> [i]
range (m (i, i) -> m [i]) -> (b -> m (i, i)) -> b -> m [i]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> m (i, i)
forall (m :: * -> *) b i. BorderedM m b i => b -> m (i, i)
getBounds

--------------------------------------------------------------------------------

{- |
  'LinearM' is 'Linear' version for mutable data structures. This class is
  designed with the possibility of in-place implementation, so many operations
  from 'Linear' have no analogues here.
-}
class (Monad m) => LinearM m l e | l -> m, l -> e
  where
    {-# MINIMAL (newLinear|fromFoldableM), (getLeft|getRight), (!#>), writeM, copyTo #-}
    
    -- | Monadic 'single'.
    newNull :: m l
    newNull =  [e] -> m l
forall (m :: * -> *) l e. LinearM m l e => [e] -> m l
newLinear []
    
    -- | Monadic 'isNull'.
    nowNull :: l -> m Bool
    nowNull =  ([e] -> Bool) -> m [e] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [e] -> Bool
forall e. Nullable e => e -> Bool
isNull (m [e] -> m Bool) -> (l -> m [e]) -> l -> m Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft
    
    -- | Monadic 'single'.
    singleM :: e -> m l
    singleM =  [e] -> m l
forall (m :: * -> *) l e. LinearM m l e => [e] -> m l
newLinear ([e] -> m l) -> (e -> [e]) -> e -> m l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> [e]
forall l e. Linear l e => e -> l
single
    
    {- |
      'getHead' is monadic version of 'head'. This procedure mustn't modify the
      source structure or return references to its mutable fields.
    -}
    getHead :: l -> m e
    getHead =  ([e] -> e) -> m [e] -> m e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [e] -> e
forall l e. Linear l e => l -> e
head (m [e] -> m e) -> (l -> m [e]) -> l -> m e
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft
    
    {- |
      'getLast' is monadic version of 'last'. This procedure mustn't modify the
      source structure or return references to its mutable fields.
    -}
    getLast :: l -> m e
    getLast =  ([e] -> e) -> m [e] -> m e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [e] -> e
forall l e. Linear l e => l -> e
head (m [e] -> m e) -> (l -> m [e]) -> l -> m e
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getRight
    
    {- |
      Prepends new element to the start of the structure (monadic 'toHead').
      Like most size-changing operations, @prepend@ doesn't guarantee the
      correctness of the original structure after conversion.
    -}
    prepend :: e -> l -> m l
    prepend e
e l
es = [e] -> m l
forall (m :: * -> *) l e. LinearM m l e => [e] -> m l
newLinear ([e] -> m l) -> ([e] -> [e]) -> [e] -> m l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (e
e e -> [e] -> [e]
forall a. a -> [a] -> [a]
:) ([e] -> m l) -> m [e] -> m l
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft l
es
    
    {- |
      Appends new element to the end of the structure (monadic 'toLast').
      Like most size-changing operations, @append@ doesn't guarantee the
      correctness of the original structure after conversion.
    -}
    append :: l -> e -> m l
    append l
es e
e = [e] -> m l
forall (m :: * -> *) l e. LinearM m l e => [e] -> m l
newLinear ([e] -> m l) -> ([e] -> [e]) -> [e] -> m l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([e] -> e -> [e]
forall l e. Linear l e => l -> e -> l
:< e
e) ([e] -> m l) -> m [e] -> m l
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft l
es
    
    -- | Monadic 'fromList'.
    {-# INLINE newLinear #-}
    newLinear :: [e] -> m l
    newLinear =  [e] -> m l
forall (m :: * -> *) l e (f :: * -> *).
(LinearM m l e, Foldable f) =>
f e -> m l
fromFoldableM
    
    -- | Monadic 'fromListN'.
    {-# INLINE newLinearN #-}
    newLinearN :: Int -> [e] -> m l
    newLinearN =  [e] -> m l
forall (m :: * -> *) l e. LinearM m l e => [e] -> m l
newLinear ([e] -> m l) -> (Int -> [e] -> [e]) -> Int -> [e] -> m l
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... Int -> [e] -> [e]
forall s e. Split s e => Int -> s -> s
take
    
    -- | Monadic 'fromFoldable'.
    {-# INLINE fromFoldableM #-}
    fromFoldableM :: (Foldable f) => f e -> m l
    fromFoldableM =  [e] -> m l
forall (m :: * -> *) l e. LinearM m l e => [e] -> m l
newLinear ([e] -> m l) -> (f e -> [e]) -> f e -> m l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f e -> [e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    
    -- | Left view of line.
    {-# INLINE getLeft #-}
    getLeft :: l -> m [e]
    getLeft =  ([e] -> [e]) -> m [e] -> m [e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [e] -> [e]
forall l e. Linear l e => l -> l
reverse (m [e] -> m [e]) -> (l -> m [e]) -> l -> m [e]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getRight
    
    -- | Right view of line.
    {-# INLINE getRight #-}
    getRight :: l -> m [e]
    getRight =  ([e] -> [e]) -> m [e] -> m [e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [e] -> [e]
forall l e. Linear l e => l -> l
reverse (m [e] -> m [e]) -> (l -> m [e]) -> l -> m [e]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft
    
    -- | (!#>) is unsafe monadic offset-based reader.
    (!#>) :: l -> Int -> m e
    
    -- | Unsafe monadic offset-based writer.
    writeM :: l -> Int -> e -> m ()
    
    -- | Create copy.
    {-# INLINE copied #-}
    copied :: l -> m l
    copied =  l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft (l -> m [e]) -> ([e] -> m l) -> l -> m l
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [e] -> m l
forall (m :: * -> *) l e. LinearM m l e => [e] -> m l
newLinear
    
    -- | @copied' es l n@ returns the slice of @es@ from @l@ of length @n@.
    {-# INLINE copied' #-}
    copied' :: l -> Int -> Int -> m l
    copied' l
es Int
l Int
n = l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft l
es m [e] -> ([e] -> m l) -> m l
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> [e] -> m l
forall (m :: * -> *) l e. LinearM m l e => Int -> [e] -> m l
newLinearN Int
n ([e] -> m l) -> ([e] -> [e]) -> [e] -> m l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> [e] -> [e]
forall s e. Split s e => Int -> s -> s
drop Int
l
    
    -- | Monadic 'reverse', returns new structure.
    {-# INLINE reversed #-}
    reversed :: l -> m l
    reversed =  [e] -> m l
forall (m :: * -> *) l e. LinearM m l e => [e] -> m l
newLinear ([e] -> m l) -> (l -> m [e]) -> l -> m l
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getRight

    {- |
      @since 0.2.1
      
      Monadic in-place 'reverse', reverse elements of given structure.
    -}
    reversed' :: l -> m ()
    reversed' l
es = ((Int, e) -> m ()) -> [(Int, e)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Int -> e -> m ()) -> (Int, e) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> e -> m ()) -> (Int, e) -> m ())
-> (Int -> e -> m ()) -> (Int, e) -> m ()
forall a b. (a -> b) -> a -> b
$ l -> Int -> e -> m ()
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> e -> m ()
writeM l
es) ([(Int, e)] -> m ()) -> ([e] -> [(Int, e)]) -> [e] -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [e] -> [(Int, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs ([e] -> m ()) -> m [e] -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getRight l
es
    
    -- | Monadic 'concat'.
    merged :: (Foldable f) => f l -> m l
    merged =  [e] -> m l
forall (m :: * -> *) l e. LinearM m l e => [e] -> m l
newLinear ([e] -> m l) -> ([[e]] -> [e]) -> [[e]] -> m l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [[e]] -> [e]
forall l e (f :: * -> *). (Linear l e, Foldable f) => f l -> l
concat ([[e]] -> m l) -> (f l -> m [[e]]) -> f l -> m l
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [m [e]] -> m [[e]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m [e]] -> m [[e]]) -> (f l -> [m [e]]) -> f l -> m [[e]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (l -> [m [e]] -> [m [e]]) -> [m [e]] -> f l -> [m [e]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (m [e] -> [m [e]] -> [m [e]])
-> (l -> m [e]) -> l -> [m [e]] -> [m [e]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft) []
    
    -- | Monadic version of 'replicate'.
    {-# INLINE filled #-}
    filled :: Int -> e -> m l
    filled Int
n = Int -> [e] -> m l
forall (m :: * -> *) l e. LinearM m l e => Int -> [e] -> m l
newLinearN Int
n ([e] -> m l) -> (e -> [e]) -> e -> m l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> e -> [e]
forall l e. Linear l e => Int -> e -> l
replicate Int
n
    
    {- |
      @since 0.2.1
      @'removed' n es@ removes element with offset @n@ from @es@.
    -}
    removed :: Int -> l -> m l
    removed Int
n l
es = [e] -> m l
forall (m :: * -> *) l e. LinearM m l e => [e] -> m l
newLinear ([e] -> m l) -> ([e] -> [e]) -> [e] -> m l
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> [e] -> [e]
forall l e. Linear l e => Int -> l -> l
remove Int
n ([e] -> m l) -> m [e] -> m l
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft l
es
    
    {- |
      @since 0.2.1
      
      @'lshiftM' es i j@ cyclically shifts the elements with offsets between @i@
      and @j@ @(i < j)@ one position to the left (the @j@-th element is in the
      @i@-th position, the @i@-th in the @(i+1)@th, etc.) If @i >= j@, does
      nothing.
    -}
    lshiftM :: l -> Int -> Int -> m ()
    lshiftM l
es Int
i Int
j =
      let go :: Int -> e -> m ()
go Int
k e
ej = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
j) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do e
ek <- l
es l -> Int -> m e
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> m e
!#> Int
k; l -> Int -> e -> m ()
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> e -> m ()
writeM l
es Int
k e
ej; Int -> e -> m ()
go (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) e
ek
      in  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
j) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> e -> m ()
go Int
i (e -> m ()) -> m e -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (l
es l -> Int -> m e
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> m e
!#> Int
j)
    
    {- |
      @copyTo source soff target toff count@ writes @count@ elements of @source@
      from @soff@ to @target@ starting with @toff@.
    -}
    copyTo :: l -> Int -> l -> Int -> Int -> m ()
    
    -- | 'ofoldrM' is right monadic fold with offset.
    ofoldrM :: (Int -> e -> r -> m r) -> r -> l -> m r
    ofoldrM Int -> e -> r -> m r
f r
base = ((Int, e) -> m r -> m r) -> m r -> [(Int, e)] -> m r
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((r -> m r) -> m r -> m r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) ((r -> m r) -> m r -> m r)
-> ((Int, e) -> r -> m r) -> (Int, e) -> m r -> m r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int -> e -> r -> m r) -> (Int, e) -> r -> m r
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> e -> r -> m r
f) (r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
base) ([(Int, e)] -> m r) -> ([e] -> [(Int, e)]) -> [e] -> m r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [e] -> [(Int, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs ([e] -> m r) -> (l -> m [e]) -> l -> m r
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft
    
    -- | 'ofoldlM' is left monadic fold with offset.
    ofoldlM :: (Int -> r -> e -> m r) -> r -> l -> m r
    ofoldlM Int -> r -> e -> m r
f r
base l
es = (m r -> (Int, e) -> m r) -> m r -> [(Int, e)] -> m r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Int, e) -> m r -> m r) -> m r -> (Int, e) -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Int, e) -> m r -> m r) -> m r -> (Int, e) -> m r)
-> ((Int, e) -> m r -> m r) -> m r -> (Int, e) -> m r
forall a b. (a -> b) -> a -> b
$ (Int -> e -> m r -> m r) -> (Int, e) -> m r -> m r
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((r -> m r) -> m r -> m r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) ((r -> m r) -> m r -> m r)
-> (Int -> e -> r -> m r) -> Int -> e -> m r -> m r
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... (r -> e -> m r) -> e -> r -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((r -> e -> m r) -> e -> r -> m r)
-> (Int -> r -> e -> m r) -> Int -> e -> r -> m r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> r -> e -> m r
f)) (r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
base)
                      ([(Int, e)] -> m r) -> ([e] -> [(Int, e)]) -> [e] -> m r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [e] -> [(Int, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs ([e] -> m r) -> m [e] -> m r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft l
es
    
    -- | 'ofoldrM'' is strict version of 'ofoldrM'.
    ofoldrM' :: (Int -> e -> r -> m r) -> r -> l -> m r
    ofoldrM' Int -> e -> r -> m r
f = (Int -> e -> r -> m r) -> r -> l -> m r
forall (m :: * -> *) l e r.
LinearM m l e =>
(Int -> e -> r -> m r) -> r -> l -> m r
ofoldrM (\ !Int
i e
e !r
r -> Int -> e -> r -> m r
f Int
i e
e r
r)
    
    -- | 'ofoldrM'' is strict version of 'ofoldrM'.
    ofoldlM' :: (Int -> r -> e -> m r) -> r -> l -> m r
    ofoldlM' Int -> r -> e -> m r
f = (Int -> r -> e -> m r) -> r -> l -> m r
forall (m :: * -> *) l e r.
LinearM m l e =>
(Int -> r -> e -> m r) -> r -> l -> m r
ofoldlM (\ !Int
i !r
r e
e -> Int -> r -> e -> m r
f Int
i r
r e
e)
    
    -- | 'foldrM' is just 'ofoldrM' in 'Linear' context.
    foldrM :: (e -> r -> m r) -> r -> l -> m r
    foldrM =  (Int -> e -> r -> m r) -> r -> l -> m r
forall (m :: * -> *) l e r.
LinearM m l e =>
(Int -> e -> r -> m r) -> r -> l -> m r
ofoldrM ((Int -> e -> r -> m r) -> r -> l -> m r)
-> ((e -> r -> m r) -> Int -> e -> r -> m r)
-> (e -> r -> m r)
-> r
-> l
-> m r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (e -> r -> m r) -> Int -> e -> r -> m r
forall a b. a -> b -> a
const
    
    -- | 'foldlM' is just 'ofoldlM' in 'Linear' context.
    foldlM :: (r -> e -> m r) -> r -> l -> m r
    foldlM =  (Int -> r -> e -> m r) -> r -> l -> m r
forall (m :: * -> *) l e r.
LinearM m l e =>
(Int -> r -> e -> m r) -> r -> l -> m r
ofoldlM ((Int -> r -> e -> m r) -> r -> l -> m r)
-> ((r -> e -> m r) -> Int -> r -> e -> m r)
-> (r -> e -> m r)
-> r
-> l
-> m r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (r -> e -> m r) -> Int -> r -> e -> m r
forall a b. a -> b -> a
const
    
    -- | 'foldrM'' is strict version of 'foldrM'.
    foldrM' :: (e -> r -> m r) -> r -> l -> m r
    foldrM' e -> r -> m r
f = (e -> r -> m r) -> r -> l -> m r
forall (m :: * -> *) l e r.
LinearM m l e =>
(e -> r -> m r) -> r -> l -> m r
foldrM (\ e
e !r
r -> e -> r -> m r
f e
e r
r)
    
    -- | 'foldlM'' is strict version of 'foldlM'.
    foldlM' :: (r -> e -> m r) -> r -> l -> m r
    foldlM' r -> e -> m r
f = (r -> e -> m r) -> r -> l -> m r
forall (m :: * -> *) l e r.
LinearM m l e =>
(r -> e -> m r) -> r -> l -> m r
foldlM (\ !r
r e
e -> r -> e -> m r
f r
r e
e)
    
    {- |
      @since 0.2.1
      'foldrM1' is 'foldrM' version with 'last' element as base.
    -}
    foldrM1 :: (e -> e -> m e) -> l -> m e
    foldrM1 e -> e -> m e
f = l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft (l -> m [e]) -> ([e] -> m e) -> l -> m e
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ ([e]
es :< e
e) -> (e -> m e -> m e) -> m e -> [e] -> m e
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((e -> m e) -> m e -> m e
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) ((e -> m e) -> m e -> m e) -> (e -> e -> m e) -> e -> m e -> m e
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> e -> m e
f) (e -> m e
forall (f :: * -> *) a. Applicative f => a -> f a
pure e
e) [e]
es
    
    {- |
      @since 0.2.1
      'foldlM1' is 'foldlM' version with 'head' element as base.
    -}
    foldlM1 :: (e -> e -> m e) -> l -> m e
    foldlM1 e -> e -> m e
f = l -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft (l -> m [e]) -> ([e] -> m e) -> l -> m e
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ (e
e :> [e]
es) -> (m e -> e -> m e) -> m e -> [e] -> m e
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((e -> m e -> m e) -> m e -> e -> m e
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((e -> m e -> m e) -> m e -> e -> m e)
-> (e -> m e -> m e) -> m e -> e -> m e
forall a b. (a -> b) -> a -> b
$ (e -> m e) -> m e -> m e
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) ((e -> m e) -> m e -> m e) -> (e -> e -> m e) -> e -> m e -> m e
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (e -> e -> m e) -> e -> e -> m e
forall a b c. (a -> b -> c) -> b -> a -> c
flip e -> e -> m e
f) (e -> m e
forall (f :: * -> *) a. Applicative f => a -> f a
pure e
e) [e]
es
    
    -- | Just swap two elements.
    swapM :: l -> Int -> Int -> m ()
    swapM l
es Int
i Int
j = do e
ei <- l
es l -> Int -> m e
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> m e
!#> Int
i; l -> Int -> e -> m ()
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> e -> m ()
writeM l
es Int
i (e -> m ()) -> m e -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< l
es l -> Int -> m e
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> m e
!#> Int
j; l -> Int -> e -> m ()
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> e -> m ()
writeM l
es Int
j e
ei

--------------------------------------------------------------------------------

{- |
  'SplitM' is 'Split' version for mutable data structures. This class is
  designed with the possibility of in-place implementation, so many operations
  from 'Split' have no analogues here.
-}
class (LinearM m s e) => SplitM m s e
  where
    {-# MINIMAL (takeM|sansM), (dropM|keepM) #-}
    
    {- |
      @takeM n es@ returns a reference to the @es@, keeping first @n@ elements.
      Changes in the source and result must be synchronous.
    -}
    takeM :: Int -> s -> m s
    default takeM :: (BorderedM m s i) => Int -> s -> m s
    takeM Int
n s
es = do Int
s <- s -> m Int
forall (m :: * -> *) b i. BorderedM m b i => b -> m Int
getSizeOf s
es; Int -> s -> m s
forall (m :: * -> *) s e. SplitM m s e => Int -> s -> m s
sansM (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
es
    
    {- |
      @dropM n es@ returns a reference to the @es@, discarding first @n@ elements.
      Changes in the source and result must be synchronous.
    -}
    dropM :: Int -> s -> m s
    default dropM :: (BorderedM m s i) => Int -> s -> m s
    dropM Int
n s
es = do Int
s <- s -> m Int
forall (m :: * -> *) b i. BorderedM m b i => b -> m Int
getSizeOf s
es; Int -> s -> m s
forall (m :: * -> *) s e. SplitM m s e => Int -> s -> m s
keepM (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
es
    
    {- |
      @keepM n es@ returns a reference to the @es@, keeping last @n@ elements.
      Changes in the source and result must be synchronous.
    -}
    keepM :: Int -> s -> m s
    default keepM :: (BorderedM m s i) => Int -> s -> m s
    keepM Int
n s
es = do Int
s <- s -> m Int
forall (m :: * -> *) b i. BorderedM m b i => b -> m Int
getSizeOf s
es; Int -> s -> m s
forall (m :: * -> *) s e. SplitM m s e => Int -> s -> m s
dropM (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
es
    
    {- |
      @sansM n es@ returns a reference to the @es@, discarding last @n@ elements.
      Changes in the source and result must be synchronous.
    -}
    sansM :: Int -> s -> m s
    default sansM :: (BorderedM m s i) => Int -> s -> m s
    sansM Int
n s
es = do Int
s <- s -> m Int
forall (m :: * -> *) b i. BorderedM m b i => b -> m Int
getSizeOf s
es; Int -> s -> m s
forall (m :: * -> *) s e. SplitM m s e => Int -> s -> m s
takeM (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
es
    
    {- |
      @splitM n es@ returns pair of references to the @es@: keeping and
      discarding first @n@ elements. Changes in the source and result must be
      synchronous.
    -}
    splitM  :: Int -> s -> m (s, s)
    splitM Int
n s
es = (s -> s -> (s, s)) -> m s -> m s -> m (s, s)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Int -> s -> m s
forall (m :: * -> *) s e. SplitM m s e => Int -> s -> m s
takeM Int
n s
es) (Int -> s -> m s
forall (m :: * -> *) s e. SplitM m s e => Int -> s -> m s
dropM Int
n s
es)
    
    {- |
      @divideM n es@ returns pair of references to the @es@: discarding and
      keeping last @n@ elements. Changes in the source and results must be
      synchronous.
    -}
    divideM :: Int -> s -> m (s, s)
    divideM Int
n s
es = (s -> s -> (s, s)) -> m s -> m s -> m (s, s)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Int -> s -> m s
forall (m :: * -> *) s e. SplitM m s e => Int -> s -> m s
sansM Int
n s
es) (Int -> s -> m s
forall (m :: * -> *) s e. SplitM m s e => Int -> s -> m s
keepM Int
n s
es)
    
    {- |
      @splitM ns es@ returns the sequence of @es@ prefix references of length
      @n <- ns@. Changes in the source and results must be synchronous.
    -}
    splitsM :: (Foldable f) => f Int -> s -> m [s]
    splitsM f Int
ns s
es =
      let f :: m [a] -> Int -> m [a]
f m [a]
ds' Int
n = do [a]
ds <- m [a]
ds'; (a
d,a
d') <- Int -> a -> m (a, a)
forall (m :: * -> *) s e. SplitM m s e => Int -> s -> m (s, s)
splitM Int
n ([a] -> a
forall l e. Linear l e => l -> e
head [a]
ds); [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
d'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ds)
      in  [s] -> [s]
forall l e. Linear l e => l -> l
reverse ([s] -> [s]) -> m [s] -> m [s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m [s] -> Int -> m [s]) -> m [s] -> f Int -> m [s]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl m [s] -> Int -> m [s]
forall (m :: * -> *) a e. SplitM m a e => m [a] -> Int -> m [a]
f ([s] -> m [s]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [s
es]) f Int
ns
    
    {- |
      @dividesM ns es@ returns the sequence of @es@ suffix references of length
      @n <- ns@. Changes in the source and results must be synchronous.
    -}
    dividesM :: (Foldable f) => f Int -> s -> m [s]
    dividesM f Int
ns s
es =
      let f :: Int -> m [a] -> m [a]
f Int
n m [a]
ds' = do [a]
ds <- m [a]
ds'; (a
d, a
d') <- Int -> a -> m (a, a)
forall (m :: * -> *) s e. SplitM m s e => Int -> s -> m (s, s)
divideM Int
n ([a] -> a
forall l e. Linear l e => l -> e
head [a]
ds); [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
d'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ds)
      in  (Int -> m [s] -> m [s]) -> m [s] -> f Int -> m [s]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> m [s] -> m [s]
forall (m :: * -> *) a e. SplitM m a e => Int -> m [a] -> m [a]
f ([s] -> m [s]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [s
es]) f Int
ns
    
    {- |
      @partsM n es@ returns the sequence of @es@ prefix references, splitted by
      offsets in @es@. Changes in the source and results must be synchronous.
    -}
    partsM :: (Foldable f) => f Int -> s -> m [s]
    partsM =  [Int] -> s -> m [s]
forall (m :: * -> *) s e (f :: * -> *).
(SplitM m s e, Foldable f) =>
f Int -> s -> m [s]
splitsM ([Int] -> s -> m [s]) -> (f Int -> [Int]) -> f Int -> s -> m [s]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Int] -> [Int]
forall a. Num a => [a] -> [a]
go ([Int] -> [Int]) -> (f Int -> [Int]) -> f Int -> [Int]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f Int -> [Int]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList where go :: [a] -> [a]
go [a]
is = (a -> a -> a) -> [a] -> [a] -> [a]
forall (z :: * -> *) a b c.
Zip z =>
(a -> b -> c) -> z a -> z b -> z c
zipWith (-) [a]
is (a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
is)
    
    {- |
      @chunksM n es@ returns the sequence of @es@ prefix references of length
      @n@. Changes in the source and results must be synchronous.
    -}
    chunksM :: Int -> s -> m [s]
    chunksM Int
n s
es = do (s
t, s
d) <- Int -> s -> m (s, s)
forall (m :: * -> *) s e. SplitM m s e => Int -> s -> m (s, s)
splitM Int
n s
es; s -> m Bool
forall (m :: * -> *) l e. LinearM m l e => l -> m Bool
nowNull s
d m Bool -> m [s] -> m [s] -> m [s]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
?^ [s] -> m [s]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [s
t] (m [s] -> m [s]) -> m [s] -> m [s]
forall a b. (a -> b) -> a -> b
$ (s
t s -> [s] -> [s]
forall a. a -> [a] -> [a]
:) ([s] -> [s]) -> m [s] -> m [s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> s -> m [s]
forall (m :: * -> *) s e. SplitM m s e => Int -> s -> m [s]
chunksM Int
n s
d
    
    {- |
      @eachM n es@ returns new sequence of @es@ elements with step @n@. eachM
      shouldn't return references to @es@.
    -}
    eachM :: Int -> s -> m s
    eachM Int
n = Int -> [e] -> m s
forall (m :: * -> *) l e. LinearM m l e => Int -> [e] -> m l
newLinearN Int
n ([e] -> m s) -> ([e] -> [e]) -> [e] -> m s
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> [e] -> [e]
forall s e. Split s e => Int -> s -> s
each Int
n ([e] -> m s) -> (s -> m [e]) -> s -> m s
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< s -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft
    
    -- | @prefixM p es@ returns the longest @es@ prefix size, satisfying @p@.
    prefixM :: (e -> Bool) -> s -> m Int
    prefixM e -> Bool
p = ([e] -> Int) -> m [e] -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> Bool) -> [e] -> Int
forall s e. Split s e => (e -> Bool) -> s -> Int
prefix e -> Bool
p) (m [e] -> m Int) -> (s -> m [e]) -> s -> m Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft
    
    -- | @suffixM p es@ returns the longest @es@ suffix size, satisfying @p@.
    suffixM :: (e -> Bool) -> s -> m Int
    suffixM e -> Bool
p = ([e] -> Int) -> m [e] -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> Bool) -> [e] -> Int
forall s e. Split s e => (e -> Bool) -> s -> Int
suffix e -> Bool
p) (m [e] -> m Int) -> (s -> m [e]) -> s -> m Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft
    
    -- | @mprefix p es@ returns the longest @es@ prefix size, satisfying @p@.
    mprefix :: (e -> m Bool) -> s -> m Int
    mprefix e -> m Bool
p = (e -> m Int -> m Int) -> m Int -> [e] -> m Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ e
e m Int
c -> do Bool
b <- e -> m Bool
p e
e; Bool
b Bool -> m Int -> m Int -> m Int
forall a. Bool -> a -> a -> a
? Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> m Int -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Int
c (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0) (Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0) ([e] -> m Int) -> (s -> m [e]) -> s -> m Int
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< s -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft
    
    -- | @msuffix p es@ returns the longest @es@ suffix size, satisfying @p@.
    msuffix :: (e -> m Bool) -> s -> m Int
    msuffix e -> m Bool
p = (m Int -> e -> m Int) -> m Int -> [e] -> m Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ m Int
c e
e -> do Bool
b <- e -> m Bool
p e
e; Bool
b Bool -> m Int -> m Int -> m Int
forall a. Bool -> a -> a -> a
? Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> m Int -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Int
c (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0) (Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0) ([e] -> m Int) -> (s -> m [e]) -> s -> m Int
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< s -> m [e]
forall (m :: * -> *) l e. LinearM m l e => l -> m [e]
getLeft

--------------------------------------------------------------------------------

{- fmr-0.2 append, prepend and delete fields. -}

-- | 'FieldLinearM' is a service type used to prepend, append or remove element.
data FieldLinearM l e m field record
  where
    Prepend :: (LinearM m l e, FieldGet field, FieldSet field)
            => e -> field m record l -> FieldLinearM l e m field record
    Append  :: (LinearM m l e, FieldGet field, FieldSet field)
            => field m record l -> e -> FieldLinearM l e m field record
    Delete  :: (LinearM m l e, FieldGet field, FieldSet field)
            => Int -> field m record l -> FieldLinearM l e m field record
  deriving ( Typeable )

instance IsProp (FieldLinearM l e)
  where
    performProp :: record -> FieldLinearM l e m field record -> m ()
performProp record
record (Append  field m record l
field e
e) = field m record l -> record -> l -> m ()
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldSet field, Monad m) =>
field m record a -> record -> a -> m ()
setRecord field m record l
field record
record (l -> m ()) -> m l -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                              (l -> e -> m l) -> e -> l -> m l
forall a b c. (a -> b -> c) -> b -> a -> c
flip l -> e -> m l
forall (m :: * -> *) l e. LinearM m l e => l -> e -> m l
append e
e (l -> m l) -> m l -> m l
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< field m record l -> record -> m l
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldGet field, Monad m) =>
field m record a -> record -> m a
getRecord field m record l
field record
record
    
    performProp record
record (Delete  Int
n field m record l
field) = field m record l -> record -> l -> m ()
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldSet field, Monad m) =>
field m record a -> record -> a -> m ()
setRecord field m record l
field record
record (l -> m ()) -> m l -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                              Int -> l -> m l
forall (m :: * -> *) l e. LinearM m l e => Int -> l -> m l
removed Int
n (l -> m l) -> m l -> m l
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< field m record l -> record -> m l
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldGet field, Monad m) =>
field m record a -> record -> m a
getRecord field m record l
field record
record
    
    performProp record
record (Prepend e
e field m record l
field) = field m record l -> record -> l -> m ()
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldSet field, Monad m) =>
field m record a -> record -> a -> m ()
setRecord field m record l
field record
record (l -> m ()) -> m l -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                              e -> l -> m l
forall (m :: * -> *) l e. LinearM m l e => e -> l -> m l
prepend e
e (l -> m l) -> m l -> m l
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< field m record l -> record -> m l
forall (field :: FieldKind) (m :: * -> *) record a.
(FieldGet field, Monad m) =>
field m record a -> record -> m a
getRecord field m record l
field record
record

{- |
  @since 0.2.1
  @(':+=')@ is @fmr@-compatible 'prepend' element pattern for 'LinearM' fields.
-}
pattern (:+=) ::
  (
    Typeable record, Typeable field, Typeable m, Typeable l, Typeable e,
    LinearM m l e, FieldGet field, FieldSet field
  ) => e -> field m record l -> Prop m field record
pattern e $b:+= :: e -> field m record l -> Prop m field record
$m:+= :: forall r record (field :: FieldKind) (m :: * -> *) l e.
(Typeable record, Typeable field, Typeable m, Typeable l,
 Typeable e, LinearM m l e, FieldGet field, FieldSet field) =>
Prop m field record
-> (e -> field m record l -> r) -> (Void# -> r) -> r
:+= field <- (cast' -> Just (Prepend e field)) where (:+=) = FieldLinearM l e m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (FieldLinearM l e m field record -> Prop m field record)
-> (e -> field m record l -> FieldLinearM l e m field record)
-> e
-> field m record l
-> Prop m field record
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... e -> field m record l -> FieldLinearM l e m field record
forall (m :: * -> *) l e (field :: FieldKind) record.
(LinearM m l e, FieldGet field, FieldSet field) =>
e -> field m record l -> FieldLinearM l e m field record
Prepend

{- |
  @since 0.2.1
  @(':=+')@ is @fmr@-compatible 'append' element pattern for 'LinearM' fields.
-}
pattern (:=+) ::
  (
    Typeable record, Typeable field, Typeable m, Typeable l, Typeable e,
    LinearM m l e, FieldGet field, FieldSet field
  ) => field m record l -> e -> Prop m field record
pattern field $b:=+ :: field m record l -> e -> Prop m field record
$m:=+ :: forall r record (field :: FieldKind) (m :: * -> *) l e.
(Typeable record, Typeable field, Typeable m, Typeable l,
 Typeable e, LinearM m l e, FieldGet field, FieldSet field) =>
Prop m field record
-> (field m record l -> e -> r) -> (Void# -> r) -> r
:=+ e <- (cast' -> Just (Append field e)) where (:=+) = FieldLinearM l e m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (FieldLinearM l e m field record -> Prop m field record)
-> (field m record l -> e -> FieldLinearM l e m field record)
-> field m record l
-> e
-> Prop m field record
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... field m record l -> e -> FieldLinearM l e m field record
forall (m :: * -> *) l e (field :: FieldKind) record.
(LinearM m l e, FieldGet field, FieldSet field) =>
field m record l -> e -> FieldLinearM l e m field record
Append

{- |
  @since 0.2.1
  @(':~=')@ is @fmr@-compatible delete element pattern for 'LinearM' fields, see
  'removed'.
-}
pattern (:~=) ::
  (
    Typeable record, Typeable field, Typeable m, Typeable l, Typeable e,
    LinearM m l e, FieldGet field, FieldSet field
  ) => Int -> field m record l -> Prop m field record
pattern n $b:~= :: Int -> field m record l -> Prop m field record
$m:~= :: forall r record (field :: FieldKind) (m :: * -> *) l e.
(Typeable record, Typeable field, Typeable m, Typeable l,
 Typeable e, LinearM m l e, FieldGet field, FieldSet field) =>
Prop m field record
-> (Int -> field m record l -> r) -> (Void# -> r) -> r
:~= field <- (cast' -> Just (Delete n field)) where (:~=) = FieldLinearM l e m field record -> Prop m field record
forall (m :: * -> *) (prop :: PropertyKind) (field :: FieldKind)
       record.
(Monad m, IsProp prop) =>
prop m field record -> Prop m field record
Prop (FieldLinearM l e m field record -> Prop m field record)
-> (Int -> field m record l -> FieldLinearM l e m field record)
-> Int
-> field m record l
-> Prop m field record
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... Int -> field m record l -> FieldLinearM l e m field record
forall (m :: * -> *) l e (field :: FieldKind) record.
(LinearM m l e, FieldGet field, FieldSet field) =>
Int -> field m record l -> FieldLinearM l e m field record
Delete

-- | 'cast'' is just service function for 'Prop' data extraction.
cast' ::
  (
    Typeable record, Typeable field, Typeable m, Typeable l, Typeable e,
    LinearM m l e, FieldGet field, FieldSet field
  ) => Prop m field record -> Maybe (FieldLinearM l e m field record)
cast' :: Prop m field record -> Maybe (FieldLinearM l e m field record)
cast' =  Prop m field record -> Maybe (FieldLinearM l e m field record)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast

--------------------------------------------------------------------------------

-- | 'BorderedM' contraint for @(Type -> Type)@-kind types.
type BorderedM1 m l i e = BorderedM m (l e) i

-- | 'BorderedM' contraint for @(Type -> Type -> Type)@-kind types.
type BorderedM2 m l i e = BorderedM m (l i e) i

-- | 'LinearM' contraint for @(Type -> Type)@-kind types.
type LinearM1 m l e = LinearM m (l e) e

-- | 'LinearM' contraint for @(Type -> Type -> Type)@-kind types.
type LinearM2 m l i e = LinearM m (l i e) e

-- | Kind @(Type -> Type)@ 'SplitM' structure.
type SplitM1 m l e = SplitM m (l e) e

#if __GLASGOW_HASKELL__ >= 806
-- | 'BorderedM' contraint for @(Type -> Type)@-kind types.
type BorderedM' m l i = forall e . BorderedM m (l e) i

-- | 'BorderedM' contraint for @(Type -> Type -> Type)@-kind types.
type BorderedM'' m l = forall i e . BorderedM m (l i e) i

-- | 'LinearM' contraint for @(Type -> Type)@-kind types.
type LinearM' m l = forall e . LinearM m (l e) e

-- | 'LinearM' contraint for @(Type -> Type -> Type)@-kind types.
type LinearM'' m l = forall i e . LinearM m (l i e) e
#endif