{-# LANGUAGE CPP, BangPatterns #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

-- |
-- Module      :  Data.Foldable.Ix
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
--

module Data.Foldable.Ix where

import Data.Foldable

data TwoInThreeBang a b = B23 a !Int !Int deriving TwoInThreeBang a b -> TwoInThreeBang a b -> Bool
(TwoInThreeBang a b -> TwoInThreeBang a b -> Bool)
-> (TwoInThreeBang a b -> TwoInThreeBang a b -> Bool)
-> Eq (TwoInThreeBang a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
Eq a =>
TwoInThreeBang a b -> TwoInThreeBang a b -> Bool
/= :: TwoInThreeBang a b -> TwoInThreeBang a b -> Bool
$c/= :: forall a b.
Eq a =>
TwoInThreeBang a b -> TwoInThreeBang a b -> Bool
== :: TwoInThreeBang a b -> TwoInThreeBang a b -> Bool
$c== :: forall a b.
Eq a =>
TwoInThreeBang a b -> TwoInThreeBang a b -> Bool
Eq

data TwoInThreeBang2 a = B23L a ![Int] !Int

data ThreeInFourBang a b = B34 b b !b ![a] deriving ThreeInFourBang a b -> ThreeInFourBang a b -> Bool
(ThreeInFourBang a b -> ThreeInFourBang a b -> Bool)
-> (ThreeInFourBang a b -> ThreeInFourBang a b -> Bool)
-> Eq (ThreeInFourBang a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq b, Eq a) =>
ThreeInFourBang a b -> ThreeInFourBang a b -> Bool
/= :: ThreeInFourBang a b -> ThreeInFourBang a b -> Bool
$c/= :: forall a b.
(Eq b, Eq a) =>
ThreeInFourBang a b -> ThreeInFourBang a b -> Bool
== :: ThreeInFourBang a b -> ThreeInFourBang a b -> Bool
$c== :: forall a b.
(Eq b, Eq a) =>
ThreeInFourBang a b -> ThreeInFourBang a b -> Bool
Eq

{-| Function to find out the \'index\' (as the reperesentative of the 'Integral' class) of the first element in the 'Foldable' structure (from the left with indices starting from 0), which equals to the first argument. Returns 'Nothing' if there are no such elements.
-}
findIdx1 :: (Eq a, Foldable t, Integral b) => a -> t a -> Maybe b
findIdx1 :: a -> t a -> Maybe b
findIdx1 a
x t a
js = (\(a
_, b
n1, b
_) -> if b
n1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== (-b
1) then Maybe b
forall a. Maybe a
Nothing else b -> Maybe b
forall a. a -> Maybe a
Just b
n1) ((a, b, b) -> Maybe b) -> (t a -> (a, b, b)) -> t a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b, b) -> a -> (a, b, b)) -> (a, b, b) -> t a -> (a, b, b)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (a, b, b) -> a -> (a, b, b)
forall a a. (Ord a, Num a, Eq a) => (a, a, a) -> a -> (a, a, a)
f (a, b, b)
v (t a -> Maybe b) -> t a -> Maybe b
forall a b. (a -> b) -> a -> b
$ t a
js
  where v :: (a, b, b)
v = (a
x, (-b
1), b
0)
        f :: (a, a, a) -> a -> (a, a, a)
f (a
t, a
n, a
m) a
y
         | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 = (a
t, a
n, a
m a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
         | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t = (a
t, a
m, a
m a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
         | Bool
otherwise = (a
t, a
n, a
m a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)

{-| A variant of the 'findIdx1' where the resulting 'Maybe' b is 'Maybe' 'Int'. Possibly can be more optimized.
-}
findIdx1' :: (Eq a, Foldable t) => a -> t a -> Maybe Int
findIdx1' :: a -> t a -> Maybe Int
findIdx1' a
x t a
js = (\(B23 a
_ Int
n1 Int
_) -> if Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1) then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n1) (TwoInThreeBang a Any -> Maybe Int)
-> (t a -> TwoInThreeBang a Any) -> t a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TwoInThreeBang a Any -> a -> TwoInThreeBang a Any)
-> TwoInThreeBang a Any -> t a -> TwoInThreeBang a Any
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' TwoInThreeBang a Any -> a -> TwoInThreeBang a Any
forall a b b. Eq a => TwoInThreeBang a b -> a -> TwoInThreeBang a b
f TwoInThreeBang a Any
forall b. TwoInThreeBang a b
v (t a -> Maybe Int) -> t a -> Maybe Int
forall a b. (a -> b) -> a -> b
$ t a
js
  where v :: TwoInThreeBang a b
v = a -> Int -> Int -> TwoInThreeBang a b
forall a b. a -> Int -> Int -> TwoInThreeBang a b
B23 a
x (-Int
1) Int
0
        f :: TwoInThreeBang a b -> a -> TwoInThreeBang a b
f (B23 a
t Int
n Int
m) a
y
         | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = a -> Int -> Int -> TwoInThreeBang a b
