1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
{-# 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) []
|
