module Main (main) where

import Criterion.Main (bench, bgroup, defaultMain, whnf)

import qualified Data.DList as DList

import qualified Data.DList.DNonEmpty as DNonEmpty

import qualified Data.DList.NonEmpty as NonEmptyDList

import qualified Data.Foldable as Foldable

import qualified Data.List.NonEmpty as NonEmpty

import Prelude

main :: IO ()

main =

defaultMain

[ bgroup

"append"

[ bench "List" $

whnf (append 1000) $

[1, 2, 3, 4, 5],

bench "DList" $

whnf (append 1000) $

DList.fromList [1, 2, 3, 4, 5],

bench "NonEmpty" $

whnf (append 1000) $

1 NonEmpty.:| [2, 3, 4, 5],

bench "DNonEmpty" $

whnf (append 1000) $

DNonEmpty.fromNonEmpty $ 1 NonEmpty.:| [2, 3, 4, 5],

bench "NonEmptyDList" $

whnf (append 1000) $

NonEmptyDList.fromNonEmpty $ 1 NonEmpty.:| [2, 3, 4, 5]

],

bgroup

"fmap_append"

[ bench "List" $

whnf (fmap_append 1000) $

[1, 2, 3, 4, 5],

bench "DList" $

whnf (fmap_append 1000) $

DList.fromList [1, 2, 3, 4, 5],

bench "NonEmpty" $

whnf (fmap_append 1000) $

1 NonEmpty.:| [2, 3, 4, 5],

bench "DNonEmpty" $

whnf (fmap_append 1000) $

DNonEmpty.fromNonEmpty $ 1 NonEmpty.:| [2, 3, 4, 5],

bench "NonEmptyDList" $

whnf (fmap_append 1000) $

NonEmptyDList.fromNonEmpty $ 1 NonEmpty.:| [2, 3, 4, 5]

],

bgroup

"Tree"

[ bench "flattenSlow" $

whnf flattenSlow exampleTree,

bench "flattenFast" $

whnf flattenFast exampleTree

]

]

-- | Left-nested append

append :: (Semigroup (f Int), Foldable f) => Int -> f Int -> Int

append m right = Foldable.foldl' (+) 0 $ Foldable.toList $ go m right

where

go n left

| n <= 0 = left

| otherwise = go (pred n) (left <> right)

-- | Left-nested append with map

fmap_append :: (Foldable f, Functor f, Semigroup (f Int)) => Int -> f Int -> Int

fmap_append m x = Foldable.foldl' (+) 0 $ Foldable.toList $ go m x

where

go n y

| n <= 0 = y

| otherwise = go (pred n) (fmap (+ 1) $ y <> x)

data Tree a = Leaf a | Branch (Tree a) (Tree a)

exampleTree :: Tree Char

exampleTree =

Branch

(Branch

(Branch

(Branch (Leaf 'a') (Leaf 'b'))

(Leaf 'c'))

(Leaf 'd'))

(Branch (Leaf 'e') (Leaf 'f'))

flattenSlow :: Tree a -> [a]

flattenSlow = go

where

go (Leaf x) = [x]

go (Branch left right) = go left ++ go right

flattenFast :: Tree a -> [a]

flattenFast = DList.toList . go

where

go (Leaf x) = DList.singleton x

go (Branch left right) = go left `DList.append` go right