git.iko.soy/streamly
on efecb26 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Serialize/TH.hs
76 lines 2.5 kB history raw
1{-# LANGUAGE TemplateHaskell #-}
3module Streamly.Benchmark.Data.Serialize.TH (genLargeRecord) where
5--------------------------------------------------------------------------------
6-- Imports
7--------------------------------------------------------------------------------
9import Language.Haskell.TH
11import Streamly.Internal.Data.Serialize.TH.Bottom (makeI)
12import Control.DeepSeq (NFData(..))
14--------------------------------------------------------------------------------
15-- Large Record
16--------------------------------------------------------------------------------
18genLargeRecord :: String -> Int -> Q [Dec]
19genLargeRecord tyName numFields =
20 sequence
21 ([ dataD
22 (pure [])
23 (mkName tyName)
24 []
25 Nothing
26 [mkCon tyName]
27 [derivClause Nothing [conT ''Eq, conT ''Show]]
28 , mkValueSigDec
29 , mkValueDec
30 , nfDataInstance tyName
31 ])
33 where
35 fieldTypeChoices = [conT ''()]
36 chooseCycle i xs = xs !! (i `mod` length xs)
37 nfDataInstance nm =
38 instanceD
39 (pure [])
40 (appT (conT ''NFData) (conT (mkName nm)))
41 [ funD
42 'rnf
43 [ clause
44 [ conP
45 (mkName nm)
46 (varP . makeI <$> [0 .. (numFields - 1)])
47 ]
48 (normalB
49 (foldl
50 (\b a -> [|rnf $(b) `seq` rnf $(a)|])
51 [|()|]
52 (varE . makeI <$> [0 .. (numFields - 1)])))
53 []
54 ]
55 ]
56 valueName = mkName $ "val" ++ tyName
57 mkValueSigDec = sigD valueName [t|$(conT (mkName tyName))|]
58 mkValueDec =
59 funD
60 valueName
61 [ clause
62 []
63 (normalB
64 (foldl
65 (\b a -> [|$(b) $(a)|])
66 (conE (mkName tyName))
67 (const (conE '()) <$> [0 .. (numFields - 1)])))
68 []
69 ]
70 mkCon nm = recC (mkName nm) (mkField <$> [0 .. (numFields - 1)])
71 mkField i =
72 varBangType
73 (mkName ("field" ++ show i))
74 (bangType
75 (bang noSourceUnpackedness noSourceStrictness)
76 (chooseCycle i fieldTypeChoices))