{-|
Description : List utilities
-}
module Language.Haskell.Formatter.Toolkit.ListTool
       (maybeLast, dropWhileAtMost, mergeLongerSuccessions, takeEvery,
        concatenateRuns, concatenateShiftedRuns)
       where
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.Monoid as Monoid

{-| The last element, or 'Nothing' if there is none.

    prop> maybeLast [] == Nothing
    prop> maybeLast (l ++ [e]) == Just e -}
maybeLast :: [a] -> Maybe a
maybeLast :: [a] -> Maybe a
maybeLast = [a] -> Maybe a
forall a. [a] -> Maybe a
Maybe.listToMaybe ([a] -> Maybe a) -> ([a] -> [a]) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

{-| @dropWhileAtMost p l@ is like @dropWhile p@, but drops at most @l@ elements.

    >>> dropWhileAtMost (== ' ') 2 "   a bc "
    " a bc " -}
dropWhileAtMost :: (a -> Bool) -> Int -> [a] -> [a]
dropWhileAtMost :: (a -> Bool) -> Int -> [a] -> [a]
dropWhileAtMost a -> Bool
predicate Int
limit [a]
list
  = [a] -> [a] -> [a]
forall a. Monoid a => a -> a -> a
Monoid.mappend ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
predicate [a]
deformable) [a]
rigid
  where ([a]
deformable, [a]
rigid) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
limit [a]
list

{-| @mergeLongerSuccessions p c l@ keeps only the first @c@ elements of
    successive elements of @l@ satisfying the predicate @p@.

    >>> mergeLongerSuccessions Data.Char.isSpace 2 "  ab c  d\LF  e   "
    "  ab c  d\n e  " -}
mergeLongerSuccessions :: (a -> Bool) -> Int -> [a] -> [a]
mergeLongerSuccessions :: (a -> Bool) -> Int -> [a] -> [a]
mergeLongerSuccessions a -> Bool
predicate Int
count = (Int, [a]) -> [a]
forall a b. (a, b) -> b
snd ((Int, [a]) -> [a]) -> ([a] -> (Int, [a])) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [a]) -> a -> (Int, [a])) -> (Int, [a]) -> [a] -> (Int, [a])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (Int, [a]) -> a -> (Int, [a])
merge (Int
0, [])
  where merge :: (Int, [a]) -> a -> (Int, [a])
merge (Int
successionLength, [a]
list) a
element
          = if a -> Bool
predicate a
element then
              if Int
successionLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
count then (Int -> Int
forall a. Enum a => a -> a
succ Int
successionLength, [a]
extended)
                else (Int
count, [a]
list)
              else (Int
0, [a]
extended)
          where extended :: [a]
extended = [a] -> [a] -> [a]
forall a. Monoid a => a -> a -> a
Monoid.mappend [a]
list [a
element]

{-| @takeEvery p l@ takes every @p@th element of @l@ from the first one.

    >>> takeEvery 2 "apple"
    "ape"

    prop> takeEvery 1 l == l -}
takeEvery :: Int -> [a] -> [a]
takeEvery :: Int -> [a] -> [a]
takeEvery Int
_ [] = []
takeEvery Int
period list :: [a]
list@(a
first : [a]
_) = a
first a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
takeEvery Int
period (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
period [a]
list)

{-| @concatenateRuns p l@ repeatedly concatenates @p@ lists of @l@.

    >>> concatenateRuns 2 ["a", "b", "c", "d", "e"]
    ["ab","cd","e"] -}
concatenateRuns :: Int -> [[a]] -> [[a]]
concatenateRuns :: Int -> [[a]] -> [[a]]
concatenateRuns Int
_ [] = []
concatenateRuns Int
period [[a]]
lists = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
run [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [[a]] -> [[a]]
forall a. Int -> [[a]] -> [[a]]
concatenateRuns Int
period [[a]]
rest
  where ([[a]]
run, [[a]]
rest) = Int -> [[a]] -> ([[a]], [[a]])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
period [[a]]
lists

{-| @concatenateShiftedRuns p s l@ first takes @s@ lists of @l@, followed by
    repeatedly concatenating @p@ lists.

    >>> concatenateShiftedRuns 2 1 ["a", "b", "c", "d", "e"]
    ["a","bc","de"]

    prop> p <= 0 || concatenateShiftedRuns p 0 l == concatenateRuns p l -}
concatenateShiftedRuns :: Int -> Int -> [[a]] -> [[a]]
concatenateShiftedRuns :: Int -> Int -> [[a]] -> [[a]]
concatenateShiftedRuns Int
period Int
shift [[a]]
lists
  = case Int
shift of
        Int
0 -> [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
concatenateUnshifted [[a]]
lists
        Int
_ -> [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
shifted [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
concatenateUnshifted [[a]]
unshifted
          where ([[a]]
shifted, [[a]]
unshifted) = Int -> [[a]] -> ([[a]], [[a]])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
shift [[a]]
lists
  where concatenateUnshifted :: [[a]] -> [[a]]
concatenateUnshifted = Int -> [[a]] -> [[a]]
forall a. Int -> [[a]] -> [[a]]
concatenateRuns Int
period