git.iko.soy/streamly
on 52ddfee help sign in
streamly/test/Streamly/Test/Data/Serialize/TH.hs
82 lines 2.5 kB history raw
1{-# LANGUAGE TemplateHaskell #-}
3-- |
4-- Module : Streamly.Test.Data.Serialize.TH
5-- Copyright : (c) 2022 Composewell technologies
6-- License : BSD-3-Clause
7-- Maintainer : streamly@composewell.com
8-- Stability : experimental
9-- Portability : GHC
11module Streamly.Test.Data.Serialize.TH (genDatatype) where
13--------------------------------------------------------------------------------
14-- Imports
15--------------------------------------------------------------------------------
17import Language.Haskell.TH
19import Test.QuickCheck.Arbitrary (Arbitrary(..))
20import Test.QuickCheck.Gen (oneof)
22--------------------------------------------------------------------------------
23-- Generated types
24--------------------------------------------------------------------------------
26genDatatype :: String -> Int -> Q [Dec]
27genDatatype tyName numCons =
28 sequence
29 ([ dataD
30 (pure [])
31 (mkName tyName)
32 []
33 Nothing
34 (mkCon <$> [0 .. (numCons - 1)])
35 [derivClause Nothing [conT ''Eq, conT ''Show]]
36 , instanceD
37 (pure [])
38 (appT (conT ''Arbitrary) (conT (mkName tyName)))
39 [ funD
40 'arbitrary
41 [ clause
42 []
43 (normalB
44 (appE
45 (varE 'oneof)
46 (listE
47 (mkArbitraryExp <$>
48 [0 .. (numCons - 1)]))))
49 []
50 ]
51 ]
52 ])
54 where
56 fieldTypeChoices =
57 [ conT ''Int
58 , conT ''Char
59 , conT ''String
60 , appT listT (conT ''Int)
61 , appT listT (conT ''String)
62 , appT listT (appT listT (conT ''Int))
63 , appT listT (appT listT (conT ''String))
64 ]
66 chooseCycle i xs = xs !! (i `mod` length xs)
68 mkArbitraryExp i =
69 foldl
70 (\b a -> [|$(b) <*> $(a)|])
71 [|pure $(conE (mkName ("Constructor" ++ show i)))|]
72 (replicate i (varE 'arbitrary))
74 mkCon i =
75 normalC
76 (mkName ("Constructor" ++ show i))
77 (mkField <$> [0..(i - 1)])
79 mkField i =
80 bangType
81 (bang noSourceUnpackedness noSourceStrictness)
82 (chooseCycle i fieldTypeChoices)