git.iko.soy/streamly
on master help sign in
Move independent serialization routines into Serialize.TH.Common
8f3f3f7Adithya Kumar
core/src/Streamly/Internal/Data/Serialize/TH.hs+2−45
compare with master
unifiedsplit
@@ -33,7 +33,9 @@ import Streamly.Internal.Data.Unbox.TH
33 , plainInstanceD
33 , plainInstanceD
34 , reifyDataType
34 , reifyDataType
35 )
35 )
36+
36import Streamly.Internal.Data.Serialize.TH.Bottom
37import Streamly.Internal.Data.Serialize.TH.Bottom
38+import Streamly.Internal.Data.Serialize.TH.Common
37
39
38--------------------------------------------------------------------------------
40--------------------------------------------------------------------------------
39-- Domain specific helpers
41-- Domain specific helpers
@@ -158,35 +160,6 @@ mkSizeDec (Config {..}) headTy cons = do
158-- Peek
160-- Peek
159--------------------------------------------------------------------------------
161--------------------------------------------------------------------------------
160
162
161−mkDeserializeExprOne :: SimpleDataCon -> Q Exp
162−mkDeserializeExprOne (SimpleDataCon cname fields) =
163− case fields of
164− -- Only tag is serialized for unit fields, no actual value
165− [] -> [|pure ($(varE (mkName "i0")), $(conE cname))|]
166− _ ->
167− doE
168− (concat
169− [ fmap makeBind [0 .. (numFields - 1)]
170− , [ noBindS
171− (appE
172− (varE 'pure)
173− (tupE
174− [ varE (makeI numFields)
175− , appsE
176− (conE cname :
177− (map (varE . makeA)
178− [0 .. (numFields - 1)]))
179− ]))
180− ]
181− ])
182− where
183− numFields = length fields
184− makeBind i =
185− bindS
186− (tupP [varP (makeI (i + 1)), varP (makeA i)])
187− [|deserialize $(varE (makeI i)) $(varE _arr) $(varE _endOffset)|]
188−
189−
190mkDeserializeExpr :: Bool -> Type -> TypeOfType -> Q Exp
163mkDeserializeExpr :: Bool -> Type -> TypeOfType -> Q Exp
191mkDeserializeExpr True headTy tyOfTy =
164mkDeserializeExpr True headTy tyOfTy =
192 case tyOfTy of
165 case tyOfTy of
@@ -286,22 +259,6 @@ mkSerializeExprTag tagType tagVal =
286 $(varE _arr)
259 $(varE _arr)
287 $((sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType)))|]
260 $((sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType)))|]
288
261
289−mkSerializeExprFields :: [Field] -> Q Exp
290−mkSerializeExprFields fields =
291− case fields of
292− -- Unit constructor, do nothing just tag is enough
293− [] -> [|pure ($(varE (mkName "i0")))|]
294− _ ->
295− doE
296− (fmap makeBind [0 .. (numFields - 1)] ++
297− [noBindS ([|pure $(varE (makeI numFields))|])])
298− where
299− numFields = length fields
300− makeBind i =
301− bindS
302− (varP (makeI (i + 1)))
303− [|serialize $(varE (makeI i)) $(varE _arr) $(varE (mkFieldName i))|]
304−
305mkSerializeExpr :: Bool -> TypeOfType -> Q Exp
262mkSerializeExpr :: Bool -> TypeOfType -> Q Exp
306mkSerializeExpr True tyOfTy =
263mkSerializeExpr True tyOfTy =
307 case tyOfTy of
264 case tyOfTy of
core/src/Streamly/Internal/Data/Serialize/TH/Common.hsnew file+70
@@ -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))|]
core/streamly-core.cabal+1
@@ -289,6 +289,7 @@ library
289 , Streamly.Internal.Data.Serialize
289 , Streamly.Internal.Data.Serialize
290 , Streamly.Internal.Data.Unbox.TH
290 , Streamly.Internal.Data.Unbox.TH
291 , Streamly.Internal.Data.Serialize.TH
291 , Streamly.Internal.Data.Serialize.TH
292+ , Streamly.Internal.Data.Serialize.TH.Common
292 , Streamly.Internal.Data.Serialize.TH.Bottom
293 , Streamly.Internal.Data.Serialize.TH.Bottom
293
294
294 -- Unboxed IORef
295 -- Unboxed IORef