@@ -0,0 +1,70 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+
3+-- |
4+-- Module : Streamly.Internal.Data.Serialize.TH.Common
5+-- Copyright : (c) 2023 Composewell Technologies
6+-- License : BSD3-3-Clause
7+-- Maintainer : streamly@composewell.com
8+-- Stability : experimental
9+-- Portability : GHC
10+--
11+module Streamly.Internal.Data.Serialize.TH.Common
12+ ( mkDeserializeExprOne
13+ , mkSerializeExprFields
14+ ) where
15+
16+--------------------------------------------------------------------------------
17+-- Imports
18+--------------------------------------------------------------------------------
19+
20+import Language.Haskell.TH
21+import Streamly.Internal.Data.Serialize.Type
22+import Streamly.Internal.Data.Serialize.TH.Bottom
23+
24+--------------------------------------------------------------------------------
25+-- Code
26+--------------------------------------------------------------------------------
27+
28+mkDeserializeExprOne :: SimpleDataCon -> Q Exp
29+mkDeserializeExprOne (SimpleDataCon cname fields) =
30+ case fields of
31+ -- Only tag is serialized for unit fields, no actual value
32+ [] -> [|pure ($(varE (mkName "i0")), $(conE cname))|]
33+ _ ->
34+ doE
35+ (concat
36+ [ fmap makeBind [0 .. (numFields - 1)]
37+ , [ noBindS
38+ (appE
39+ (varE 'pure)
40+ (tupE
41+ [ varE (makeI numFields)
42+ , appsE
43+ (conE cname :
44+ (map (varE . makeA)
45+ [0 .. (numFields - 1)]))
46+ ]))
47+ ]
48+ ])
49+ where
50+ numFields = length fields
51+ makeBind i =
52+ bindS
53+ (tupP [varP (makeI (i + 1)), varP (makeA i)])
54+ [|deserialize $(varE (makeI i)) $(varE _arr) $(varE _endOffset)|]
55+
56+mkSerializeExprFields :: [Field] -> Q Exp
57+mkSerializeExprFields fields =
58+ case fields of
59+ -- Unit constructor, do nothing just tag is enough
60+ [] -> [|pure ($(varE (mkName "i0")))|]
61+ _ ->
62+ doE
63+ (fmap makeBind [0 .. (numFields - 1)] ++
64+ [noBindS ([|pure $(varE (makeI numFields))|])])
65+ where
66+ numFields = length fields
67+ makeBind i =
68+ bindS
69+ (varP (makeI (i + 1)))
70+ [|serialize $(varE (makeI i)) $(varE _arr) $(varE (mkFieldName i))|]