{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      : Streamly.Internal.Data.Serialize.TH.Common
-- Copyright   : (c) 2023 Composewell Technologies
-- License     : BSD3-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
module Streamly.Internal.Data.Serialize.TH.Common
    ( mkDeserializeExprOne
    , mkSerializeExprFields
    ) where

--------------------------------------------------------------------------------
-- Imports
--------------------------------------------------------------------------------

import Language.Haskell.TH
import Streamly.Internal.Data.Serialize.TH.Bottom

--------------------------------------------------------------------------------
-- Code
--------------------------------------------------------------------------------

mkDeserializeExprOne :: Name -> SimpleDataCon -> Q Exp
mkDeserializeExprOne :: Name -> SimpleDataCon -> Q Exp
mkDeserializeExprOne Name
peeker (SimpleDataCon Name
cname [Field]
fields) =
    case [Field]
fields of
        -- Only tag is serialized for unit fields, no actual value
        [] -> [|pure ($(varE (mkName "i0")), $(conE cname))|]
        [Field]
_ ->
            forall (m :: * -> *). Quote m => [m Stmt] -> m Exp
doE
                (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                     [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {m :: * -> *}. Quote m => Int -> m Stmt
makeBind [Int
0 .. (Int
numFields forall a. Num a => a -> a -> a
- Int
1)]
                     , [ forall (m :: * -> *). Quote m => m Exp -> m Stmt
noBindS
                             (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
                                  (forall (m :: * -> *). Quote m => Name -> m Exp
varE 'pure)
                                  (forall (m :: * -> *). Quote m => [m Exp] -> m Exp
tupE
                                       [ forall (m :: * -> *). Quote m => Name -> m Exp
varE (Int -> Name
makeI Int
numFields)
                                       , forall (m :: * -> *). Quote m => [m Exp] -> m Exp
appsE
                                             (forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
cname forall a. a -> [a] -> [a]
:
                                              (forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *). Quote m => Name -> m Exp
varE forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Name
makeA)
                                                   [Int
0 .. (Int
numFields forall a. Num a => a -> a -> a
- Int
1)]))
                                       ]))
                       ]
                     ])
  where
    numFields :: Int
numFields = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Field]
fields
    makeBind :: Int -> m Stmt
makeBind Int
i =
        forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Stmt
bindS
            (forall (m :: * -> *). Quote m => [m Pat] -> m Pat
tupP [forall (m :: * -> *). Quote m => Name -> m Pat
varP (Int -> Name
makeI (Int
i forall a. Num a => a -> a -> a
+ Int
1)), forall (m :: * -> *). Quote m => Name -> m Pat
varP (Int -> Name
makeA Int
i)])
            [|$(varE peeker) $(varE (makeI i)) $(varE _arr) $(varE _endOffset)|]

mkSerializeExprFields :: Name -> [Field] -> Q Exp
mkSerializeExprFields :: Name -> [Field] -> Q Exp
mkSerializeExprFields Name
poker [Field]
fields =
    case [Field]
fields of
        -- Unit constructor, do nothing just tag is enough
        [] -> [|pure ($(varE (mkName "i0")))|]
        [Field]
_ ->
            forall (m :: * -> *). Quote m => [m Stmt] -> m Exp
doE
                (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {m :: * -> *}. Quote m => Int -> m Stmt
makeBind [Int
0 .. (Int
numFields forall a. Num a => a -> a -> a
- Int
1)] forall a. [a] -> [a] -> [a]
++
                 [forall (m :: * -> *). Quote m => m Exp -> m Stmt
noBindS ([|pure $(varE (makeI numFields))|])])
  where
    numFields :: Int
numFields = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Field]
fields
    makeBind :: Int -> m Stmt
makeBind Int
i =
        forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Stmt
bindS
            (forall (m :: * -> *). Quote m => Name -> m Pat
varP (Int -> Name
makeI (Int
i forall a. Num a => a -> a -> a
+ Int
1)))
            [|$(varE poker)
                   $(varE (makeI i)) $(varE _arr) $(varE (mkFieldName i))|]