{-# LANGUAGE MagicHash #-}
{-# OPTIONS_GHC -fglasgow-exts #-}

-- | A module designed for intensive work with lists, emphasizing @fold/build@ optimization and chunking into blocks.
-- /WARNING/: This module exports a number of nonstandard @fold/build@ rules on standard "Data.List" functions,
-- including 'scanl', 'scanl1', 'scanr', 'scanr1', 'tails', 'unfoldr', 'mapAccumR', and 'mapAccumL'.  These optimizations 
-- significantly improve the performance of "Data.RangeMin", but they have not been checked on whether or not they 
-- preserve the strictness of the original functions. Use caution when importing this module, and please notify the 
-- author of any issues found.
module Data.RangeMin.Internal.HandyList (splitEvery, splitEvery') where

import GHC.Exts
import Data.Maybe(fromJust)
import Data.List
import Data.Tree

{-# INLINE consecutives #-}
consecutives :: [e] -> [(e, e)]
consecutives l = build (\ c n -> case foldr (consec c) (Nothing, n) l of (_, l) -> l) where
	consec _ x (Nothing, b) = (Just x, b)
	consec c x (Just y, b) = (Just x, (x, y) `c` b)

{-# INLINE splitEvery #-}
-- | @splitEvery n l@ is equivalent to @map (take n) (takeWhile (not . null) (iterate (drop n) l))@, so
-- 
-- @splitEvery n [x1,x2,..,xm] = [[x1,x2,..,x(n-1)],[xn,x(n+1),..,x(2n-1)],..,[..xm]]@
--
-- It is a good producer in the @fold/build@ sense, but not a good consumer; the author believes
-- this is unavoidable.
splitEvery :: Int -> [e] -> [[e]]
splitEvery i l = map (take i) $ build (splitter l) where
	splitter [] _ n	= n
	splitter l c n	= l `c` splitter (drop i l) c n

data BlockAccum e f = BA Int# [e] f -- hopefully unboxed by GHC

{-# INLINE splitEvery' #-}
splitEvery' :: Int -> Int -> [e] -> [[e]]
splitEvery' (I# n#) (I# bS#) l = build (\ c nil -> case foldr (blocker c) (BA n# [] nil) l of BA _ _ bs -> bs) where
	blocker c x (BA i# b bs) = let j# = i# -# 1# in 
		if j# `remInt#` bS# ==# 0# then BA j# [] ((x:b) `c` bs) else BA j# (x:b) bs

{-# NOINLINE [0] unfoldrFB #-}
unfoldrFB :: (b -> Maybe (a, b)) -> b -> (a -> c -> c) -> c -> c
unfoldrFB g x c n = unfoldr' x where
	unfoldr' = maybe n (\ (a, y) -> a `c` unfoldr' y) . g

{-# NOINLINE [0] scanlFB #-}
scanlFB :: (a -> b -> a) -> a -> [b] -> (a -> c -> c) -> c -> c
scanlFB f x ls c n = scanl' ls x where
	scanl' (l:ls) x	= x `c` scanl' ls (f x l)
	scanl' [] _	= n

{-# NOINLINE [0] tailerFB #-}
tailerFB :: ([a] -> b -> b) -> a -> ([a], b) -> ([a], b)
tailerFB c = \ x (h, l) -> let xh = x:h in (xh, xh `c` l)

{-# NOINLINE [0] scanl1FB #-}
scanl1FB :: (a -> a -> a) -> [a] -> (a -> b -> b) -> b -> b
scanl1FB f (l:ls) c n = scanner l ls where
	scanner x ls = c x $ case ls of
		(y:ys)	-> scanner (f x y) ys
		[]	-> n
scanl1FB _ [] _ n = n

{-# INLINE [1] mebbe #-}
mebbe :: (a -> b -> a) -> a -> Maybe b -> Maybe a
mebbe f x my	| Just y <- my	= Just (f x y)
		| otherwise	= Just x

{-# NOINLINE [0] scanrFB #-}
scanrFB :: (a -> b -> b) -> (b -> c -> c) -> a -> (b, c) -> (b, c)
scanrFB f c = \ x (b, bs) -> let b' = f x b in (b', b' `c` bs)

{-# NOINLINE [0] scanr1FB #-}
scanr1FB :: (a -> a -> a) -> (a -> b -> b) -> a -> (Maybe a, b) -> (Maybe a, b)
scanr1FB f c = \ x (y, m) -> let Just fxy = mebbe f x y in (Just fxy, fxy `c` m)

{-# INLINE [0] mapAccumLFB #-}
mapAccumLFB :: (a -> b -> (a, c)) -> (c -> d -> d) -> [b] -> a -> d -> d
mapAccumLFB f c = accumulator where
	accumulator [] _ t	= t
	accumulator (l:ls) x t	= let (x', a) = f x l in accumulator ls x' (a `c` t)
-- only for use when the second component is all that's needed

{-# INLINE [0] mapAccumRFB #-}
mapAccumRFB :: (a -> b -> (a, c)) -> (c -> d -> d) -> b -> (a, d) -> (a, d)
mapAccumRFB f c = \ x (z, t) -> let (z', a) = f z x in (z', a `c` t)
-- don't bother to transform  back into mapAccumR

{-# INLINE [1] flattenFB #-}
flattenFB :: (a -> b -> b) -> Tree a -> b -> b
flattenFB c (Node x ts) n = x `c` foldr (flattenFB c) n ts

{-# INLINE[0] unckdEFIntFB #-}
unckdEFIntFB :: (Int -> b -> b) -> Int# -> b
unckdEFIntFB c = unckdEFIntFB' where
	unckdEFIntFB' x = I# x `c` unckdEFIntFB' (x +# 1#)

{-# INLINE[0] unckdEFDIntFB #-}
unckdEFDIntFB :: (Int -> b -> b) -> Int# -> Int# -> b
unckdEFDIntFB c x y = unckdEFDInt' x where
	d = x -# y
	unckdEFDInt' x = I# x `c` unckdEFDInt' (x +# d) 

{-# RULES
	"efInt" [~1] forall x . enumFrom x = let I# xx = fromEnum x in map toEnum (build (\ c _ -> unckdEFIntFB c xx));
	"efdInt" [~1] forall x y . enumFromThen x y = let I# xx = fromEnum x; I# yy = fromEnum y in
			map toEnum (build (\ c _ -> unckdEFDIntFB c xx yy));
	"scanl" [~1] forall f x l . scanl f x l = build (scanlFB f x l);
	"scanlList" [1] forall f l x . build (scanlFB f x l) = scanl f x l;
	"tails" [~1] forall l . tails l =
		build (\c n -> case foldr (tailerFB c) ([], [] `c` n) l of (_, l) -> l);
-- 	"tails/map" forall f l . tails (map f l) = build (\ c n -> case foldr (tailerFB c . f) ([], [] `c` n) l of (_, l) -> l);
	"tailsList" [1] forall l . foldr (tailerFB (:)) ([], [[]]) l = (l, tails l);
	"scanl1" [~1] forall f l . scanl1 f l = build (scanl1FB f l);
	"scanl1List" [1] forall f l . scanl1FB f l (:) [] = scanl1 f l;
	"foldr1" [~1] forall f l . foldr1 f l = fromJust (foldr (mebbe f) Nothing l);
	"foldr1List" [1] forall f l . foldr (mebbe f) Nothing l = Just (foldr1 f l);
	"scanr" [~1] forall f x l . scanr f x l = build (\c n -> snd (foldr (scanrFB f c) (x, n) l));
	"scanrList" [1] forall f x l . snd (foldr (scanrFB f (:)) (x, []) l) = scanr f x l;
	"scanr1" [~1] forall f l . scanr1 f l = build (\c n -> snd (foldr (scanr1FB f c) (Nothing, n) l));
	"scanr1List" [1] forall f l . snd (foldr (scanr1FB f (:)) (Nothing, []) l) = scanr1 f l;
	"unfoldr" [~1]  forall g x . unfoldr g x = build (unfoldrFB g x);
	"unfoldrList" [1] forall g x . build (unfoldrFB g x) = unfoldr g x;
	"snd/mapAccumR" [~1] forall f z l . snd (foldr (mapAccumRFB f (:)) (z, []) l) = build (\c n -> snd (foldr (mapAccumRFB f c) (z, n) l));
	"mapAccumR" [~1] forall f z . mapAccumR f z = foldr (mapAccumRFB f (:)) (z, []);
	"snd/mapAccumL" [~1] forall f z l . snd (mapAccumL f z l) = build (\c n -> mapAccumLFB f c l z n);
	"flatten" forall t . flatten t = build (\c n -> flattenFB c t n)
        #-}