{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Unused LANGUAGE pragma" #-}

-- |
-- Module      :   Grisette.Internal.TH.Derivation.DeriveBinary
-- Copyright   :   (c) Sirui Lu 2024
-- License     :   BSD-3-Clause (see the LICENSE file)
--
-- Maintainer  :   siruilu@cs.washington.edu
-- Stability   :   Experimental
-- Portability :   GHC only
module Grisette.Internal.TH.Derivation.DeriveBinary (deriveBinary) where

import Data.Binary (Binary (get, put))
import Grisette.Internal.TH.Derivation.Common
  ( DeriveConfig (useSerialForCerealAndBinary),
  )
import Grisette.Internal.TH.Derivation.SerializeCommon
  ( serializeConfig,
    serializeWithSerialConfig,
  )
import Grisette.Internal.TH.Derivation.UnaryOpCommon
  ( UnaryOpClassConfig,
    genUnaryOpClass,
  )
import Language.Haskell.TH (Dec, Name, Q)

binaryConfig :: UnaryOpClassConfig
binaryConfig :: UnaryOpClassConfig
binaryConfig = [Name] -> [Name] -> [Name] -> UnaryOpClassConfig
serializeConfig [''Binary] ['put] ['get]

binaryWithSerialConfig :: UnaryOpClassConfig
binaryWithSerialConfig :: UnaryOpClassConfig
binaryWithSerialConfig =
  [Name] -> [Name] -> [Name] -> UnaryOpClassConfig
serializeWithSerialConfig [''Binary] ['put] ['get]

-- | Derive 'Binary' instance for a data type.
deriveBinary :: DeriveConfig -> Name -> Q [Dec]
deriveBinary :: DeriveConfig -> Name -> Q [Dec]
deriveBinary DeriveConfig
deriveConfig =
  DeriveConfig -> UnaryOpClassConfig -> Int -> Name -> Q [Dec]
genUnaryOpClass
    DeriveConfig
deriveConfig
    ( if DeriveConfig -> Bool
useSerialForCerealAndBinary DeriveConfig
deriveConfig
        then UnaryOpClassConfig
binaryWithSerialConfig
        else UnaryOpClassConfig
binaryConfig
    )
    Int
0