{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK show-extensions #-}

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

module Data.Foldable.Ix where

import Data.Foldable

{-| 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)

{-| 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 = (\(a
_,[Int]
ys,Int
_) -> [Int] -> [Int]
forall a. [a] -> [a]
reverse [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, [Int], Int) -> a -> (a, [Int], Int))
-> (a, [Int], Int) -> t a -> (a, [Int], Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (a, [Int], Int) -> a -> (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,[],Int
0)
        f :: (a, [a], a) -> a -> (a, [a], a)
f (a
t,[a]
xs,a
m) a
y
         | 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)