{-# LANGUAGE TupleSections, TypeFamilies, CPP #-}

-- | Grouped lists are like lists, but internally they are represented
--   as groups of consecutive elements.
--
--   For example, the list @[1,2,2,3,4,5,5,5]@ would be internally
--   represented as @[[1],[2,2],[3],[4],[5,5,5]]@. Use 'groupedGroups'
--   to see this.
--
module Data.GroupedList
  ( -- * Type
    Grouped
    -- * Builders
  , empty
  , point
    -- | Use 'point' to create a 'Grouped' list with a single element.
  , concatMap
  , replicate
  , fromGroup
    -- * Info
  , length
  , groupCount
    -- * Indexing
  , index
  , adjust
  , adjustM
    -- * Sublists
  , take
  , drop
    -- * Mapping
  , map
    -- * Traversal
  , traverseGrouped
  , traverseGroupedByGroup
  , traverseGroupedByGroupAccum
    -- * Filtering
  , partition
  , filter
    -- * Sorting
  , sort
    -- * Zipping
  , zipWith
  , zip
    -- * List conversion
    -- | For to-list conversion use 'toList'.
  , fromList
    -- * Groups
  , Group
  , buildGroup
  , groupElement
  , groupSize
    -- ** In grouped lists
  , groupedGroups
  , firstGroup
  , lastGroup
    ) where

import Prelude hiding
  ( concat, concatMap, replicate, filter, map
  , take, drop, foldl, foldr, length, zipWith
  , zip
    )
import qualified Prelude as Prelude
import Data.Pointed
import Data.Foldable (Foldable (..), toList)
import Data.Sequence (Seq)
import qualified Data.Sequence as S
import Data.Monoid ((<>))
import Control.DeepSeq (NFData (..))
import Control.Arrow (second)
import qualified Data.Map.Strict as M
import Data.Functor.Identity (Identity (..))
import Control.Applicative (liftA2)
import Control.Monad (foldM)
import Data.Binary (Binary (..))

------------------------------------------------------------------
------------------------------------------------------------------
-- COMPATIBILITY

#if MIN_VERSION_base(4,7,0)
import qualified GHC.Exts as GHC
#endif

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative (..), (<$>))
import Data.Traversable (traverse)
import Data.Monoid (Monoid (..))
#endif

------------------------------------------------------------------
------------------------------------------------------------------
-- GROUP

