{-# 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 . AppT (AppT ArrowT $ ConT dataName) $ 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) []