File: Stream.hs

package info (click to toggle)
haskell-text 1.2.0.6-1~bpo8%2B1
  • links: PTS, VCS
  • area: main
  • in suites: jessie-backports
  • size: 900 kB
  • sloc: haskell: 9,299; ansic: 238; python: 87; ruby: 84; sh: 49; makefile: 29
file content (93 lines) | stat: -rw-r--r-- 3,368 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
-- | This module contains a number of benchmarks for the different streaming
-- functions
--
-- Tested in this benchmark:
--
-- * Most streaming functions
--
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Benchmarks.Stream
    ( benchmark
    ) where

import Control.DeepSeq (NFData (..))
import Criterion (Benchmark, bgroup, bench, nf)
import Data.Text.Internal.Fusion.Types (Step (..), Stream (..))
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as E
import qualified Data.Text.Internal.Encoding.Fusion as T
import qualified Data.Text.Internal.Encoding.Fusion.Common as F
import qualified Data.Text.Internal.Fusion as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL
import qualified Data.Text.Internal.Lazy.Fusion as TL
import qualified Data.Text.Lazy.IO as TL

instance NFData a => NFData (Stream a) where
    -- Currently, this implementation does not force evaluation of the size hint
    rnf (Stream next s0 _) = go s0
      where
        go !s = case next s of
            Done       -> ()
            Skip s'    -> go s'
            Yield x s' -> rnf x `seq` go s'

benchmark :: FilePath -> IO Benchmark
benchmark fp = do
    -- Different formats
    t  <- T.readFile fp
    let !utf8    = T.encodeUtf8 t
        !utf16le = T.encodeUtf16LE t
        !utf16be = T.encodeUtf16BE t
        !utf32le = T.encodeUtf32LE t
        !utf32be = T.encodeUtf32BE t

    -- Once again for the lazy variants
    tl <- TL.readFile fp
    let !utf8L    = TL.encodeUtf8 tl
        !utf16leL = TL.encodeUtf16LE tl
        !utf16beL = TL.encodeUtf16BE tl
        !utf32leL = TL.encodeUtf32LE tl
        !utf32beL = TL.encodeUtf32BE tl

    -- For the functions which operate on streams
    let !s = T.stream t

    return $ bgroup "Stream"

        -- Fusion
        [ bgroup "stream" $
            [ bench "Text"     $ nf T.stream t
            , bench "LazyText" $ nf TL.stream tl
            ]

        -- Encoding.Fusion
        , bgroup "streamUtf8"
            [ bench "Text"     $ nf (T.streamUtf8 E.lenientDecode) utf8
            , bench "LazyText" $ nf (TL.streamUtf8 E.lenientDecode) utf8L
            ]
        , bgroup "streamUtf16LE"
            [ bench "Text"     $ nf (T.streamUtf16LE E.lenientDecode) utf16le
            , bench "LazyText" $ nf (TL.streamUtf16LE E.lenientDecode) utf16leL
            ]
        , bgroup "streamUtf16BE"
            [ bench "Text"     $ nf (T.streamUtf16BE E.lenientDecode) utf16be
            , bench "LazyText" $ nf (TL.streamUtf16BE E.lenientDecode) utf16beL
            ]
        , bgroup "streamUtf32LE"
            [ bench "Text"     $ nf (T.streamUtf32LE E.lenientDecode) utf32le
            , bench "LazyText" $ nf (TL.streamUtf32LE E.lenientDecode) utf32leL
            ]
        , bgroup "streamUtf32BE"
            [ bench "Text"     $ nf (T.streamUtf32BE E.lenientDecode) utf32be
            , bench "LazyText" $ nf (TL.streamUtf32BE E.lenientDecode) utf32beL
            ]

        -- Encoding.Fusion.Common
        , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s
        , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s
        , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s
        , bench "restreamUtf32BE" $ nf F.restreamUtf32BE s
        ]