{-|
Module      : Htcc.Utils.List
Description : Utilities
Copyright   : (c) roki, 2019
License     : MIT
Maintainer  : falgon53@yahoo.co.jp
Stability   : experimental
Portability : POSIX

List utilities
-}
{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
module Htcc.Utils.List (
    -- * Extra functions for lists
    takeWhileLen,
    splitAtLen,
    spanLen,
    lastInit
) where

import           Data.Tuple.Extra (second)
import           Htcc.Utils.Tuple
import           Prelude          hiding (toInteger)

-- | `lastInit` returns @Just (init xxs)@ when @f (last x) == True@ for then given list @xxs@.
-- Otherwise, returns `Nothing`
lastInit :: (a -> Bool) -> [a] -> Maybe [a]
lastInit :: (a -> Bool) -> [a] -> Maybe [a]
lastInit _ [] = Maybe [a]
forall a. Maybe a
Nothing
lastInit f :: a -> Bool
f [x :: a
x]
    | a -> Bool
f a
x = [a] -> Maybe [a]
forall a. a -> Maybe a
Just []
    | Bool
otherwise = Maybe [a]
forall a. Maybe a
Nothing
lastInit y :: a -> Bool
y (x :: a
x:xs :: [a]
xs) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Bool) -> [a] -> Maybe [a]
forall a. (a -> Bool) -> [a] -> Maybe [a]
lastInit a -> Bool
y [a]
xs

-- | `takeWhileLen`, applied to a predicate @f@ and a list @xs@, returns the
-- longest prefix (possibly empty) of @xs@ of elements that satisfy @f@ and
-- the length of the list taken. The time complexity of this function is
-- equivalent to `takeWhile`.
takeWhileLen :: (a -> Bool) -> [a] -> (Int, [a])
takeWhileLen :: (a -> Bool) -> [a] -> (Int, [a])
takeWhileLen = Int -> (a -> Bool) -> [a] -> (Int, [a])
forall t a. Enum t => t -> (a -> Bool) -> [a] -> (t, [a])
takeWhileLen' 0
    where
        takeWhileLen' :: t -> (a -> Bool) -> [a] -> (t, [a])
takeWhileLen' !t
n _ [] = (t
n, [])
        takeWhileLen' !t
n f :: a -> Bool
f (x :: a
x:xs :: [a]
xs)
            | a -> Bool
f a
x = ([a] -> [a]) -> (t, [a]) -> (t, [a])
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ((t, [a]) -> (t, [a])) -> (t, [a]) -> (t, [a])
forall a b. (a -> b) -> a -> b
$ t -> (a -> Bool) -> [a] -> (t, [a])
takeWhileLen' (t -> t
forall a. Enum a => a -> a
succ t
n) a -> Bool
f [a]
xs
            | Bool
otherwise = (t
n, [])

-- | `splitAtLen`, simmilar to `splitAt` but also returns the length of the splited list.
splitAtLen :: Int -> [a] -> (Int, [a], [a])
splitAtLen :: Int -> [a] -> (Int, [a], [a])
splitAtLen !Int
n = Int -> [a] -> (Int, [a], [a])
forall a. Int -> [a] -> (Int, [a], [a])
go Int
n
    where
        go :: Int -> [a] -> (Int, [a], [a])
go 0 xs :: [a]
xs       = (Int
n, [], [a]
xs)
        go !Int
n' (x :: a
x:xs :: [a]
xs) = ([a] -> [a]) -> (Int, [a], [a]) -> (Int, [a], [a])
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ((Int, [a], [a]) -> (Int, [a], [a]))
-> (Int, [a], [a]) -> (Int, [a], [a])
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> (Int, [a], [a])
go (Int -> Int
forall a. Enum a => a -> a
pred Int
n') [a]
xs
        go !Int
n' []     = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n', [], [])

-- | Almost the same as `span`, but returns the number of elements in the list that
-- satisfy @f@ at the same time.
spanLen :: (a -> Bool) -> [a] -> (Int, [a], [a])
spanLen :: (a -> Bool) -> [a] -> (Int, [a], [a])
spanLen = Int -> (a -> Bool) -> [a] -> (Int, [a], [a])
forall t a. Enum t => t -> (a -> Bool) -> [a] -> (t, [a], [a])
spanLen' 0
    where
        spanLen' :: t -> (a -> Bool) -> [a] -> (t, [a], [a])
spanLen' !t
n _ [] = (t
n, [], [])
        spanLen' !t
n f :: a -> Bool
f xs :: [a]
xs@(x :: a
x:xs' :: [a]
xs')
            | a -> Bool
f a
x = ([a] -> [a]) -> (t, [a], [a]) -> (t, [a], [a])
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ((t, [a], [a]) -> (t, [a], [a])) -> (t, [a], [a]) -> (t, [a], [a])
forall a b. (a -> b) -> a -> b
$ t -> (a -> Bool) -> [a] -> (t, [a], [a])
spanLen' (t -> t
forall a. Enum a => a -> a
succ t
n) a -> Bool
f [a]
xs'
            | Bool
otherwise = (t
n, [], [a]
xs)