{-# 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 mapFunction mapType indices =
  return
    [ DataD [] dataName [] Nothing (indexCons <$> indices) [deriveClause]
    , SigD mapFunctionName $ ArrowT `AppT` ConT dataName `AppT` ConT mapType
    , FunD mapFunctionName $ mapFunctionClause <$> indices
    ]
  where
    dataName = mkName $ name <> suffix
    indexName index = mkName $ name <> show index
    indexCons index = NormalC (indexName index) []
    deriveClause = DerivClause Nothing [ConT ''Bounded, ConT ''Enum, ConT ''Show]
    mapFunctionName = mkName mapFunction
    mapFunctionBody = NormalB . LitE . IntegerL . integerFromInt
    mapFunctionClause index = Clause [ConP (indexName index) [] []] (mapFunctionBody index) []