{-# LANGUAGE TypeFamilies #-}

module Data.Queue.SWAG where

import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import GHC.Exts

{- |
>>> slidingWindowAggregationK 3 $ map (:"")['a'..'e']
["abc","bcd","cde"]
>>> slidingWindowAggregationK 100 $ map (:"")['a'..'e']
[]
-}
slidingWindowAggregationK :: (Semigroup a) => Int -> [a] -> [a]
slidingWindowAggregationK :: forall a. Semigroup a => Int -> [a] -> [a]
slidingWindowAggregationK Int
k [a]
_ | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
slidingWindowAggregationK Int
k [a]
xs
  | [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k = a
agg0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Queue a, [a]) -> [a]
forall a b. (a, b) -> b
snd ((Queue a -> a -> (Queue a, a)) -> Queue a -> [a] -> (Queue a, [a])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
L.mapAccumL Queue a -> a -> (Queue a, a)
forall {b}. Semigroup b => Queue b -> b -> (Queue b, b)
step Queue a
queue0 [a]
ys)
  | Bool
otherwise = []
  where
    ([a]
ys0, [a]
ys) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
k [a]
xs
    queue0 :: Queue a
queue0 = [Item (Queue a)] -> Queue a
forall l. IsList l => [Item l] -> l
fromList [a]
[Item (Queue a)]
ys0
    !agg0 :: a
agg0 = Queue a -> a
forall a. Semigroup a => Queue a -> a
sconcatQ Queue a
queue0
    step :: Queue b -> b -> (Queue b, b)
step !Queue b
queue b
x = case Queue b -> Maybe (b, Queue b)
forall a. Semigroup a => Queue a -> Maybe (a, Queue a)
unconsQ (Queue b -> b -> Queue b
forall a. Semigroup a => Queue a -> a -> Queue a
snocQ Queue b
queue b
x) of
      Just (b
_, Queue b
queue') -> (Queue b
queue', Queue b -> b
forall a. Semigroup a => Queue a -> a
sconcatQ Queue b
queue')
      Maybe (b, Queue b)
Nothing -> (Queue b, b)
forall a. HasCallStack => a
undefined

data Agg a = Agg {forall a. Agg a -> a
getAggAcc :: !a, forall a. Agg a -> a
getAggItem :: !a}
  deriving (Agg a -> Agg a -> Bool
(Agg a -> Agg a -> Bool) -> (Agg a -> Agg a -> Bool) -> Eq (Agg a)
forall a. Eq a => Agg a -> Agg a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Agg a -> Agg a -> Bool
== :: Agg a -> Agg a -> Bool
$c/= :: forall a. Eq a => Agg a -> Agg a -> Bool
/= :: Agg a -> Agg a -> Bool
Eq, Int -> Agg a -> ShowS
[Agg a] -> ShowS
Agg a -> String
(Int -> Agg a -> ShowS)
-> (Agg a -> String) -> ([Agg a] -> ShowS) -> Show (Agg a)
forall a. Show a => Int -> Agg a -> ShowS
forall a. Show a => [Agg a] -> ShowS
forall a. Show a => Agg a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Agg a -> ShowS
showsPrec :: Int -> Agg a -> ShowS
$cshow :: forall a. Show a => Agg a -> String
show :: Agg a -> String
$cshowList :: forall a. Show a => [Agg a] -> ShowS
showList :: [Agg a] -> ShowS
Show)

{- |
>>> Agg "abc" "a" <> Agg "def" "d"
Agg {getAggAcc = "abcdef", getAggItem = "a"}
-}
instance (Semigroup a) => Semigroup (Agg a) where
  (Agg a
accX a
x) <> :: Agg a -> Agg a -> Agg a
<> (Agg a
accY a
_) = a -> a -> Agg a
forall a. a -> a -> Agg a
Agg (a
accX a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
accY) a
x

data Queue a = Q [Agg a] [Agg a]
  deriving (Queue a -> Queue a -> Bool
(Queue a -> Queue a -> Bool)
-> (Queue a -> Queue a -> Bool) -> Eq (Queue a)
forall a. Eq a => Queue a -> Queue a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Queue a -> Queue a -> Bool
== :: Queue a -> Queue a -> Bool
$c/= :: forall a. Eq a => Queue a -> Queue a -> Bool
/= :: Queue a -> Queue a -> Bool
Eq, Int -> Queue a -> ShowS
[Queue a] -> ShowS
Queue a -> String
(Int -> Queue a -> ShowS)
-> (Queue a -> String) -> ([Queue a] -> ShowS) -> Show (Queue a)
forall a. Show a => Int -> Queue a -> ShowS
forall a. Show a => [Queue a] -> ShowS
forall a. Show a => Queue a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Queue a -> ShowS
showsPrec :: Int -> Queue a -> ShowS
$cshow :: forall a. Show a => Queue a -> String
show :: Queue a -> String
$cshowList :: forall a. Show a => [Queue a] -> ShowS
showList :: [Queue a] -> ShowS
Show)

emptyQ :: Queue a
emptyQ :: forall a. Queue a
emptyQ = [Agg a] -> [Agg a] -> Queue a
forall a. [Agg a] -> [Agg a] -> Queue a
Q [] []
{-# INLINE emptyQ #-}

nullQ :: Queue a -> Bool
nullQ :: forall a. Queue a -> Bool
nullQ (Q [Agg a]
fs [Agg a]
rs) = [Agg a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Agg a]
fs Bool -> Bool -> Bool
&& [Agg a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Agg a]
rs
{-# INLINE nullQ #-}

singletonQ :: a -> Queue a
singletonQ :: forall a. a -> Queue a
singletonQ a
x = [Agg a] -> [Agg a] -> Queue a
forall a. [Agg a] -> [Agg a] -> Queue a
Q [a -> a -> Agg a
forall a. a -> a -> Agg a
Agg a
x a
x] []
{-# INLINE singletonQ #-}

{- |
>>> unconsQ $ fromListQ ["a", "b", "c"]
Just ("a",Q [Agg {getAggAcc = "bc", getAggItem = "b"},Agg {getAggAcc = "c", getAggItem = "c"}] [])
>>> unconsQ $ emptyQ |> "a" |> "b" |> "c"
Just ("a",Q [Agg {getAggAcc = "bc", getAggItem = "b"},Agg {getAggAcc = "c", getAggItem = "c"}] [])
>>> unconsQ (emptyQ @String)
Nothing
-}
unconsQ :: (Semigroup a) => Queue a -> Maybe (a, Queue a)
unconsQ :: forall a. Semigroup a => Queue a -> Maybe (a, Queue a)
unconsQ (Q (Agg a
_ a
f : [Agg a]
fs) [Agg a]
rs) = (a, Queue a) -> Maybe (a, Queue a)
forall a. a -> Maybe a
Just (a
f, [Agg a] -> [Agg a] -> Queue a
forall a. [Agg a] -> [Agg a] -> Queue a
Q [Agg a]
fs [Agg a]
rs)
unconsQ (Q [] []) = Maybe (a, Queue a)
forall a. Maybe a
Nothing
unconsQ (Q [] [Agg a]
rs) = case [Agg a] -> Maybe (NonEmpty (Agg a))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Agg a]
rs of
  Maybe (NonEmpty (Agg a))
Nothing -> Maybe (a, Queue a)
forall a. Maybe a
Nothing
  Just NonEmpty (Agg a)
rs' -> case NonEmpty (Agg a) -> NonEmpty (Agg a)
forall a. NonEmpty a -> NonEmpty a
NE.reverse (NonEmpty (Agg a) -> NonEmpty (Agg a))
-> NonEmpty (Agg a) -> NonEmpty (Agg a)
forall a b. (a -> b) -> a -> b
$ (Agg a -> Agg a -> Agg a) -> NonEmpty (Agg a) -> NonEmpty (Agg a)
forall a. (a -> a -> a) -> NonEmpty a -> NonEmpty a
NE.scanl1 (\ !Agg a
acc Agg a
x -> Agg a
x Agg a -> Agg a -> Agg a
forall a. Semigroup a => a -> a -> a
<> Agg a
acc) (NonEmpty (Agg a) -> NonEmpty (Agg a))
-> NonEmpty (Agg a) -> NonEmpty (Agg a)
forall a b. (a -> b) -> a -> b
$ (Agg a -> Agg a) -> NonEmpty (Agg a) -> NonEmpty (Agg a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Agg a
_ a
x) -> a -> a -> Agg a
forall a. a -> a -> Agg a
Agg a
x a
x) NonEmpty (Agg a)
rs' of
    Agg a
_ a
f NE.:| [Agg a]
fs -> (a, Queue a) -> Maybe (a, Queue a)
forall a. a -> Maybe a
Just (a
f, [Agg a] -> [Agg a] -> Queue a
forall a. [Agg a] -> [Agg a] -> Queue a
Q [Agg a]
fs [])
{-# INLINE unconsQ #-}

snocQ :: (Semigroup a) => Queue a -> a -> Queue a
snocQ :: forall a. Semigroup a => Queue a -> a -> Queue a
snocQ (Q [Agg a]
fs [Agg a]
rs) a
x = case [Agg a]
rs of
  [] -> [Agg a] -> [Agg a] -> Queue a
forall a. [Agg a] -> [Agg a] -> Queue a
Q [Agg a]
fs [a -> a -> Agg a
forall a. a -> a -> Agg a
Agg a
x a
x]
  (Agg a
acc a
_ : [Agg a]
_) -> [Agg a] -> [Agg a] -> Queue a
forall a. [Agg a] -> [Agg a] -> Queue a
Q [Agg a]
fs (a -> a -> Agg a
forall a. a -> a -> Agg a
Agg (a
acc a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x) a
x Agg a -> [Agg a] -> [Agg a]
forall a. a -> [a] -> [a]
: [Agg a]
rs)
{-# INLINE snocQ #-}

infixr 5 <|
infixl 5 |>

(|>) :: (Semigroup a) => Queue a -> a -> Queue a
|> :: forall a. Semigroup a => Queue a -> a -> Queue a
(|>) = Queue a -> a -> Queue a
forall a. Semigroup a => Queue a -> a -> Queue a
snocQ
{-# INLINE (|>) #-}

consQ :: (Semigroup a) => a -> Queue a -> Queue a
consQ :: forall a. Semigroup a => a -> Queue a -> Queue a
consQ a
x (Q [Agg a]
fs [Agg a]
rs) = case [Agg a]
fs of
  [] -> [Agg a] -> [Agg a] -> Queue a
forall a. [Agg a] -> [Agg a] -> Queue a
Q [a -> a -> Agg a
forall a. a -> a -> Agg a
Agg a
x a
x] [Agg a]
rs
  (Agg a
acc a
_ : [Agg a]
_) -> [Agg a] -> [Agg a] -> Queue a
forall a. [Agg a] -> [Agg a] -> Queue a
Q (a -> a -> Agg a
forall a. a -> a -> Agg a
Agg (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
acc) a
x Agg a -> [Agg a] -> [Agg a]
forall a. a -> [a] -> [a]
: [Agg a]
fs) [Agg a]
rs
{-# INLINE consQ #-}

(<|) :: (Semigroup a) => a -> Queue a -> Queue a
<| :: forall a. Semigroup a => a -> Queue a -> Queue a
(<|) = a -> Queue a -> Queue a
forall a. Semigroup a => a -> Queue a -> Queue a
consQ
{-# INLINE (<|) #-}

{- |
>>> mconcatQ (("a" <| "b" <| emptyQ) |> "c" |> "d")
"abcd"
>>> mconcatQ (emptyQ @String)
""
-}
mconcatQ :: (Monoid a) => Queue a -> a
mconcatQ :: forall a. Monoid a => Queue a -> a
mconcatQ (Q [Agg a]
fs [Agg a]
rs) = a
f a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
r
  where
    !f :: a
f = (Agg a -> a -> a) -> a -> [Agg a] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> a -> a
forall a b. a -> b -> a
const (a -> a -> a) -> (Agg a -> a) -> Agg a -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Agg a -> a
forall a. Agg a -> a
getAggAcc) a
forall a. Monoid a => a
mempty [Agg a]
fs
    !r :: a
r = (Agg a -> a -> a) -> a -> [Agg a] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> a -> a
forall a b. a -> b -> a
const (a -> a -> a) -> (Agg a -> a) -> Agg a -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Agg a -> a
forall a. Agg a -> a
getAggAcc) a
forall a. Monoid a => a
mempty [Agg a]
rs

{- |
>>> sconcatQ (("a" <| "b" <| emptyQ) |> "c" |> "d")
"abcd"
>>> sconcatQ (emptyQ @String)
*** Exception: Prelude.undefined
-}
sconcatQ :: (Semigroup a) => Queue a -> a
sconcatQ :: forall a. Semigroup a => Queue a -> a
sconcatQ (Q (Agg a
acc a
_ : [Agg a]
_) []) = a
acc
sconcatQ (Q [] (Agg a
acc a
_ : [Agg a]
_)) = a
acc
sconcatQ (Q (Agg a
accF a
_ : [Agg a]
_) (Agg a
accR a
_ : [Agg a]
_)) = a
accF a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
accR
sconcatQ (Q [] []) = a
forall a. HasCallStack => a
undefined

{- |
>>> fromListQ ["a", "b", "c"]
Q [Agg {getAggAcc = "abc", getAggItem = "a"},Agg {getAggAcc = "bc", getAggItem = "b"},Agg {getAggAcc = "c", getAggItem = "c"}] []
-}
fromListQ :: (Semigroup a) => [a] -> Queue a
fromListQ :: forall a. Semigroup a => [a] -> Queue a
fromListQ [a]
xs = case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
xs of
  Maybe (NonEmpty a)
Nothing -> [Agg a] -> [Agg a] -> Queue a
forall a. [Agg a] -> [Agg a] -> Queue a
Q [] []
  Just NonEmpty a
xs' -> [Agg a] -> [Agg a] -> Queue a
forall a. [Agg a] -> [Agg a] -> Queue a
Q (NonEmpty (Agg a) -> [Agg a]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (Agg a) -> [Agg a])
-> (NonEmpty (Agg a) -> NonEmpty (Agg a))
-> NonEmpty (Agg a)
-> [Agg a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Agg a -> Agg a -> Agg a) -> NonEmpty (Agg a) -> NonEmpty (Agg a)
forall a. (a -> a -> a) -> NonEmpty a -> NonEmpty a
NE.scanr1 (\Agg a
x !Agg a
acc -> Agg a
x Agg a -> Agg a -> Agg a
forall a. Semigroup a => a -> a -> a
<> Agg a
acc) (NonEmpty (Agg a) -> [Agg a]) -> NonEmpty (Agg a) -> [Agg a]
forall a b. (a -> b) -> a -> b
$ (a -> Agg a) -> NonEmpty a -> NonEmpty (Agg a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> a -> Agg a
forall a. a -> a -> Agg a
Agg a
x a
x) NonEmpty a
xs') []
{-# INLINE fromListQ #-}

instance (Semigroup a) => IsList (Queue a) where
  type Item (Queue a) = a
  fromList :: [Item (Queue a)] -> Queue a
fromList = [a] -> Queue a
[Item (Queue a)] -> Queue a
forall a. Semigroup a => [a] -> Queue a
fromListQ
  toList :: Queue a -> [Item (Queue a)]
toList (Q [Agg a]
fs [Agg a]
rs) = (Agg a -> a) -> [Agg a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Agg a -> a
forall a. Agg a -> a
getAggItem [Agg a]
fs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a] -> [a]
forall a. [a] -> [a]
reverse ((Agg a -> a) -> [Agg a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Agg a -> a
forall a. Agg a -> a
getAggItem [Agg a]
rs)