-- | A 'Group' is a non-empty finite list that contains the same element
--   repeated a number of times.
data Group a = Group {-# UNPACK #-} !Int a deriving Group a -> Group a -> Bool
(Group a -> Group a -> Bool)
-> (Group a -> Group a -> Bool) -> Eq (Group a)
forall a. Eq a => Group a -> Group a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Group a -> Group a -> Bool
$c/= :: forall a. Eq a => Group a -> Group a -> Bool
== :: Group a -> Group a -> Bool
$c== :: forall a. Eq a => Group a -> Group a -> Bool
Eq

instance Binary a => Binary (Group a) where
  put :: Group a -> Put
put (Group Int
n a
x) = Int -> Put
forall t. Binary t => t -> Put
put Int
n Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> Put
forall t. Binary t => t -> Put
put a
x
  get :: Get (Group a)
get = (Int -> a -> Group a) -> Get Int -> Get a -> Get (Group a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Int -> a -> Group a
forall a. Int -> a -> Group a
Group Get Int
forall t. Binary t => Get t
get Get a
forall t. Binary t => Get t
get

-- | Build a group by repeating the given element a number of times.
--   If the given number is less or equal to 0, 'Nothing' is returned.
buildGroup :: Int -> a -> Maybe (Group a)
buildGroup :: Int -> a -> Maybe (Group a)
buildGroup Int
n a
x = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Maybe (Group a)
forall a. Maybe a
Nothing else Group a -> Maybe (Group a)
forall a. a -> Maybe a
Just (Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
n a
x)

-- | Get the element of a group.
groupElement :: Group a -> a
groupElement :: Group a -> a
groupElement (Group Int
_ a
a) = a
a

-- | Size of a group.
groupSize :: Group a -> Int
groupSize :: Group a -> Int
groupSize (Group Int
n a
_) = Int
n

-- | A group is larger than other if its constituent element is
--   larger. If they are equal, the group with more elements is
--   the larger.
instance Ord a => Ord (Group a) where
  Group Int
n a
a <= :: Group a -> Group a -> Bool
<= Group Int
m a
b =
    if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b
       then Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
m
       else a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
b

instance Pointed Group where
  point :: a -> Group a
point = Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
1

instance Functor Group where
  fmap :: (a -> b) -> Group a -> Group b
fmap a -> b
f (Group Int
n a
a) = Int -> b -> Group b
forall a. Int -> a -> Group a
Group Int
n (a -> b
f a
a)

instance Foldable Group where
  foldMap :: (a -> m) -> Group a -> m
foldMap a -> m
f (Group Int
n a
a) = [m] -> m
forall a. Monoid a => [a] -> a
mconcat ([m] -> m) -> [m] -> m
forall a b. (a -> b) -> a -> b
$ Int -> m -> [m]
forall a. Int -> a -> [a]
Prelude.replicate Int
n (m -> [m]) -> m -> [m]
forall a b. (a -> b) -> a -> b
$ a -> m
f a
a
#if MIN_VERSION_base(4,8,0)
  elem :: a -> Group a -> Bool
elem a
x (Group Int
_ a
a) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a
  null :: Group a -> Bool
null Group a
_ = Bool
False
  length :: Group a -> Int
length (Group Int
n a
_) = Int
n
#endif

instance Show a => Show (Group a) where
  show :: Group a -> String
show = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (Group a -> [a]) -> Group a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Group a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

groupJoin :: Group (Group a) -> Group a
groupJoin :: Group (Group a) -> Group a
groupJoin (Group Int
n (Group Int
m a
a)) = Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) a
a

groupBind :: Group a -> (a -> Group b) -> Group b
groupBind :: Group a -> (a -> Group b) -> Group b
groupBind Group a
gx a -> Group b
f = Group (Group b) -> Group b
forall a. Group (Group a) -> Group a
groupJoin (Group (Group b) -> Group b) -> Group (Group b) -> Group b
forall a b. (a -> b) -> a -> b
$ (a -> Group b) -> Group a -> Group (Group b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Group b
f Group a
gx

instance Applicative Group where
  pure :: a -> Group a
pure = a -> Group a
forall (p :: * -> *) a. Pointed p => a -> p a
point
  Group (a -> b)
gf <*> :: Group (a -> b) -> Group a -> Group b
<*> Group a
gx = Group a -> (a -> Group b) -> Group b
forall a b. Group a -> (a -> Group b) -> Group b
groupBind Group a
gx ((a -> Group b) -> Group b) -> (a -> Group b) -> Group b
forall a b. (a -> b) -> a -> b
$ \a
x -> ((a -> b) -> b) -> Group (a -> b) -> Group b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$a
x) Group (a -> b)
gf

instance Monad Group where
#if !MIN_VERSION_base(4,8,0)
  return = pure
#endif
  >>= :: Group a -> (a -> Group b) -> Group b
(>>=) = Group a -> (a -> Group b) -> Group b
forall a b. Group a -> (a -> Group b) -> Group b
groupBind

instance NFData a => NFData (Group a) where
  rnf :: Group a -> ()
rnf (Group Int
_ a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a

------------------------------------------------------------------
------------------------------------------------------------------
-- GROUPED

-- | Type of grouped lists. Grouped lists are finite lists that
--   perform better than regular lists in the abundance of sublists
--   that have all their elements equal.
newtype Grouped a = Grouped (Seq (Group a)) deriving Grouped a -> Grouped a -> Bool
(Grouped a -> Grouped a -> Bool)
-> (Grouped a -> Grouped a -> Bool) -> Eq (Grouped a)
forall a. Eq a => Grouped a -> Grouped a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Grouped a -> Grouped a -> Bool
$c/= :: forall a. Eq a => Grouped a -> Grouped a -> Bool
== :: Grouped a -> Grouped a -> Bool
$c== :: forall a. Eq a => Grouped a -> Grouped a -> Bool
Eq

-- | Grouped list with no elements.
empty :: Grouped a
empty :: Grouped a
empty = Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped Seq (Group a)
forall a. Seq a
S.empty

-- | Return the number of groups in a grouped list. See 'Group'.
--   It should give the same result as @length . groupedGroups@.
groupCount :: Grouped a -> Int
groupCount :: Grouped a -> Int
groupCount (Grouped Seq (Group a)
xs) = Seq (Group a) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Group a)
xs

#if MIN_VERSION_base(4,7,0)
-- | Method 'fromList' doesn't work for infinite lists.
--   A grouped list cannot be infinite.
instance Eq a => GHC.IsList (Grouped a) where
  type (Item (Grouped a)) = a
  fromList :: [Item (Grouped a)] -> Grouped a
fromList = [Item (Grouped a)] -> Grouped a
forall a. Eq a => [a] -> Grouped a
fromList
  toList :: Grouped a -> [Item (Grouped a)]
toList = Grouped a -> [Item (Grouped a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
#endif

instance Binary a => Binary (Grouped a) where
  put :: Grouped a -> Put
put (Grouped Seq (Group a)
xs) = Seq (Group a) -> Put
forall t. Binary t => t -> Put
put Seq (Group a)
xs
  get :: Get (Grouped a)
get = Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped (Seq (Group a) -> Grouped a)
-> Get (Seq (Group a)) -> Get (Grouped a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Seq (Group a))
forall t. Binary t => Get t
get

headGroup :: Eq a => [a] -> Maybe (Group a, [a])
headGroup :: [a] -> Maybe (Group a, [a])
headGroup [] = Maybe (Group a, [a])
forall a. Maybe a
Nothing
headGroup (a
a:[a]
as) = (Group a, [a]) -> Maybe (Group a, [a])
forall a. a -> Maybe a
Just (Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
n a
a, [a]
r)
  where
    (Int
n,[a]
r) = Int -> [a] -> (Int, [a])
count Int
1 [a]
as
    count :: Int -> [a] -> (Int, [a])
count Int
acc [] = (Int
acc,[])
    count Int
acc l :: [a]
l@(a
x:[a]
xs) =
      if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
         then let acc' :: Int
acc' = Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
              in  Int -> (Int, [a]) -> (Int, [a])
seq Int
acc' ((Int, [a]) -> (Int, [a])) -> (Int, [a]) -> (Int, [a])
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> (Int, [a])
count Int
acc' [a]
xs
         else (Int
acc, [a]
l)

-- | Build a grouped list from a regular list. It doesn't work if
--   the input list is infinite.
fromList :: Eq a => [a] -> Grouped a
fromList :: [a] -> Grouped a
fromList = Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped (Seq (Group a) -> Grouped a)
-> ([a] -> Seq (Group a)) -> [a] -> Grouped a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Maybe (Group a, [a])) -> [a] -> Seq (Group a)
forall b a. (b -> Maybe (a, b)) -> b -> Seq a
S.unfoldr [a] -> Maybe (Group a, [a])
forall a. Eq a => [a] -> Maybe (Group a, [a])
headGroup

-- | Build a grouped list from a group (see 'Group').
fromGroup :: Group a -> Grouped a
fromGroup :: Group a -> Grouped a
fromGroup = Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped (Seq (Group a) -> Grouped a)
-> (Group a -> Seq (Group a)) -> Group a -> Grouped a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Group a -> Seq (Group a)
forall (p :: * -> *) a. Pointed p => a -> p a
point

-- | Groups of consecutive elements in a grouped list.
groupedGroups :: Grouped a -> [Group a]
groupedGroups :: Grouped a -> [Group a]
groupedGroups (Grouped Seq (Group a)
gs) = Seq (Group a) -> [Group a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Group a)
gs

-- | Get the first group (if the list is not empty) and
--   the rest of the list.
firstGroup :: Grouped a -> Maybe (Group a, Grouped a)
firstGroup :: Grouped a -> Maybe (Group a, Grouped a)
firstGroup (Grouped Seq (Group a)
gs) =
  case Seq (Group a) -> ViewL (Group a)
forall a. Seq a -> ViewL a
S.viewl Seq (Group a)
gs of
    Group a
g S.:< Seq (Group a)
hs -> (Group a, Grouped a) -> Maybe (Group a, Grouped a)
forall a. a -> Maybe a
Just (Group a
g, Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped Seq (Group a)
hs)
    ViewL (Group a)
_ -> Maybe (Group a, Grouped a)
forall a. Maybe a
Nothing

-- | Get the last group (if the list is not empty) and
--   the rest of the list.
lastGroup :: Grouped a -> Maybe (Grouped a, Group a)
lastGroup :: Grouped a -> Maybe (Grouped a, Group a)
lastGroup (Grouped Seq (Group a)
gs) =
  case Seq (Group a) -> ViewR (Group a)
forall a. Seq a -> ViewR a
S.viewr Seq (Group a)
gs of
    Seq (Group a)
hs S.:> Group a
g -> (Grouped a, Group a) -> Maybe (Grouped a, Group a)
forall a. a -> Maybe a
Just (Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped Seq (Group a)
hs,Group a
g)
    ViewR (Group a)
_ -> Maybe (Grouped a, Group a)
forall a. Maybe a
Nothing

instance Pointed Grouped where
  point :: a -> Grouped a
point = Group a -> Grouped a
forall a. Group a -> Grouped a
fromGroup (Group a -> Grouped a) -> (a -> Group a) -> a -> Grouped a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Group a
forall (p :: * -> *) a. Pointed p => a -> p a
point

#if MIN_VERSION_base(4,11,0)
instance Eq a => Monoid (Grouped a) where
  mempty :: Grouped a
mempty = Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped Seq (Group a)
forall a. Seq a
S.empty

instance Eq a => Semigroup (Grouped a) where
  Grouped Seq (Group a)
gs <> :: Grouped a -> Grouped a -> Grouped a
<> Grouped Seq (Group a)
gs' = Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped (Seq (Group a) -> Grouped a) -> Seq (Group a) -> Grouped a
forall a b. (a -> b) -> a -> b
$
#else
instance Eq a => Monoid (Grouped a) where
  mempty = Grouped S.empty
  mappend (Grouped gs) (Grouped gs') = Grouped $
#endif
    case Seq (Group a) -> ViewR (Group a)
forall a. Seq a -> ViewR a
S.viewr Seq (Group a)
gs of
      Seq (Group a)
gsl S.:> Group Int
n a
l ->
        case Seq (Group a) -> ViewL (Group a)
forall a. Seq a -> ViewL a
S.viewl Seq (Group a)
gs' of
          Group Int
m a
r S.:< Seq (Group a)
gsr ->
            if a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
r
               then Seq (Group a)
gsl Seq (Group a) -> Seq (Group a) -> Seq (Group a)
forall a. Seq a -> Seq a -> Seq a
S.>< (Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m) a
l Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
gsr)
               else Seq (Group a)
gs Seq (Group a) -> Seq (Group a) -> Seq (Group a)
forall a. Seq a -> Seq a -> Seq a
S.>< Seq (Group a)
gs'
          ViewL (Group a)
_ -> Seq (Group a)
gs
      ViewR (Group a)
_ -> Seq (Group a)
gs'

-- | Apply a function to every element in a grouped list.
map :: Eq b => (a -> b) -> Grouped a -> Grouped b
map :: (a -> b) -> Grouped a -> Grouped b
map a -> b
f (Grouped Seq (Group a)
gs) = Seq (Group b) -> Grouped b
forall a. Seq (Group a) -> Grouped a
Grouped (Seq (Group b) -> Grouped b) -> Seq (Group b) -> Grouped b
forall a b. (a -> b) -> a -> b
$
  case Seq (Group a) -> ViewL (Group a)
forall a. Seq a -> ViewL a
S.viewl Seq (Group a)
gs of
    Group a
g S.:< Seq (Group a)
xs ->
      let go :: (Seq (Group b), Group b) -> Group a -> (Seq (Group b), Group b)
go (Seq (Group b)
acc, Group Int
n b
a') (Group Int
m a
b) =
             let b' :: b
b' = a -> b
f a
b
             in  if b
a' b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b'
                    then (Seq (Group b)
acc, Int -> b -> Group b
forall a. Int -> a -> Group a
Group (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m) b
a')
                    else (Seq (Group b)
acc Seq (Group b) -> Group b -> Seq (Group b)
forall a. Seq a -> a -> Seq a
S.|> Int -> b -> Group b
forall a. Int -> a -> Group a
Group Int
n b
a', Int -> b -> Group b
forall a. Int -> a -> Group a
Group Int
m b
b')
      in  ((Seq (Group b) -> Group b -> Seq (Group b))
-> (Seq (Group b), Group b) -> Seq (Group b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Seq (Group b) -> Group b -> Seq (Group b)
forall a. Seq a -> a -> Seq a
(S.|>)) ((Seq (Group b), Group b) -> Seq (Group b))
-> (Seq (Group b), Group b) -> Seq (Group b)
forall a b. (a -> b) -> a -> b
$ ((Seq (Group b), Group b) -> Group a -> (Seq (Group b), Group b))
-> (Seq (Group b), Group b)
-> Seq (Group a)
-> (Seq (Group b), Group b)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Seq (Group b), Group b) -> Group a -> (Seq (Group b), Group b)
go (Seq (Group b)
forall a. Seq a
S.empty, (a -> b) -> Group a -> Group b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Group a
g) Seq (Group a)
xs
    ViewL (Group a)
_ -> Seq (Group b)
forall a. Seq a
S.empty

instance Foldable Grouped where
  foldMap :: (a -> m) -> Grouped a -> m
foldMap a -> m
f (Grouped Seq (Group a)
gs) = (Group a -> m) -> Seq (Group a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> Group a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) Seq (Group a)
gs
#if MIN_VERSION_base(4,8,0)
  length :: Grouped a -> Int
length (Grouped Seq (Group a)
gs) = (Int -> Group a -> Int) -> Int -> Seq (Group a) -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
s Group a
g -> Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Group a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Group a
g) Int
0 Seq (Group a)
gs
  null :: Grouped a -> Bool
null (Grouped Seq (Group a)
gs) = Seq (Group a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (Group a)
gs
#else

length :: Grouped a -> Int
length (Grouped gs) = foldl' (+) 0 $ fmap groupSize gs
#endif

instance Show a => Show (Grouped a) where
  show :: Grouped a -> String
show = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (Grouped a -> [a]) -> Grouped a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grouped a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance NFData a => NFData (Grouped a) where
  rnf :: Grouped a -> ()
rnf (Grouped Seq (Group a)
gs) = Seq (Group a) -> ()
forall a. NFData a => a -> ()
rnf Seq (Group a)
gs

------------------------------------------------------------------
------------------------------------------------------------------
-- Monad instance (almost)

-- | Map a function that produces a grouped list for each element
--   in a grouped list, then concat the results.
concatMap :: Eq b => Grouped a -> (a -> Grouped b) -> Grouped b
concatMap :: Grouped a -> (a -> Grouped b) -> Grouped b
concatMap Grouped a
gx a -> Grouped b
f = Grouped (Grouped b) -> Grouped b
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Grouped (Grouped b) -> Grouped b)
-> Grouped (Grouped b) -> Grouped b
forall a b. (a -> b) -> a -> b
$ (a -> Grouped b) -> Grouped a -> Grouped (Grouped b)
forall b a. Eq b => (a -> b) -> Grouped a -> Grouped b
map a -> Grouped b
f Grouped a
gx

------------------------------------------------------------------
------------------------------------------------------------------
-- Builders

-- | Replicate a single element the given number of times.
--   If the given number is less or equal to zero, it produces
--   an empty list.
replicate :: Int -> a -> Grouped a
replicate :: Int -> a -> Grouped a
replicate Int
n a
x = Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped (Seq (Group a) -> Grouped a) -> Seq (Group a) -> Grouped a
forall a b. (a -> b) -> a -> b
$
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
     then Seq (Group a)
forall a. Monoid a => a
mempty
     else Group a -> Seq (Group a)
forall a. a -> Seq a
S.singleton (Group a -> Seq (Group a)) -> Group a -> Seq (Group a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
n a
x

------------------------------------------------------------------
------------------------------------------------------------------
-- Sorting

-- | Sort a grouped list.
sort :: Ord a => Grouped a -> Grouped a
sort :: Grouped a -> Grouped a
sort (Grouped Seq (Group a)
xs) = Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped (Seq (Group a) -> Grouped a) -> Seq (Group a) -> Grouped a
forall a b. (a -> b) -> a -> b
$ [Group a] -> Seq (Group a)
forall a. [a] -> Seq a
S.fromList ([Group a] -> Seq (Group a)) -> [Group a] -> Seq (Group a)
forall a b. (a -> b) -> a -> b
$ ((a, Int) -> Group a) -> [(a, Int)] -> [Group a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Int -> Group a) -> (a, Int) -> Group a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> Int -> Group a) -> (a, Int) -> Group a)
-> (a -> Int -> Group a) -> (a, Int) -> Group a
forall a b. (a -> b) -> a -> b
$ (Int -> a -> Group a) -> a -> Int -> Group a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> a -> Group a
forall a. Int -> a -> Group a
Group)
                            ([(a, Int)] -> [Group a]) -> [(a, Int)] -> [Group a]
forall a b. (a -> b) -> a -> b
$ Map a Int -> [(a, Int)]
forall k a. Map k a -> [(k, a)]
M.toAscList (Map a Int -> [(a, Int)]) -> Map a Int -> [(a, Int)]
forall a b. (a -> b) -> a -> b
$ (Group a -> Map a Int -> Map a Int)
-> Map a Int -> Seq (Group a) -> Map a Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Group a -> Map a Int -> Map a Int
forall k. Ord k => Group k -> Map k Int -> Map k Int
go Map a Int
forall k a. Map k a
M.empty Seq (Group a)
xs
  where
    f :: a -> Maybe a -> Maybe a
f a
n (Just a
k) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
ka -> a -> a
forall a. Num a => a -> a -> a
+a
n
    f a
n Maybe a
_ = a -> Maybe a
forall a. a -> Maybe a
Just a
n
    go :: Group k -> Map k Int -> Map k Int
go (Group Int
n k
a) = (Maybe Int -> Maybe Int) -> k -> Map k Int -> Map k Int
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (Int -> Maybe Int -> Maybe Int
forall a. Num a => a -> Maybe a -> Maybe a
f Int
n) k
a

------------------------------------------------------------------
------------------------------------------------------------------
-- Filtering

-- | Break a grouped list in the elements that match a given condition
--   and those that don't.
partition :: Eq a => (a -> Bool) -> Grouped a -> (Grouped a, Grouped a)
partition :: (a -> Bool) -> Grouped a -> (Grouped a, Grouped a)
partition a -> Bool
f (Grouped Seq (Group a)
xs) = (Group a -> (Grouped a, Grouped a) -> (Grouped a, Grouped a))
-> (Grouped a, Grouped a)
-> Seq (Group a)
-> (Grouped a, Grouped a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Group a -> (Grouped a, Grouped a) -> (Grouped a, Grouped a)
go (Grouped a
forall a. Monoid a => a
mempty, Grouped a
forall a. Monoid a => a
mempty) Seq (Group a)
xs
  where
    go :: Group a -> (Grouped a, Grouped a) -> (Grouped a, Grouped a)
go Group a
g (Grouped a
gtrue,Grouped a
gfalse) =
      if a -> Bool
f (a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ Group a -> a
forall a. Group a -> a
groupElement Group a
g
         then (Group a -> Grouped a
forall a. Group a -> Grouped a
fromGroup Group a
g Grouped a -> Grouped a -> Grouped a
forall a. Semigroup a => a -> a -> a
<> Grouped a
gtrue,Grouped a
gfalse)
         else (Grouped a
gtrue,Group a -> Grouped a
forall a. Group a -> Grouped a
fromGroup Group a
g Grouped a -> Grouped a -> Grouped a
forall a. Semigroup a => a -> a -> a
<> Grouped a
gfalse)

-- | Filter a grouped list by keeping only those elements that match a given condition.
filter :: Eq a => (a -> Bool) -> Grouped a -> Grouped a
filter :: (a -> Bool) -> Grouped a -> Grouped a
filter a -> Bool
f = (Grouped a, Grouped a) -> Grouped a
forall a b. (a, b) -> a
fst ((Grouped a, Grouped a) -> Grouped a)
-> (Grouped a -> (Grouped a, Grouped a)) -> Grouped a -> Grouped a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Grouped a -> (Grouped a, Grouped a)
forall a.
Eq a =>
(a -> Bool) -> Grouped a -> (Grouped a, Grouped a)
partition a -> Bool
f

------------------------------------------------------------------
------------------------------------------------------------------
-- Indexing

-- | Retrieve the element at the given index. If the index is
--   out of the list index range, it returns 'Nothing'.
index :: Grouped a -> Int -> Maybe a
index :: Grouped a -> Int -> Maybe a
index (Grouped Seq (Group a)
gs) Int
k = if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Maybe a
forall a. Maybe a
Nothing else Int -> [Group a] -> Maybe a
go Int
0 ([Group a] -> Maybe a) -> [Group a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ Seq (Group a) -> [Group a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Group a)
gs
  where
    go :: Int -> [Group a] -> Maybe a
go Int
i (Group Int
n a
a : [Group a]
xs) =
       let i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
       in  if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i'
              then a -> Maybe a
forall a. a -> Maybe a
Just a
a
              else Int -> [Group a] -> Maybe a
go Int
i' [Group a]
xs
    go Int
_ [] = Maybe a
forall a. Maybe a
Nothing

-- | Update the element at the given index. If the index is out of range,
--   the original list is returned.
adjust :: Eq a => (a -> a) -> Int -> Grouped a -> Grouped a
adjust :: (a -> a) -> Int -> Grouped a -> Grouped a
adjust a -> a
f Int
i Grouped a
g = Identity (Grouped a) -> Grouped a
forall a. Identity a -> a
runIdentity (Identity (Grouped a) -> Grouped a)
-> Identity (Grouped a) -> Grouped a
forall a b. (a -> b) -> a -> b
$ (a -> Identity a) -> Int -> Grouped a -> Identity (Grouped a)
forall (m :: * -> *) a.
(Monad m, Eq a) =>
(a -> m a) -> Int -> Grouped a -> m (Grouped a)
adjustM (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> (a -> a) -> a -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f) Int
i Grouped a
g

-- | Just like 'adjust', but the function returns in a 'Monad'.
#if MIN_VERSION_base(4,8,0)
adjustM :: (Monad m, Eq a) => (a -> m a) -> Int -> Grouped a -> m (Grouped a)
#else
adjustM :: (Applicative m, Monad m, Eq a) => (a -> m a) -> Int -> Grouped a -> m (Grouped a)
#endif
adjustM :: (a -> m a) -> Int -> Grouped a -> m (Grouped a)
adjustM a -> m a
f Int
k g :: Grouped a
g@(Grouped Seq (Group a)
gs) = if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Grouped a -> m (Grouped a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Grouped a
g else Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped (Seq (Group a) -> Grouped a) -> m (Seq (Group a)) -> m (Grouped a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Seq (Group a) -> m (Seq (Group a))
go Int
0 Int
k Seq (Group a)
gs
  where
    -- Pre-condition: 0 <= i
    go :: Int -> Int -> Seq (Group a) -> m (Seq (Group a))
go Int
npre Int
i Seq (Group a)
gseq =
      case Seq (Group a) -> ViewL (Group a)
forall a. Seq a -> ViewL a
S.viewl Seq (Group a)
gseq of
        Group Int
n a
a S.:< Seq (Group a)
xs ->
          let pre :: Seq (Group a)
pre = Int -> Seq (Group a) -> Seq (Group a)
forall a. Int -> Seq a -> Seq a
S.take Int
npre Seq (Group a)
gs
          in  case () of
                -- This condition implies the change only affects current group.
                -- Furthermore:
                --
                --   i <  n - 1  ==>  i + 1 < n
                --   0 <= i      ==>  1 <= i + 1 < n  ==>  n > 1
                --
                --   Therefore, in this case we know n > 1.
                --
            ()
_ | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 -> (Seq (Group a) -> Seq (Group a))
-> m (Seq (Group a)) -> m (Seq (Group a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq (Group a)
pre Seq (Group a) -> Seq (Group a) -> Seq (Group a)
forall a. Seq a -> Seq a -> Seq a
S.><) (m (Seq (Group a)) -> m (Seq (Group a)))
-> m (Seq (Group a)) -> m (Seq (Group a))
forall a b. (a -> b) -> a -> b
$ do
                  a
a' <- a -> m a
f a
a
                  Seq (Group a) -> m (Seq (Group a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq (Group a) -> m (Seq (Group a)))
-> Seq (Group a) -> m (Seq (Group a))
forall a b. (a -> b) -> a -> b
$
                    if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
                       then Seq (Group a)
gseq
                       else if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                               then Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
1 a
a' Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
a Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
xs
                                    -- Note: i + 1 < n  ==>  0 < n - (i+1)
                               else Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
i a
a Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
1 a
a' Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) a
a Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
xs
                -- This condition implies the change affects the current group, and can
                -- potentially affect the next group.
            ()
_ | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 -> (Seq (Group a) -> Seq (Group a))
-> m (Seq (Group a)) -> m (Seq (Group a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq (Group a)
pre Seq (Group a) -> Seq (Group a) -> Seq (Group a)
forall a. Seq a -> Seq a -> Seq a
S.><) (m (Seq (Group a)) -> m (Seq (Group a)))
-> m (Seq (Group a)) -> m (Seq (Group a))
forall a b. (a -> b) -> a -> b
$ do
                  a
a' <- a -> m a
f a
a
                  Seq (Group a) -> m (Seq (Group a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq (Group a) -> m (Seq (Group a)))
-> Seq (Group a) -> m (Seq (Group a))
forall a b. (a -> b) -> a -> b
$
                    if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
                       then Seq (Group a)
gseq
                       else if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                               then case Seq (Group a) -> ViewL (Group a)
forall a. Seq a -> ViewL a
S.viewl Seq (Group a)
xs of
                                      Group Int
m a
b S.:< Seq (Group a)
ys ->
                                        if a
a' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b
                                           then Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
b Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
ys
                                           else Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
1 a
a' Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
xs
                                      ViewL (Group a)
_ -> Group a -> Seq (Group a)
forall a. a -> Seq a
S.singleton (Group a -> Seq (Group a)) -> Group a -> Seq (Group a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
1 a
a'
                               -- In this branch, n > 1
                               else case Seq (Group a) -> ViewL (Group a)
forall a. Seq a -> ViewL a
S.viewl Seq (Group a)
xs of
                                      Group Int
m a
b S.:< Seq (Group a)
ys ->
                                        if a
a' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b
                                           then Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
a Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
b Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
ys
                                           else Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
a Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
1 a
a' Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
xs
                                      ViewL (Group a)
_ -> [Group a] -> Seq (Group a)
forall a. [a] -> Seq a
S.fromList [ Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
a , Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
1 a
a' ]
                -- This condition implies the change affects the next group, and can
                -- potentially affect the current group and the next to the next group.
            ()
_ | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n -> (Seq (Group a) -> Seq (Group a))
-> m (Seq (Group a)) -> m (Seq (Group a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq (Group a)
pre Seq (Group a) -> Seq (Group a) -> Seq (Group a)
forall a. Seq a -> Seq a -> Seq a
S.><) (m (Seq (Group a)) -> m (Seq (Group a)))
-> m (Seq (Group a)) -> m (Seq (Group a))
forall a b. (a -> b) -> a -> b
$
                  case Seq (Group a) -> ViewL (Group a)
forall a. Seq a -> ViewL a
S.viewl Seq (Group a)
xs of
                    Group Int
m a
b S.:< Seq (Group a)
ys -> do
                      a
b' <- a -> m a
f a
b
                      Seq (Group a) -> m (Seq (Group a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq (Group a) -> m (Seq (Group a)))
-> Seq (Group a) -> m (Seq (Group a))
forall a b. (a -> b) -> a -> b
$
                        if a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b'
                           then Seq (Group a)
gseq
                           else if Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                                   then if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b'
                                           then case Seq (Group a) -> ViewL (Group a)
forall a. Seq a -> ViewL a
S.viewl Seq (Group a)
ys of
                                                  Group Int
l a
c S.:< Seq (Group a)
zs ->
                                                    if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c
                                                       then Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l) a
a Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
zs
                                                       else Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
a Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
ys
                                                  ViewL (Group a)
_ -> Group a -> Seq (Group a)
forall a. a -> Seq a
S.singleton (Group a -> Seq (Group a)) -> Group a -> Seq (Group a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
a
                                           else Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
n a
a Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<|
                                                  case Seq (Group a) -> ViewL (Group a)
forall a. Seq a -> ViewL a
S.viewl Seq (Group a)
ys of
                                                    Group Int
l a
c S.:< Seq (Group a)
zs ->
                                                      if a
b' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c
                                                         then Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
c Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
zs
                                                         else Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
1 a
b' Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
ys
                                                    ViewL (Group a)
_ -> Group a -> Seq (Group a)
forall a. a -> Seq a
S.singleton (Group a -> Seq (Group a)) -> Group a -> Seq (Group a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
1 a
b'
                                   -- In this branch, m > 1
                                   else if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b'
                                           then Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
a Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
b Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
ys
                                           else Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
n a
a Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
1 a
b' Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
b Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
ys
                    ViewL (Group a)
_ -> Seq (Group a) -> m (Seq (Group a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq (Group a) -> m (Seq (Group a)))
-> Seq (Group a) -> m (Seq (Group a))
forall a b. (a -> b) -> a -> b
$ Group a -> Seq (Group a)
forall a. a -> Seq a
S.singleton (Group a -> Seq (Group a)) -> Group a -> Seq (Group a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
n a
a
                -- Otherwise, the current group isn't affected at all.
                -- Note: n < i  ==>  0 < i - n
            ()
_ | Bool
otherwise -> Int -> Int -> Seq (Group a) -> m (Seq (Group a))
go (Int
npreInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) Seq (Group a)
xs
        ViewL (Group a)
_ -> Seq (Group a) -> m (Seq (Group a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq (Group a)
forall a. Seq a
S.empty

------------------------------------------------------------------
------------------------------------------------------------------
-- Sublists

-- | Take the given number of elements from the left end of the
--   list.
take :: Int -> Grouped a -> Grouped a
take :: Int -> Grouped a -> Grouped a
take Int
n (Grouped Seq (Group a)
gs) = Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped (Seq (Group a) -> Grouped a) -> Seq (Group a) -> Grouped a
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Seq (Group a)
forall a. Seq a
S.empty else Int -> Int -> Seq (Group a) -> Seq (Group a)
go Int
0 Int
n Seq (Group a)
gs
  where
    go :: Int -> Int -> Seq (Group a) -> Seq (Group a)
go Int
npre Int
k Seq (Group a)
xs =
      case Seq (Group a) -> ViewL (Group a)
forall a. Seq a -> ViewL a
S.viewl Seq (Group a)
xs of
        Group Int
q a
x S.:< Seq (Group a)
ys ->
          if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
q
             then Int -> Seq (Group a) -> Seq (Group a)
forall a. Int -> Seq a -> Seq a
S.take Int
npre Seq (Group a)
gs Seq (Group a) -> Group a -> Seq (Group a)
forall a. Seq a -> a -> Seq a
S.|> Int -> a -> Group a
forall a. Int -> a -> Group a
Group Int
k a
x
             else Int -> Int -> Seq (Group a) -> Seq (Group a)
go (Int
npreInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
q) Seq (Group a)
ys -- k - q > 0
        ViewL (Group a)
_ -> Seq (Group a)
gs

-- | Discard the given number of elements from the left end of
--   the list.
drop :: Int -> Grouped a -> Grouped a
drop :: Int -> Grouped a -> Grouped a
drop Int
n g :: Grouped a
g@(Grouped Seq (Group a)
gs) = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Grouped a
g else Seq (Group a) -> Grouped a
forall a. Seq (Group a) -> Grouped a
Grouped (Seq (Group a) -> Grouped a) -> Seq (Group a) -> Grouped a
forall a b. (a -> b) -> a -> b
$ Int -> Seq (Group a) -> Seq (Group a)
forall a. Int -> Seq (Group a) -> Seq (Group a)
go Int
n Seq (Group a)
gs
  where
    go :: Int -> Seq (Group a) -> Seq (Group a)
go Int
k Seq (Group a)
xs =
      case Seq (Group a) -> ViewL (Group a)
forall a. Seq a -> ViewL a
S.viewl Seq (Group a)
xs of
        Group Int
q a
x S.:< Seq (Group a)
ys ->
          if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
q
             then Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) a
x Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
ys
             else Int -> Seq (Group a) -> Seq (Group a)
go (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
q) Seq (Group a)
ys
        ViewL (Group a)
_ -> Seq (Group a)
forall a. Seq a
S.empty

------------------------------------------------------------------
------------------------------------------------------------------
-- Traversal

-- | Apply a function with results residing in an applicative functor to every
--   element in a grouped list.
traverseGrouped :: (Applicative f, Eq b) => (a -> f b) -> Grouped a -> f (Grouped b)
traverseGrouped :: (a -> f b) -> Grouped a -> f (Grouped b)
traverseGrouped a -> f b
f = (a -> f (Grouped b) -> f (Grouped b))
-> f (Grouped b) -> Grouped a -> f (Grouped b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x f (Grouped b)
fxs -> (Grouped b -> Grouped b -> Grouped b)
-> f (Grouped b) -> f (Grouped b) -> f (Grouped b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Grouped b -> Grouped b -> Grouped b
forall a. Monoid a => a -> a -> a
mappend (b -> Grouped b
forall (p :: * -> *) a. Pointed p => a -> p a
point (b -> Grouped b) -> f b -> f (Grouped b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x) f (Grouped b)
fxs) (Grouped b -> f (Grouped b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Grouped b
forall a. Monoid a => a
mempty)

-- | Similar to 'traverseGrouped', but instead of applying a function to every element
--   of the list, it is applied to groups of consecutive elements. You might return more
--   than one element, so the result is of type 'Grouped'. The results are then concatenated
--   into a single value, embedded in the applicative functor.
traverseGroupedByGroup :: (Applicative f, Eq b) => (Group a -> f (Grouped b)) -> Grouped a -> f (Grouped b)
traverseGroupedByGroup :: (Group a -> f (Grouped b)) -> Grouped a -> f (Grouped b)
traverseGroupedByGroup Group a -> f (Grouped b)
f (Grouped Seq (Group a)
gs) = Seq (Grouped b) -> Grouped b
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Seq (Grouped b) -> Grouped b)
-> f (Seq (Grouped b)) -> f (Grouped b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Group a -> f (Grouped b)) -> Seq (Group a) -> f (Seq (Grouped b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Group a -> f (Grouped b)
f Seq (Group a)
gs

-- | Like 'traverseGroupedByGroup', but carrying an accumulator.
--   Note the 'Monad' constraint instead of 'Applicative'.
traverseGroupedByGroupAccum ::
#if MIN_VERSION_base(4,8,0)
  (Monad m, Eq b)
#else
  (Applicative m, Monad m, Eq b)
#endif
   => (acc -> Group a -> m (acc, Grouped b))
   -> acc -- ^ Initial value of the accumulator.
   -> Grouped a
   -> m (acc, Grouped b)
traverseGroupedByGroupAccum :: (acc -> Group a -> m (acc, Grouped b))
-> acc -> Grouped a -> m (acc, Grouped b)
traverseGroupedByGroupAccum acc -> Group a -> m (acc, Grouped b)
f acc
acc0 (Grouped Seq (Group a)
gs) = ((acc, Grouped b) -> Group a -> m (acc, Grouped b))
-> (acc, Grouped b) -> Seq (Group a) -> m (acc, Grouped b)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (acc, Grouped b) -> Group a -> m (acc, Grouped b)
go (acc
acc0, Grouped b
forall a. Monoid a => a
mempty) Seq (Group a)
gs
  where
    go :: (acc, Grouped b) -> Group a -> m (acc, Grouped b)
go (acc
acc, Grouped b
gd) Group a
g = (Grouped b -> Grouped b) -> (acc, Grouped b) -> (acc, Grouped b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Grouped b
gd Grouped b -> Grouped b -> Grouped b
forall a. Semigroup a => a -> a -> a
<>) ((acc, Grouped b) -> (acc, Grouped b))
-> m (acc, Grouped b) -> m (acc, Grouped b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> acc -> Group a -> m (acc, Grouped b)
f acc
acc Group a
g

------------------------------------------------------------------
------------------------------------------------------------------
-- Zipping

-- | Combine two lists using a combining function. If one list is longer,
--   remaining elements are discarded.
zipWith :: Eq c => (a -> b -> c) -> Grouped a -> Grouped b -> Grouped c
zipWith :: (a -> b -> c) -> Grouped a -> Grouped b -> Grouped c
zipWith a -> b -> c
f (Grouped Seq (Group a)
xs) (Grouped Seq (Group b)
ys) = [Grouped c] -> Grouped c
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Grouped c] -> Grouped c) -> [Grouped c] -> Grouped c
forall a b. (a -> b) -> a -> b
$ (Group c -> Grouped c) -> [Group c] -> [Grouped c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Group c -> Grouped c
forall a. Group a -> Grouped a
fromGroup ([Group c] -> [Grouped c]) -> [Group c] -> [Grouped c]
forall a b. (a -> b) -> a -> b
$ Seq (Group a) -> Seq (Group b) -> [Group c]
go Seq (Group a)
xs Seq (Group b)
ys
  where
    go :: Seq (Group a) -> Seq (Group b) -> [Group c]
go Seq (Group a)
gs Seq (Group b)
gs' =
      case Seq (Group a) -> ViewL (Group a)
forall a. Seq a -> ViewL a
S.viewl Seq (Group a)
gs of
        Group Int
n a
x S.:< Seq (Group a)
hs ->
          case Seq (Group b) -> ViewL (Group b)
forall a. Seq a -> ViewL a
S.viewl Seq (Group b)
gs' of
            Group Int
m b
y S.:< Seq (Group b)
hs' ->
              let z :: c
z = a -> b -> c
f a
x b
y
              in  case () of
                    ()
_ | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m -> Int -> c -> Group c
forall a. Int -> a -> Group a
Group Int
n c
z Group c -> [Group c] -> [Group c]
forall a. a -> [a] -> [a]
: Seq (Group a) -> Seq (Group b) -> [Group c]
go Seq (Group a)
hs Seq (Group b)
hs'
                    ()
_ | Int
n  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m -> Int -> c -> Group c
forall a. Int -> a -> Group a
Group Int
m c
z Group c -> [Group c] -> [Group c]
forall a. a -> [a] -> [a]
: Seq (Group a) -> Seq (Group b) -> [Group c]
go (Int -> a -> Group a
forall a. Int -> a -> Group a
Group (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
m) a
x Group a -> Seq (Group a) -> Seq (Group a)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group a)
hs) Seq (Group b)
hs'
                    ()
_ -> Int -> c -> Group c
forall a. Int -> a -> Group a
Group Int
n c
z Group c -> [Group c] -> [Group c]
forall a. a -> [a] -> [a]
: Seq (Group a) -> Seq (Group b) -> [Group c]
go Seq (Group a)
hs (Int -> b -> Group b
forall a. Int -> a -> Group a
Group (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) b
y Group b -> Seq (Group b) -> Seq (Group b)
forall a. a -> Seq a -> Seq a
S.<| Seq (Group b)
hs')
            ViewL (Group b)
_ -> []
        ViewL (Group a)
_ -> []

-- | Combine two lists in a single list of pairs. If one list is longer,
--   remaining elements are discarded.
zip :: (Eq a, Eq b) => Grouped a -> Grouped b -> Grouped (a,b)
zip :: Grouped a -> Grouped b -> Grouped (a, b)
zip = (a -> b -> (a, b)) -> Grouped a -> Grouped b -> Grouped (a, b)
forall c a b.
Eq c =>
(a -> b -> c) -> Grouped a -> Grouped b -> Grouped c
zipWith (,)