{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
import Criterion ( Benchmark, bench, bgroup, env, nf )
import Criterion.Main ( defaultMain )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.String as S
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified "string-interpolate" Data.String.Interpolate as SI
import qualified "string-interpolate" Data.String.Interpolate.Conversion as SI
import qualified "interpolate" Data.String.Interpolate.IsString as I
import "formatting" Formatting ( (%) )
import qualified "formatting" Formatting as F
import qualified "formatting" Formatting.ShortFormatters as F
import qualified "neat-interpolation" NeatInterpolation as NI
import Control.DeepSeq
import Test.QuickCheck
#ifdef EXTENDED_BENCHMARKS
import "Interpolation" Data.String.Interpolation as N
import "interpolatedstring-perl6" Text.InterpolatedString.Perl6 as P
#endif
type SIInterpolatable str flag =
( SI.IsCustomSink str ~ flag
, SI.InterpSink flag str
, SI.Interpolatable flag str str
, SI.Interpolatable flag Int str
, SI.Interpolatable flag Bool str
)
type AllInterpolatable str flag =
( SIInterpolatable str flag
, Show str
, S.IsString str
, Monoid str
)
--------------------
-- string-interpolate
--------------------
singleInterpSI :: SIInterpolatable str flag => str -> str
singleInterpSI str = [SI.i|A fine day to die, #{str}.|]
multiInterpSI :: SIInterpolatable str flag => (Int, str, Bool) -> str
multiInterpSI (x, y, z) = [SI.i| foo #{x} bar #{y} baz #{z} quux |]
--------------------
-- interpolate
--------------------
singleInterpI :: (Show str, S.IsString str) => str -> str
singleInterpI str = [I.i|A fine day to die, #{str}.|]
multiInterpI :: (Show str, S.IsString str) => (Int, str, Bool) -> str
multiInterpI (x, y, z) = [I.i| foo #{x} bar #{y} baz #{z} quux |]
--------------------
-- formatting
--------------------
stringF :: String -> String
stringF = F.formatToString ("A fine day to die, " % F.s % ".")
multiStringF :: (Int, String, Bool) -> String
multiStringF (x, y, z) =
F.formatToString (" foo " % F.d % " bar " % F.s % " baz " % F.sh % " quux ") x y z
textF :: T.Text -> T.Text
textF = F.sformat ("A fine day to die, " % F.st % ".")
multiTextF :: (Int, T.Text, Bool) -> T.Text
multiTextF (x, y, z) =
F.sformat (" foo " % F.d % " bar " % F.st % " baz " % F.sh % " quux ") x y z
lazyTextF :: LT.Text -> LT.Text
lazyTextF = F.format ("A find day to die, " % F.t % ".")
multiLazyTextF :: (Int, LT.Text, Bool) -> LT.Text
multiLazyTextF (x, y, z) =
F.format (" foo " % F.d % " bar " % F.t % " baz " % F.sh % " quux ") x y z
--------------------
-- neat-interpolation
--------------------
textNI :: T.Text -> T.Text
textNI t = [NI.text|A fine day to die, $t.|]
multiTextNI :: (Int, T.Text, Bool) -> T.Text
multiTextNI (x, y, z) =
let x' = T.pack $ show x
z' = T.pack $ show z
in [NI.text| foo $x' bar $y baz $z' quux |]
#ifdef EXTENDED_BENCHMARKS
--------------------
-- Interpolation
--------------------
singleInterpN :: (Monoid str, S.IsString str) => str -> str
singleInterpN t = [str|A fine day to die, $t$.|]
multiInterpN ::(Monoid str, S.IsString str) => (Int, str, Bool) -> str
multiInterpN (x, y, z) = [str| foo $:x$ bar $y$ baz $:z$ quux |]
--------------------
-- interpolatedstring-perl6
--------------------
singleInterpP :: (Monoid str, S.IsString str) => str -> str
singleInterpP t = [qc|A fine day to die, {t}.|]
multiInterpP :: (Monoid str, S.IsString str) => (Int, str, Bool) -> str
multiInterpP (x, y, z) = [qc| foo {x} bar {y} baz {z} quux |]
#endif
--------------------
-- BENCHMARK GROUPS
--------------------
singleInterpBenches :: AllInterpolatable str flag
=> [(String, (str -> str))]
singleInterpBenches =
[ ("string-interpolate" , singleInterpSI)
, ("interpolate" , singleInterpI)
#ifdef EXTENDED_BENCHMARKS
, ("interpolatedstring-perl6", singleInterpP)
, ("Interpolation" , singleInterpN)
#endif
]
multiInterpBenches :: AllInterpolatable str flag
=> [(String, ((Int, str, Bool) -> str))]
multiInterpBenches =
[ ("string-interpolate" , multiInterpSI)
, ("interpolate" , multiInterpI)
#ifdef EXTENDED_BENCHMARKS
, ("interpolatedstring-perl6", multiInterpP)
, ("Interpolation" , multiInterpN)
#endif
]
main :: IO ()
main = defaultMain $
[ benches @String "Small Strings Bench" "William" $
singleInterpBenches ++
[ ("formatting", stringF) ]
, benches @T.Text "Small Text Bench" "William" $
singleInterpBenches ++
[ ("formatting" , textF)
, ("neat-interpolation", textNI)
]
, benches @LT.Text "Small Lazy Text Bench" "William" $
singleInterpBenches ++
[ ("formatting", lazyTextF) ]
, benches @B.ByteString "Small ByteStrings Bench" "William" $
singleInterpBenches
, benches @LB.ByteString "Small Lazy ByteStrings Bench" "William" $
singleInterpBenches
, benches @String "Multiple Interpolations String Bench" (42, "CATALLAXY", True) $
multiInterpBenches ++
[ ("formatting", multiStringF) ]
, benches @T.Text "Multiple Interpolations Text Bench" (42, "CATALLAXY", True) $
multiInterpBenches ++
[ ("formatting" , multiTextF)
, ("neat-interpolation", multiTextNI)
]
, benches @LT.Text "Multiple Interpolations Lazy Text Bench" (42, "CATALLAXY", True) $
multiInterpBenches ++
[ ("formatting", multiLazyTextF) ]
, benches @B.ByteString "Multiple Interpolations ByteString Bench" (42, "CATALLAXY", True) $
multiInterpBenches
, benches @LB.ByteString "Multiple Interpolations Lazy ByteString Bench" (42, "CATALLAXY", True) $
multiInterpBenches
, env largeishText $ \ ~t -> benches @T.Text "Largeish Text Bench" t $
singleInterpBenches ++
[ ("formatting" , textF)
, ("neat-interpolation", textNI)
]
, env largeishLazyText $ \ ~lt -> benches @LT.Text "Largeish Lazy Text Bench" lt $
singleInterpBenches ++
[ ("formatting", lazyTextF) ]
, env largeishByteString $ \ ~bs -> benches @B.ByteString "Largeish ByteString Bench" bs $
singleInterpBenches
, env largeishLazyByteString $ \ ~lbs -> benches @LB.ByteString "Largeish Lazy ByteString Bench" lbs $
singleInterpBenches
]
largeishText :: IO T.Text
largeishText =
generate $ T.pack <$> Prelude.take 100000 <$> infiniteListOf arbitrary
largeishLazyText :: IO LT.Text
largeishLazyText =
generate $ LT.pack <$> Prelude.take 100000 <$> infiniteListOf arbitrary
largeishByteString :: IO B.ByteString
largeishByteString =
generate $ B.pack <$> Prelude.take 100000 <$> infiniteListOf arbitrary
largeishLazyByteString :: IO LB.ByteString
largeishLazyByteString =
generate $ LB.pack <$> Prelude.take 100000 <$> infiniteListOf arbitrary
--------------------
-- BENCHMARK UTIL
--------------------
benches :: forall b a. NFData b => String -> a -> [(String, a -> b)] -> Benchmark
benches groupname arg fs = bgroup groupname (fmap benchF fs)
where benchF (bname, f) = bench bname $ nf f arg