forall a b. a -> Int -> Int -> TwoInThreeBang a b
B23 a
t Int
n (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
         | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t = a -> Int -> Int -> TwoInThreeBang a b
forall a b. a -> Int -> Int -> TwoInThreeBang a b
B23 a
t Int
m (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
         | Bool
otherwise = a -> Int -> Int -> TwoInThreeBang a b
forall a b. a -> Int -> Int -> TwoInThreeBang a b
B23 a
t Int
n (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
         
{-| Function to find out the \'indices\' of the elements in the 'Foldable' structure (from the left with indices starting from 0) that equal to the first argument. Returns empty list if there are no such elements. Uses two passes
through the structure.
-}
findIdxs :: (Eq a, Foldable t) => a -> t a -> [Int]
findIdxs :: a -> t a -> [Int]
findIdxs a
x t a
js = (\(a
_,[Int]
ys,Int
_) -> [Int]
ys) ((a, [Int], Int) -> [Int])
-> (t a -> (a, [Int], Int)) -> t a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, [Int], Int) -> (a, [Int], Int))
-> (a, [Int], Int) -> t a -> (a, [Int], Int)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (a, [Int], Int) -> (a, [Int], Int)
forall a a. (Eq a, Num a) => a -> (a, [a], a) -> (a, [a], a)
f (a, [Int], Int)
forall a. (a, [a], Int)
v (t a -> [Int]) -> t a -> [Int]
forall a b. (a -> b) -> a -> b
$ t a
js
  where v :: (a, [a], Int)
v = (a
x,[],t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
js Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        f :: a -> (a, [a], a) -> (a, [a], a)
f a
y (a
t,[a]
xs,a
m)
         | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t = (a
t,a
ma -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs,a
m a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
         | Bool
otherwise = (a
t,[a]
xs,a
m a -> a -> a
forall a. Num a => a -> a -> a
- a
1)

{-| Function to find out the \'indices\' of the elements in the 'Foldable' structure (from the left with indices starting from 0) that equal to the first argument. Returns empty list if there are no such elements. Uses just one
pass through the structure and additional 'reverse' operation on the resulting list with 'foldl''.
-}
findIdxsL1 :: (Eq a, Foldable t) => a -> t a -> [Int]
findIdxsL1 :: a -> t a -> [Int]
findIdxsL1 a
x t a
js = (\(B23L a
_ [Int]
ys Int
_) -> [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
ys) (TwoInThreeBang2 a -> [Int])
-> (t a -> TwoInThreeBang2 a) -> t a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TwoInThreeBang2 a -> a -> TwoInThreeBang2 a)
-> TwoInThreeBang2 a -> t a -> TwoInThreeBang2 a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' TwoInThreeBang2 a -> a -> TwoInThreeBang2 a
forall a. Eq a => TwoInThreeBang2 a -> a -> TwoInThreeBang2 a
f TwoInThreeBang2 a
v (t a -> [Int]) -> t a -> [Int]
forall a b. (a -> b) -> a -> b
$ t a
js
  where v :: TwoInThreeBang2 a
v = a -> [Int] -> Int -> TwoInThreeBang2 a
forall a. a -> [Int] -> Int -> TwoInThreeBang2 a
B23L a
x [] Int
0
        f :: TwoInThreeBang2 a -> a -> TwoInThreeBang2 a
f (B23L a
t [Int]
xs Int
m) a
y
         | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t = a -> [Int] -> Int -> TwoInThreeBang2 a
forall a. a -> [Int] -> Int -> TwoInThreeBang2 a
B23L a
t (Int
mInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs) (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
         | Bool
otherwise = a -> [Int] -> Int -> TwoInThreeBang2 a
forall a. a -> [Int] -> Int -> TwoInThreeBang2 a
B23L a
t [Int]
xs (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

{-| Inspired by the Data.Vector.slice function from the @vector@ package. Takes a \'slice\' for the 'Foldable' structure converting it to the list. The first argument is the \'index\' of the element in the structure starting from 0 from the left. The second one is the length of the slice.
-}
sliceToList :: (Eq a, Foldable t) => Int -> Int -> t a -> [a]
sliceToList :: Int -> Int -> t a -> [a]
sliceToList Int
idx Int
l t a
js = (\(B34 Int
_ Int
_ Int
_ [a]
ys) -> [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys) (ThreeInFourBang a Int -> [a])
-> (t a -> ThreeInFourBang a Int) -> t a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ThreeInFourBang a Int -> a -> ThreeInFourBang a Int)
-> ThreeInFourBang a Int -> t a -> ThreeInFourBang a Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ThreeInFourBang a Int -> a -> ThreeInFourBang a Int
forall a a.
(Ord a, Num a) =>
ThreeInFourBang a a -> a -> ThreeInFourBang a a
f ThreeInFourBang a Int
forall a. ThreeInFourBang a Int
v (t a -> [a]) -> t a -> [a]
forall a b. (a -> b) -> a -> b
$ t a
js
  where v :: ThreeInFourBang a Int
v = Int -> Int -> Int -> [a] -> ThreeInFourBang a Int
forall a b. b -> b -> b -> [a] -> ThreeInFourBang a b
B34 Int
idx Int
l Int
0 []
        f :: ThreeInFourBang a a -> a -> ThreeInFourBang a a
f (B34 a
idx a
l a
i [a]
xs) a
x
         | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
idx Bool -> Bool -> Bool
&& a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
idx a -> a -> a
forall a. Num a => a -> a -> a
+ a
l a -> a -> a
forall a. Num a => a -> a -> a
- a
1 = a -> a -> a -> [a] -> ThreeInFourBang a a
forall a b. b -> b -> b -> [a] -> ThreeInFourBang a b
B34 a
idx a
l (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
         | Bool
otherwise = a -> a -> a -> [a] -> ThreeInFourBang a a
forall a b. b -> b -> b -> [a] -> ThreeInFourBang a b
B34 a
idx a
l (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) [a]
xs
{-# SPECIALIZE sliceToList :: (Eq a) => Int -> Int -> [a] -> [a] #-}
{-# NOINLINE[2] sliceToList #-}

{-# RULES "sliceToList/lists" sliceToList = s2L #-}
s2L :: (Eq a) => Int -> Int -> [a] -> [a]
s2L :: Int -> Int -> [a] -> [a]
s2L Int
idx Int
l = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
idx ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l)
{-# INLINABLE s2L #-}