{-# LANGUAGE TemplateHaskellQuotes #-}

module Hsm.Core.Serial
  ( makeSerial
  )
where

import GHC.Num (integerFromInt)
import Language.Haskell.TH
  ( Body (NormalB)
  , Clause (Clause)
  , Con (NormalC)
  , Dec (DataD, FunD, SigD)
  , DerivClause (DerivClause)
  , Exp (LitE)
  , Lit (IntegerL)
  , Name
  , Pat (ConP)
  , Q
  , Type (AppT, ArrowT, ConT)
  , mkName
  )

-- Generates a serial data type with the given name and a set of constructors,
-- each mapped to a corresponding integer value.
--
-- - The data type derives `Bounded`, `Enum`, and `Show` for convenience.
-- - A companion mapping function is also generated, converting each constructor
--   to its associated integer.
--
-- For debugging purposes, use `-ddump-splices` to inspect the generated code.
--
-- Example:
--
--   $(makeSerial "GPIO" "Pin" "pinLine" ''Int [2, 3, 4])
--
-- Generates a data type `GPIOPin` with constructors `GPIO2`, `GPIO3` `GPIO4`,
-- and a function `pinLine :: GPIOPin -> Int`.
makeSerial :: String -> String -> String -> Name -> [Int] -> Q [Dec]
makeSerial name suffix mapFun mapType idxs =
  return
    [ DataD [] dtName [] Nothing (idxCons <$> idxs) [derivClause]
    , SigD mapFunName . AppT (AppT ArrowT $ ConT dtName) $ ConT mapType
    , FunD mapFunName $ mapFunClause <$> idxs
    ]
  where
    dtName = mkName $ name <> suffix
    idxName idx = mkName $ name <> show idx
    idxCons idx = NormalC (idxName idx) []
    derivClause = DerivClause Nothing [ConT ''Bounded, ConT ''Enum, ConT ''Show]
    mapFunName = mkName mapFun
    mapFunBody = NormalB . LitE . IntegerL . integerFromInt
    mapFunClause idx = Clause [ConP (idxName idx) [] []] (mapFunBody idx) []