{- |
Functions that cope both with plain and non-empty structures.

If there are two versions of a function,
where one works on fixed-length lists,
the place the fixed-length list variant to NonEmpty
and the other one here.
-}
module Data.NonEmpty.Mixed where

import qualified Data.NonEmpty.Class as C
import qualified Data.NonEmpty as NonEmpty
import Data.Foldable (Foldable, foldr, )

import Prelude hiding (foldr, scanl, scanr, )


groupBy ::
   (Foldable f) =>
   (a -> a -> Bool) -> f a -> [NonEmpty.T [] a]
groupBy p =
   foldr
      (\x0 yt ->
         let (xr,yr) =
               case yt of
                  NonEmpty.Cons x1 xs : ys ->
                     if p x0 x1
                       then (x1:xs,ys)
                       else ([],yt)
                  [] -> ([],yt)
         in  NonEmpty.Cons x0 xr : yr)
      []

segmentBefore ::
   (Foldable f) =>
   (a -> Bool) -> f a -> ([a], [NonEmpty.T [] a])
segmentBefore p =
   foldr
      (\ x ys ->
         if p x
           then ([], NonEmpty.Cons x (fst ys) : snd ys)
           else (x : fst ys, snd ys))
      ([],[])

mapAdjacent ::
   (C.Cons f, C.Zip f) => (a -> a -> b) -> NonEmpty.T f a -> f b
mapAdjacent f xs =
   C.zipWith f (NonEmpty.flatten xs) (NonEmpty.tail xs)


tails ::
   (C.View f, C.Empty f) =>
   f a -> NonEmpty.T [] (f a)
tails xt =
   NonEmpty.force $
   case C.viewL xt of
      Nothing -> NonEmpty.Cons C.empty []
      Just (_, xs) -> NonEmpty.cons xt $ tails xs

inits ::
   (C.View f, C.Cons f, C.Empty f) =>
   f a -> NonEmpty.T [] (f a)
inits xt =
   NonEmpty.Cons C.empty $
   case C.viewL xt of
      Nothing -> []
      Just (x,xs) -> map (C.cons x) $ NonEmpty.flatten $ inits xs


appendLeft :: (C.Cons f) => [a] -> f a -> f a
appendLeft = flip $ foldr C.cons