{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
import Criterion.Main
import Data.Foldable
import Data.Word
import qualified Data.ByteString as BS

listNext :: [a] -> Maybe (a,[a])
listNext (a:as) = Just (a,as)
listNext [] = Nothing

data Iterator98 list ele = Iterator98 {
	next98 :: Maybe (ele, Iterator98 list ele)
	}

listIter98 :: [a] -> Iterator98 [a] a
listIter98 (x:xs) = Iterator98 $ Just (x, listIter98 xs)
listIter98 [] = Iterator98 $ Nothing

sum98 :: (Num n) => Iterator98 listN n -> n
sum98 iter = rec iter 0 where
	rec (Iterator98 iter') sum' = case iter' of
		(Just (ele,rest)) -> rec rest $! (sum' + ele)
		Nothing -> sum'

data IteratorExplicit98 iter list ele = IteratorExplicit98 {
	iterExplicit98 :: iter,
	nextExplicit98 :: iter -> Maybe (ele, iter)
	}

listIterExplicit98 :: [a] -> IteratorExplicit98 [a] [a] a
listIterExplicit98 list = IteratorExplicit98 list listNext

sumExplicit98 :: (Num n) => IteratorExplicit98 it list n -> n
sumExplicit98 (IteratorExplicit98 iter nextF) = rec iter 0 where
	rec iter' sum' = case nextF iter' of
		(Just (ele,rest)) -> rec rest $! (sum' + ele)
		Nothing -> sum'


class IteratorTF i where
	type ListTF i
	type ElemTF i
	nextTF :: i -> Maybe (ElemTF i, i)

instance IteratorTF [a] where
	type ListTF [a] = [a]
	type ElemTF [a] = a
	nextTF (c:str) = Just (c,str)
	nextTF [] = Nothing

sumTF :: (Num n, IteratorTF it, ElemTF it ~ n) => it -> n
sumTF it' = rec it' 0 where
	rec it sum' = case nextTF it of
		(Just (c,n)) -> rec n $! (sum' + c)
		Nothing -> sum'

class IteratorTF2Class list ele where
	data IteratorTF2 list ele
	nextTF2 :: IteratorTF2 list ele -> Maybe (ele, IteratorTF2 list ele)

instance IteratorTF2Class [ele] ele where
	data IteratorTF2 [ele] ele = ListIterTF2 [ele]
	nextTF2 (ListIterTF2 []) = Nothing
	nextTF2 (ListIterTF2 (x:xs)) = Just (x, ListIterTF2 xs)

sumTF2 :: (Num n, IteratorTF2Class list n) => IteratorTF2 list n -> n
sumTF2 it' = rec it' 0 where
	rec it sum' = case nextTF2 it of
		(Just (c,n)) -> rec n $! (sum' + c)
		Nothing -> sum'

class IteratorMPTC iter list ele | iter -> list, iter -> ele where
	nextMPTC :: iter -> Maybe (ele, iter)

instance IteratorMPTC [a] [a] a where
	nextMPTC (c:str) = Just (c,str)
	nextMPTC [] = Nothing

sumMPTC :: (Num n, IteratorMPTC it list n) => it -> n
sumMPTC it' = rec it' 0 where
	rec it sum' = case nextMPTC it of
		(Just (c,n)) -> rec n $! (sum' + c)
		Nothing -> sum'

data IteratorEQ list ele = forall iter . IteratorEQ {
	iterEQ :: iter,
	nextEQ :: iter -> Maybe (ele, iter)
	}
	
listIterEQ :: [a] -> IteratorEQ [a] a
listIterEQ list = IteratorEQ list listNext

sumEQ :: (Num n) => IteratorEQ list n -> n
sumEQ (IteratorEQ iter nextF) = rec iter 0 where
	rec iter' sum' = case nextF iter' of
		(Just (c,n)) -> rec n $! (sum' + c)
		Nothing -> sum'

explicitSum :: (Num n) => [n] -> n
explicitSum l' = rec l' 0 where
	rec (c:n) s = rec n $! (s + c)
	rec [] s = s

n = 1000000
l = replicate n 5
bs = BS.pack l

main = do
	last l `seq` return ()
	defaultMain [
		bgroup "list" [
			bench "Prelude sum" $ whnf sum l,
			bench "Prelude foldl'" $ whnf (foldl' (+) 0) l,
			bench "explicit sum" $ whnf explicitSum l,
			bench "Iterator 98" $ whnf (sum98 . listIter98) l,
			bench "Iterator explicit 98" $ whnf (sumExplicit98 . listIterExplicit98) l,
			bench "Iterator type families" $ whnf sumTF l,
			bench "Iterator type families 2" $ whnf (sumTF2 . ListIterTF2) l,
			bench "Iterator multiparameter typeclasse" $ whnf sumMPTC l,
			bench "Iterator Existential Quantification" $ whnf (sumEQ . listIterEQ) l
			],
		bgroup "bytestring" [
			bench "foldl'" $ whnf (BS.foldl' (+) 0) bs
			]
		]