{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Data.RLE
(
RLE
, toList, fromList, singleton, empty, cons, uncons
, reverse, splitAt, take, init, null, length, (++)
, map, mapInvertible, traverse, zipWith
, Run(..), toRuns, fromRuns, consRun, unconsRun, runs
) where
import Prelude hiding
( (++), init, length, map, null, reverse
, splitAt, take, traverse, zipWith
)
import qualified Prelude as P
import Control.Applicative (Applicative(..))
import Control.Monad (replicateM)
import Data.Coerce (coerce)
import Data.Functor.Contravariant (Contravariant(..))
import Data.Maybe (fromJust)
import Data.Semigroup (Semigroup(stimes))
import Data.Void (absurd)
import GHC.Exts (IsList, IsString(..))
import qualified GHC.Exts (IsList(..))
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Control.DeepSeq (NFData)
import Data.Portray (Portray(..), Portrayal(..))
import Data.Portray.Diff (Diff(..))
import Data.Serialize (Serialize)
import Data.Wrapped (Wrapped(..))
infixr 5 :><
data Run a = Int :>< a
deriving stock (Run a -> Run a -> Bool
(Run a -> Run a -> Bool) -> (Run a -> Run a -> Bool) -> Eq (Run a)
forall a. Eq a => Run a -> Run a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Run a -> Run a -> Bool
$c/= :: forall a. Eq a => Run a -> Run a -> Bool
== :: Run a -> Run a -> Bool
$c== :: forall a. Eq a => Run a -> Run a -> Bool
Eq, Int -> Run a -> ShowS
[Run a] -> ShowS
Run a -> String
(Int -> Run a -> ShowS)
-> (Run a -> String) -> ([Run a] -> ShowS) -> Show (Run a)
forall a. Show a => Int -> Run a -> ShowS
forall a. Show a => [Run a] -> ShowS
forall a. Show a => Run a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Run a] -> ShowS
$cshowList :: forall a. Show a => [Run a] -> ShowS
show :: Run a -> String
$cshow :: forall a. Show a => Run a -> String
showsPrec :: Int -> Run a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Run a -> ShowS
Show, (forall x. Run a -> Rep (Run a) x)
-> (forall x. Rep (Run a) x -> Run a) -> Generic (Run a)
forall x. Rep (Run a) x -> Run a
forall x. Run a -> Rep (Run a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Run a) x -> Run a
forall a x. Run a -> Rep (Run a) x
$cto :: forall a x. Rep (Run a) x -> Run a
$cfrom :: forall a x. Run a -> Rep (Run a) x
Generic, a -> Run b -> Run a
(a -> b) -> Run a -> Run b
(forall a b. (a -> b) -> Run a -> Run b)
-> (forall a b. a -> Run b -> Run a) -> Functor Run
forall a b. a -> Run b -> Run a
forall a b. (a -> b) -> Run a -> Run b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Run b -> Run a
$c<$ :: forall a b. a -> Run b -> Run a
fmap :: (a -> b) -> Run a -> Run b
$cfmap :: forall a b. (a -> b) -> Run a -> Run b
Functor)
deriving anyclass (Run a -> ()
(Run a -> ()) -> NFData (Run a)
forall a. NFData a => Run a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Run a -> ()
$crnf :: forall a. NFData a => Run a -> ()
NFData, Get (Run a)
Putter (Run a)
Putter (Run a) -> Get (Run a) -> Serialize (Run a)
forall a. Serialize a => Get (Run a)
forall a. Serialize a => Putter (Run a)
forall t. Putter t -> Get t -> Serialize t
get :: Get (Run a)
$cget :: forall a. Serialize a => Get (Run a)
put :: Putter (Run a)
$cput :: forall a. Serialize a => Putter (Run a)
Serialize)
deriving ([Run a] -> Portrayal
Run a -> Portrayal
(Run a -> Portrayal) -> ([Run a] -> Portrayal) -> Portray (Run a)
forall a. Portray a => [Run a] -> Portrayal
forall a. Portray a => Run a -> Portrayal
forall a. (a -> Portrayal) -> ([a] -> Portrayal) -> Portray a
portrayList :: [Run a] -> Portrayal
$cportrayList :: forall a. Portray a => [Run a] -> Portrayal
portray :: Run a -> Portrayal
$cportray :: forall a. Portray a => Run a -> Portrayal
Portray, Run a -> Run a -> Maybe Portrayal
(Run a -> Run a -> Maybe Portrayal) -> Diff (Run a)
forall a. Diff a => Run a -> Run a -> Maybe Portrayal
forall a. (a -> a -> Maybe Portrayal) -> Diff a
diff :: Run a -> Run a -> Maybe Portrayal
$cdiff :: forall a. Diff a => Run a -> Run a -> Maybe Portrayal
Diff) via Wrapped Generic (Run a)
instance Foldable Run where foldMap :: (a -> m) -> Run a -> m
foldMap a -> m
f (Int
n :>< a
x) = Int -> m -> m
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int
n (a -> m
f a
x)
instance Applicative Run where
pure :: a -> Run a
pure = (Int
1 Int -> a -> Run a
forall a. Int -> a -> Run a
:><)
liftA2 :: (a -> b -> c) -> Run a -> Run b -> Run c
liftA2 a -> b -> c
f (Int
m :>< a
x) (Int
n :>< b
y) = Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n Int -> c -> Run c
forall a. Int -> a -> Run a
:>< a -> b -> c
f a
x b
y
(Int
m :>< a -> b
f) <*> :: Run (a -> b) -> Run a -> Run b
<*> (Int
n :>< a
x) = Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n Int -> b -> Run b
forall a. Int -> a -> Run a
:>< a -> b
f a
x
instance Monad Run where (Int
m :>< a
x) >>= :: Run a -> (a -> Run b) -> Run b
>>= a -> Run b
f = case a -> Run b
f a
x of Int
n :>< b
y-> Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n Int -> b -> Run b
forall a. Int -> a -> Run a
:>< b
y
newtype RLE a = RLE
{ RLE a -> [Run a]
toRuns :: [Run a]
}
deriving stock (RLE a -> RLE a -> Bool
(RLE a -> RLE a -> Bool) -> (RLE a -> RLE a -> Bool) -> Eq (RLE a)
forall a. Eq a => RLE a -> RLE a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLE a -> RLE a -> Bool
$c/= :: forall a. Eq a => RLE a -> RLE a -> Bool
== :: RLE a -> RLE a -> Bool
$c== :: forall a. Eq a => RLE a -> RLE a -> Bool
Eq, Int -> RLE a -> ShowS
[RLE a] -> ShowS
RLE a -> String
(Int -> RLE a -> ShowS)
-> (RLE a -> String) -> ([RLE a] -> ShowS) -> Show (RLE a)
forall a. Show a => Int -> RLE a -> ShowS
forall a. Show a => [RLE a] -> ShowS
forall a. Show a => RLE a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLE a] -> ShowS
$cshowList :: forall a. Show a => [RLE a] -> ShowS
show :: RLE a -> String
$cshow :: forall a. Show a => RLE a -> String
showsPrec :: Int -> RLE a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RLE a -> ShowS
Show, (forall x. RLE a -> Rep (RLE a) x)
-> (forall x. Rep (RLE a) x -> RLE a) -> Generic (RLE a)
forall x. Rep (RLE a) x -> RLE a
forall x. RLE a -> Rep (RLE a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RLE a) x -> RLE a
forall a x. RLE a -> Rep (RLE a) x
$cto :: forall a x. Rep (RLE a) x -> RLE a
$cfrom :: forall a x. RLE a -> Rep (RLE a) x
Generic, RLE a -> Bool
(a -> m) -> RLE a -> m
(a -> b -> b) -> b -> RLE a -> b
(forall m. Monoid m => RLE m -> m)
-> (forall m a. Monoid m => (a -> m) -> RLE a -> m)
-> (forall m a. Monoid m => (a -> m) -> RLE a -> m)
-> (forall a b. (a -> b -> b) -> b -> RLE a -> b)
-> (forall a b. (a -> b -> b) -> b -> RLE a -> b)
-> (forall b a. (b -> a -> b) -> b -> RLE a -> b)
-> (forall b a. (b -> a -> b) -> b -> RLE a -> b)
-> (forall a. (a -> a -> a) -> RLE a -> a)
-> (forall a. (a -> a -> a) -> RLE a -> a)
-> (forall a. RLE a -> [a])
-> (forall a. RLE a -> Bool)
-> (forall a. RLE a -> Int)
-> (forall a. Eq a => a -> RLE a -> Bool)
-> (forall a. Ord a => RLE a -> a)
-> (forall a. Ord a => RLE a -> a)
-> (forall a. Num a => RLE a -> a)
-> (forall a. Num a => RLE a -> a)
-> Foldable RLE
forall a. Eq a => a -> RLE a -> Bool
forall a. Num a => RLE a -> a
forall a. Ord a => RLE a -> a
forall m. Monoid m => RLE m -> m
forall a. RLE a -> Bool
forall a. RLE a -> Int
forall a. RLE a -> [a]
forall a. (a -> a -> a) -> RLE a -> a
forall m a. Monoid m => (a -> m) -> RLE a -> m
forall b a. (b -> a -> b) -> b -> RLE a -> b
forall a b. (a -> b -> b) -> b -> RLE a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: RLE a -> a
$cproduct :: forall a. Num a => RLE a -> a
sum :: RLE a -> a
$csum :: forall a. Num a => RLE a -> a
minimum :: RLE a -> a
$cminimum :: forall a. Ord a => RLE a -> a
maximum :: RLE a -> a
$cmaximum :: forall a. Ord a => RLE a -> a
elem :: a -> RLE a -> Bool
$celem :: forall a. Eq a => a -> RLE a -> Bool
length :: RLE a -> Int
$clength :: forall a. RLE a -> Int
null :: RLE a -> Bool
$cnull :: forall a. RLE a -> Bool
toList :: RLE a -> [a]
$ctoList :: forall a. RLE a -> [a]
foldl1 :: (a -> a -> a) -> RLE a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> RLE a -> a
foldr1 :: (a -> a -> a) -> RLE a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> RLE a -> a
foldl' :: (b -> a -> b) -> b -> RLE a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> RLE a -> b
foldl :: (b -> a -> b) -> b -> RLE a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> RLE a -> b
foldr' :: (a -> b -> b) -> b -> RLE a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> RLE a -> b
foldr :: (a -> b -> b) -> b -> RLE a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> RLE a -> b
foldMap' :: (a -> m) -> RLE a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> RLE a -> m
foldMap :: (a -> m) -> RLE a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> RLE a -> m
fold :: RLE m -> m
$cfold :: forall m. Monoid m => RLE m -> m
Foldable)
deriving anyclass (RLE a -> ()
(RLE a -> ()) -> NFData (RLE a)
forall a. NFData a => RLE a -> ()
forall a. (a -> ()) -> NFData a
rnf :: RLE a -> ()
$crnf :: forall a. NFData a => RLE a -> ()
NFData, Get (RLE a)
Putter (RLE a)
Putter (RLE a) -> Get (RLE a) -> Serialize (RLE a)
forall a. Serialize a => Get (RLE a)
forall a. Serialize a => Putter (RLE a)
forall t. Putter t -> Get t -> Serialize t
get :: Get (RLE a)
$cget :: forall a. Serialize a => Get (RLE a)
put :: Putter (RLE a)
$cput :: forall a. Serialize a => Putter (RLE a)
Serialize)
instance Portray a => Portray (RLE a) where
portray :: RLE a -> Portrayal
portray RLE a
rle = Portrayal -> [Portrayal] -> Portrayal
Apply (Ident -> Portrayal
Name Ident
"fromRuns") [[Portrayal] -> Portrayal
List ([Portrayal] -> Portrayal) -> [Portrayal] -> Portrayal
forall a b. (a -> b) -> a -> b
$ Run a -> Portrayal
forall a. Portray a => a -> Portrayal
portray (Run a -> Portrayal) -> [Run a] -> [Portrayal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RLE a -> [Run a]
forall a. RLE a -> [Run a]
toRuns RLE a
rle]
instance (Portray a, Diff a) => Diff (RLE a) where
diff :: RLE a -> RLE a -> Maybe Portrayal
diff RLE a
x RLE a
y = Portrayal -> [Portrayal] -> Portrayal
Apply (Ident -> Portrayal
Name Ident
"fromRuns") ([Portrayal] -> Portrayal)
-> (Portrayal -> [Portrayal]) -> Portrayal -> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Portrayal -> [Portrayal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Portrayal -> Portrayal) -> Maybe Portrayal -> Maybe Portrayal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Run a] -> [Run a] -> Maybe Portrayal
forall a. Diff a => a -> a -> Maybe Portrayal
diff (RLE a -> [Run a]
forall a. RLE a -> [Run a]
toRuns RLE a
x) (RLE a -> [Run a]
forall a. RLE a -> [Run a]
toRuns RLE a
y)
instance Eq a => IsList (RLE a) where
type Item (RLE a) = a
fromList :: [Item (RLE a)] -> RLE a
fromList = [Item (RLE a)] -> RLE a
forall a. Eq a => [a] -> RLE a
fromList
toList :: RLE a -> [Item (RLE a)]
toList = RLE a -> [Item (RLE a)]
forall a. RLE a -> [a]
toList
instance a ~ Char => IsString (RLE a) where
fromString :: String -> RLE a
fromString = String -> RLE a
forall a. Eq a => [a] -> RLE a
fromList
instance Eq a => Semigroup (RLE a) where
<> :: RLE a -> RLE a -> RLE a
(<>) = RLE a -> RLE a -> RLE a
forall a. Eq a => RLE a -> RLE a -> RLE a
(++)
stimes :: b -> RLE a -> RLE a
stimes b
0 RLE a
_ = RLE a
forall a. RLE a
empty
stimes b
_ (RLE []) = RLE a
forall a. RLE a
empty
stimes b
n (RLE [Int
nx :>< a
x]) = [Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE [(b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nx Int -> a -> Run a
forall a. Int -> a -> Run a
:>< a
x)]
stimes b
n0 (RLE (Run a
r0:[Run a]
rs0)) = [Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE ([Run a] -> RLE a) -> [Run a] -> RLE a
forall a b. (a -> b) -> a -> b
$ b -> [Run a] -> [Run a]
go (b
n0 b -> b -> b
forall a. Num a => a -> a -> a
- b
1) [Run a]
rs0
where
adjustedCycle :: [Run a]
adjustedCycle = RLE a -> [Run a]
forall a. RLE a -> [Run a]
toRuns (RLE a -> [Run a]) -> RLE a -> [Run a]
forall a b. (a -> b) -> a -> b
$ [Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE [Run a]
rs0 RLE a -> RLE a -> RLE a
forall a. Eq a => RLE a -> RLE a -> RLE a
++ [Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE [Run a
r0]
go :: b -> [Run a] -> [Run a]
go b
0 [Run a]
rs = Run a
r0Run a -> [Run a] -> [Run a]
forall a. a -> [a] -> [a]
:[Run a]
rs
go b
n [Run a]
rs = b -> [Run a] -> [Run a]
go (b
nb -> b -> b
forall a. Num a => a -> a -> a
-b
1) ([Run a]
adjustedCycle [Run a] -> [Run a] -> [Run a]
forall a. [a] -> [a] -> [a]
P.++ [Run a]
rs)
instance Eq a => Monoid (RLE a) where
mempty :: RLE a
mempty = RLE a
forall a. RLE a
empty
empty :: RLE a
empty :: RLE a
empty = [Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE []
null :: RLE a -> Bool
null :: RLE a -> Bool
null = [Run a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null ([Run a] -> Bool) -> (RLE a -> [Run a]) -> RLE a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RLE a -> [Run a]
forall a. RLE a -> [Run a]
toRuns
length :: RLE a -> Int
length :: RLE a -> Int
length (RLE [Run a]
rs0) = [Run a] -> Int
forall a. [Run a] -> Int
go [Run a]
rs0
where
go :: [Run a] -> Int
go [] = Int
0
go ((Int
n :>< a
_) : [Run a]
rs) = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Run a] -> Int
go [Run a]
rs
fromList :: Eq a => [a] -> RLE a
fromList :: [a] -> RLE a
fromList = (a -> RLE a -> RLE a) -> RLE a -> [a] -> RLE a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> RLE a -> RLE a
forall a. Eq a => a -> RLE a -> RLE a
cons RLE a
forall a. RLE a
empty
toList :: RLE a -> [a]
toList :: RLE a -> [a]
toList (RLE []) = []
toList (RLE ((Int
n :>< a
x):[Run a]
xs)) = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
n a
x [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> RLE a -> [a]
forall a. RLE a -> [a]
toList ([Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE [Run a]
xs)
cons :: Eq a => a -> RLE a -> RLE a
cons :: a -> RLE a -> RLE a
cons = Run a -> RLE a -> RLE a
forall a. Eq a => Run a -> RLE a -> RLE a
consRun (Run a -> RLE a -> RLE a) -> (a -> Run a) -> a -> RLE a -> RLE a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
1 Int -> a -> Run a
forall a. Int -> a -> Run a
:><)
consRun_ :: Eq a => Run a -> [Run a] -> [Run a]
consRun_ :: Run a -> [Run a] -> [Run a]
consRun_ (Int
nx :>< a
x) ((Int
ny :>< a
y) : [Run a]
rs) | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = (Int
nxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ny Int -> a -> Run a
forall a. Int -> a -> Run a
:>< a
x) Run a -> [Run a] -> [Run a]
forall a. a -> [a] -> [a]
: [Run a]
rs
consRun_ (Int
0 :>< a
_) [Run a]
rs = [Run a]
rs
consRun_ Run a
r [Run a]
rs = Run a
r Run a -> [Run a] -> [Run a]
forall a. a -> [a] -> [a]
: [Run a]
rs
consRun :: forall a. Eq a => Run a -> RLE a -> RLE a
consRun :: Run a -> RLE a -> RLE a
consRun = (Run a -> [Run a] -> [Run a]) -> Run a -> RLE a -> RLE a
coerce (Eq a => Run a -> [Run a] -> [Run a]
forall a. Eq a => Run a -> [Run a] -> [Run a]
consRun_ @a)
uncons :: Eq a => RLE a -> Maybe (a, RLE a)
uncons :: RLE a -> Maybe (a, RLE a)
uncons (RLE a -> Maybe (Run a, RLE a)
forall a. RLE a -> Maybe (Run a, RLE a)
unconsRun -> Just (Int
n :>< a
a, RLE a
rest)) = (a, RLE a) -> Maybe (a, RLE a)
forall a. a -> Maybe a
Just (a
a, Run a -> RLE a -> RLE a
forall a. Eq a => Run a -> RLE a -> RLE a
consRun (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Int -> a -> Run a
forall a. Int -> a -> Run a
:>< a
a) RLE a
rest)
uncons RLE a
_ = Maybe (a, RLE a)
forall a. Maybe a
Nothing
unconsRun :: RLE a -> Maybe (Run a, RLE a)
unconsRun :: RLE a -> Maybe (Run a, RLE a)
unconsRun (RLE (Run a
r:[Run a]
rs)) = (Run a, RLE a) -> Maybe (Run a, RLE a)
forall a. a -> Maybe a
Just (Run a
r, [Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE [Run a]
rs)
unconsRun RLE a
_ = Maybe (Run a, RLE a)
forall a. Maybe a
Nothing
take :: Int -> RLE a -> RLE a
take :: Int -> RLE a -> RLE a
take Int
n (RLE [Run a]
xs) = [Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE (Int -> [Run a] -> [Run a]
forall a. Int -> [Run a] -> [Run a]
go Int
n [Run a]
xs)
where
go :: Int -> [Run a] -> [Run a]
go Int
0 [Run a]
_ = []
go Int
_ [] = []
go Int
i ((Int
l :>< a
x):[Run a]
rs) = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
i Int
l Int -> a -> Run a
forall a. Int -> a -> Run a
:>< a
x) Run a -> [Run a] -> [Run a]
forall a. a -> [a] -> [a]
: Int -> [Run a] -> [Run a]
go (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l)) [Run a]
rs
splitAt :: (HasCallStack, Eq a) => Int -> RLE a -> (RLE a, RLE a)
splitAt :: Int -> RLE a -> (RLE a, RLE a)
splitAt Int
n RLE a
rle = RLE a -> Int -> RLE a -> (RLE a, RLE a)
forall a. Eq a => RLE a -> Int -> RLE a -> (RLE a, RLE a)
go RLE a
rle Int
n RLE a
forall a. RLE a
empty
where
go :: RLE a -> Int -> RLE a -> (RLE a, RLE a)
go RLE a
r Int
i RLE a
prev
| RLE a -> Bool
forall a. RLE a -> Bool
null RLE a
r Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (RLE a -> RLE a
forall a. RLE a -> RLE a
reverse RLE a
prev, RLE a
r)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = ( RLE a -> RLE a
forall a. RLE a -> RLE a
reverse ((Int
i Int -> a -> Run a
forall a. Int -> a -> Run a
:>< a
a) Run a -> RLE a -> RLE a
forall a. Eq a => Run a -> RLE a -> RLE a
`consRun` RLE a
prev)
, Run a -> RLE a -> RLE a
forall a. Eq a => Run a -> RLE a -> RLE a
consRun (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> a -> Run a
forall a. Int -> a -> Run a
:>< a
a) RLE a
r')
| Bool
otherwise = RLE a -> Int -> RLE a -> (RLE a, RLE a)
go RLE a
r' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) ((Int
len Int -> a -> Run a
forall a. Int -> a -> Run a
:>< a
a) Run a -> RLE a -> RLE a
forall a. Eq a => Run a -> RLE a -> RLE a
`consRun` RLE a
prev)
where
((Int
len :>< a
a), RLE a
r') = Maybe (Run a, RLE a) -> (Run a, RLE a)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Run a, RLE a) -> (Run a, RLE a))
-> Maybe (Run a, RLE a) -> (Run a, RLE a)
forall a b. (a -> b) -> a -> b
$ RLE a -> Maybe (Run a, RLE a)
forall a. RLE a -> Maybe (Run a, RLE a)
unconsRun RLE a
r
reverse :: RLE a -> RLE a
reverse :: RLE a -> RLE a
reverse (RLE [Run a]
r) = [Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE ([Run a] -> [Run a]
forall a. [a] -> [a]
P.reverse [Run a]
r)
singleton :: a -> RLE a
singleton :: a -> RLE a
singleton a
a = [Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE [Int
1 Int -> a -> Run a
forall a. Int -> a -> Run a
:>< a
a]
(++) :: Eq a => RLE a -> RLE a -> RLE a
++ :: RLE a -> RLE a -> RLE a
(++) (RLE (Run a
x0:xs :: [Run a]
xs@(Run a
_:[Run a]
_))) = \RLE a
ys -> [Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE ([Run a] -> RLE a) -> [Run a] -> RLE a
forall a b. (a -> b) -> a -> b
$ Run a
x0 Run a -> [Run a] -> [Run a]
forall a. a -> [a] -> [a]
: RLE a -> [Run a]
forall a. RLE a -> [Run a]
toRuns ([Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE [Run a]
xs RLE a -> RLE a -> RLE a
forall a. Eq a => RLE a -> RLE a -> RLE a
++ RLE a
ys)
(++) (RLE [Run a
r]) = Run a -> RLE a -> RLE a
forall a. Eq a => Run a -> RLE a -> RLE a
consRun Run a
r
(++) (RLE []) = RLE a -> RLE a
forall a. a -> a
id
map :: Eq b => (a -> b) -> RLE a -> RLE b
map :: (a -> b) -> RLE a -> RLE b
map a -> b
f (RLE [Run a]
xs) = [Run b] -> RLE b
forall a. Eq a => [Run a] -> RLE a
fromRuns ((Run a -> Run b) -> [Run a] -> [Run b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Run a -> Run b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Run a]
xs)
mapInvertible :: (a -> b) -> RLE a -> RLE b
mapInvertible :: (a -> b) -> RLE a -> RLE b
mapInvertible a -> b
f (RLE [Run a]
xs) = [Run b] -> RLE b
forall a. [Run a] -> RLE a
RLE ((Run a -> Run b) -> [Run a] -> [Run b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Run a -> Run b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Run a]
xs)
traverse :: (Eq b, Applicative f) => (a -> f b) -> RLE a -> f (RLE b)
traverse :: (a -> f b) -> RLE a -> f (RLE b)
traverse a -> f b
f RLE a
rle = case RLE a -> Maybe (Run a, RLE a)
forall a. RLE a -> Maybe (Run a, RLE a)
unconsRun RLE a
rle of
Maybe (Run a, RLE a)
Nothing -> RLE b -> f (RLE b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure RLE b
forall a. RLE a
empty
Just (Int
n :>< a
x, RLE a
rs) -> (RLE b -> [b] -> RLE b) -> [b] -> RLE b -> RLE b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> RLE b -> RLE b) -> RLE b -> [b] -> RLE b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr b -> RLE b -> RLE b
forall a. Eq a => a -> RLE a -> RLE a
cons)
([b] -> RLE b -> RLE b) -> f [b] -> f (RLE b -> RLE b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f b -> f [b]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (a -> f b
f a
x)
f (RLE b -> RLE b) -> f (RLE b) -> f (RLE b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> RLE a -> f (RLE b)
forall b (f :: * -> *) a.
(Eq b, Applicative f) =>
(a -> f b) -> RLE a -> f (RLE b)
traverse a -> f b
f RLE a
rs
runs
:: (Contravariant f, Applicative f)
=> (Run a -> f (Run a))
-> RLE a -> f (RLE a)
runs :: (Run a -> f (Run a)) -> RLE a -> f (RLE a)
runs Run a -> f (Run a)
f RLE a
rle = (Void -> RLE a) -> f Void -> f (RLE a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Void -> RLE a
forall a. Void -> a
absurd (f Void -> f (RLE a)) -> f Void -> f (RLE a)
forall a b. (a -> b) -> a -> b
$ (Void -> [Run a]) -> f [Run a] -> f Void
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Void -> [Run a]
forall a. Void -> a
absurd (f [Run a] -> f Void) -> f [Run a] -> f Void
forall a b. (a -> b) -> a -> b
$ (Run a -> f (Run a)) -> [Run a] -> f [Run a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
P.traverse Run a -> f (Run a)
f ([Run a] -> f [Run a]) -> [Run a] -> f [Run a]
forall a b. (a -> b) -> a -> b
$ RLE a -> [Run a]
forall a. RLE a -> [Run a]
toRuns RLE a
rle
fromRuns :: Eq a => [Run a] -> RLE a
fromRuns :: [Run a] -> RLE a
fromRuns = (Run a -> RLE a -> RLE a) -> RLE a -> [Run a] -> RLE a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Run a -> RLE a -> RLE a
forall a. Eq a => Run a -> RLE a -> RLE a
consRun RLE a
forall a. RLE a
empty
zipWith :: Eq c => (a -> b -> c) -> RLE a -> RLE b -> RLE c
zipWith :: (a -> b -> c) -> RLE a -> RLE b -> RLE c
zipWith a -> b -> c
f (RLE [Run a]
xs0) (RLE [Run b]
ys0) = [Run c] -> RLE c
forall a. [Run a] -> RLE a
RLE ([Run c] -> RLE c) -> [Run c] -> RLE c
forall a b. (a -> b) -> a -> b
$ [Run a] -> [Run b] -> [Run c]
go [Run a]
xs0 [Run b]
ys0
where
go :: [Run a] -> [Run b] -> [Run c]
go [] [Run b]
_ = []
go [Run a]
_ [] = []
go ((Int
nx :>< a
x) : [Run a]
xs) ((Int
ny :>< b
y) : [Run b]
ys) = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
nx Int
ny of
Ordering
LT -> (Int
nx Int -> c -> Run c
forall a. Int -> a -> Run a
:>< a -> b -> c
f a
x b
y) Run c -> [Run c] -> [Run c]
forall a. Eq a => Run a -> [Run a] -> [Run a]
`consRun_` [Run a] -> [Run b] -> [Run c]
go [Run a]
xs ((Int
nyInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nx Int -> b -> Run b
forall a. Int -> a -> Run a
:>< b
y) Run b -> [Run b] -> [Run b]
forall a. a -> [a] -> [a]
: [Run b]
ys)
Ordering
GT -> (Int
ny Int -> c -> Run c
forall a. Int -> a -> Run a
:>< a -> b -> c
f a
x b
y) Run c -> [Run c] -> [Run c]
forall a. Eq a => Run a -> [Run a] -> [Run a]
`consRun_` [Run a] -> [Run b] -> [Run c]
go ((Int
nxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ny Int -> a -> Run a
forall a. Int -> a -> Run a
:>< a
x) Run a -> [Run a] -> [Run a]
forall a. a -> [a] -> [a]
: [Run a]
xs) [Run b]
ys
Ordering
EQ -> (Int
nx Int -> c -> Run c
forall a. Int -> a -> Run a
:>< a -> b -> c
f a
x b
y) Run c -> [Run c] -> [Run c]
forall a. Eq a => Run a -> [Run a] -> [Run a]
`consRun_` [Run a] -> [Run b] -> [Run c]
go [Run a]
xs [Run b]
ys
init :: HasCallStack => RLE a -> RLE a
init :: RLE a -> RLE a
init (RLE [Run a]
rs0) = [Run a] -> RLE a
forall a. [Run a] -> RLE a
RLE ([Run a] -> RLE a) -> [Run a] -> RLE a
forall a b. (a -> b) -> a -> b
$ [Run a] -> [Run a]
forall a. [Run a] -> [Run a]
go [Run a]
rs0
where
go :: [Run a] -> [Run a]
go [] = String -> [Run a]
forall a. HasCallStack => String -> a
error String
"RLE.init: empty RLE"
go (Run a
r0:Run a
r:[Run a]
rs) = Run a
r0 Run a -> [Run a] -> [Run a]
forall a. a -> [a] -> [a]
: [Run a] -> [Run a]
go (Run a
rRun a -> [Run a] -> [Run a]
forall a. a -> [a] -> [a]
:[Run a]
rs)
go [Int
n :>< a
x] = [Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Int -> a -> Run a
forall a. Int -> a -> Run a
:>< a
x | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1]