git.iko.soy/streamly
on a11fe00 help sign in
streamly/core/src/Streamly/Internal/Data/Serialize/TH/Common.hs
70 lines 2.5 kB history raw
1{-# LANGUAGE TemplateHaskell #-}
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--
11module Streamly.Internal.Data.Serialize.TH.Common
12 ( mkDeserializeExprOne
13 , mkSerializeExprFields
14 ) where
16--------------------------------------------------------------------------------
17-- Imports
18--------------------------------------------------------------------------------
20import Language.Haskell.TH
21import Streamly.Internal.Data.Serialize.TH.Bottom
23--------------------------------------------------------------------------------
24-- Code
25--------------------------------------------------------------------------------
27mkDeserializeExprOne :: Name -> SimpleDataCon -> Q Exp
28mkDeserializeExprOne peeker (SimpleDataCon cname fields) =
29 case fields of
30 -- Only tag is serialized for unit fields, no actual value
31 [] -> [|pure ($(varE (mkName "i0")), $(conE cname))|]
32 _ ->
33 doE
34 (concat
35 [ fmap makeBind [0 .. (numFields - 1)]
36 , [ noBindS
37 (appE
38 (varE 'pure)
39 (tupE
40 [ varE (makeI numFields)
41 , appsE
42 (conE cname :
43 (map (varE . makeA)
44 [0 .. (numFields - 1)]))
45 ]))
46 ]
47 ])
48 where
49 numFields = length fields
50 makeBind i =
51 bindS
52 (tupP [varP (makeI (i + 1)), varP (makeA i)])
53 [|$(varE peeker) $(varE (makeI i)) $(varE _arr) $(varE _endOffset)|]
55mkSerializeExprFields :: Name -> [Field] -> Q Exp
56mkSerializeExprFields poker fields =
57 case fields of
58 -- Unit constructor, do nothing just tag is enough
59 [] -> [|pure ($(varE (mkName "i0")))|]
60 _ ->
61 doE
62 (fmap makeBind [0 .. (numFields - 1)] ++
63 [noBindS ([|pure $(varE (makeI numFields))|])])
64 where
65 numFields = length fields
66 makeBind i =
67 bindS
68 (varP (makeI (i + 1)))
69 [|$(varE poker)
70 $(varE (makeI i)) $(varE _arr) $(varE (mkFieldName i))|]