{-# 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]
_ ->
            [Q Stmt] -> Q Exp
forall (m :: * -> *). Quote m => [m Stmt] -> m Exp
doE
                ([[Q Stmt]] -> [Q Stmt]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                     [ (Int -> Q Stmt) -> [Int] -> [Q Stmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Q Stmt
forall {m :: * -> *}. Quote m => Int -> m Stmt
makeBind [Int
0 .. (Int
numFields Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
                     , [ Q Exp -> Q Stmt
forall (m :: * -> *). Quote m => m Exp -> m Stmt
noBindS
                             (Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
                                  (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'pure)
                                  ([Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
tupE
                                       [ Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Int -> Name
makeI Int
numFields)
                                       , [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
appsE
                                             (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
cname Q Exp -> [Q Exp] -> [Q Exp]
forall a. a -> [a] -> [a]
:
                                              ((Int -> Q Exp) -> [Int] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Name -> Q Exp) -> (Int -> Name) -> Int -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Name
makeA)
                                                   [Int
0 .. (Int
numFields Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]))
                                       ]))
                       ]
                     ])
  where
    numFields :: Int
numFields = [Field] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Field]
fields
    makeBind :: Int -> m Stmt
makeBind Int
i =
        m Pat -> m Exp -> m Stmt
forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Stmt
bindS
            ([m Pat] -> m Pat
forall (m :: * -> *). Quote m => [m Pat] -> m Pat
tupP [Name -> m Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP (Int -> Name
makeI (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)), Name -> m Pat
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]
_ ->
            [Q Stmt] -> Q Exp
forall (m :: * -> *). Quote m => [m Stmt] -> m Exp
doE
                ((Int -> Q Stmt) -> [Int] -> [Q Stmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Q Stmt
forall {m :: * -> *}. Quote m => Int -> m Stmt
makeBind [Int
0 .. (Int
numFields Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] [Q Stmt] -> [Q Stmt] -> [Q Stmt]
forall a. [a] -> [a] -> [a]
++
                 [Q Exp -> Q Stmt
forall (m :: * -> *). Quote m => m Exp -> m Stmt
noBindS ([|pure $(varE (makeI numFields))|])])
  where
    numFields :: Int
numFields = [Field] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Field]
fields
    makeBind :: Int -> m Stmt
makeBind Int
i =
        m Pat -> m Exp -> m Stmt
forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Stmt
bindS
            (Name -> m Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP (Int -> Name
makeI (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)))
            [|$(varE poker)
                   $(varE (makeI i)) $(varE _arr) $(varE (mkFieldName i))|]