aboutsummaryrefslogtreecommitdiff
path: root/hsm-core
diff options
context:
space:
mode:
authorPaul Oliver <contact@pauloliver.dev>2025-07-02 15:06:35 +0200
committerPaul Oliver <contact@pauloliver.dev>2025-08-13 23:54:10 +0000
commit8fe62292f18f4577303a868a8557b0486b218bcb (patch)
treecb9a9108eea479e932f37d03cf399b680e3886b2 /hsm-core
parent0be7f1274e0cb8406bd4262b86d5e2e9dda77d7a (diff)
Code now uses `effectful` to manage side-effects
Diffstat (limited to 'hsm-core')
-rw-r--r--hsm-core/Hsm/Core/Serial.hs53
-rw-r--r--hsm-core/hsm-core.cabal15
2 files changed, 68 insertions, 0 deletions
diff --git a/hsm-core/Hsm/Core/Serial.hs b/hsm-core/Hsm/Core/Serial.hs
new file mode 100644
index 0000000..0fc89e8
--- /dev/null
+++ b/hsm-core/Hsm/Core/Serial.hs
@@ -0,0 +1,53 @@
+{-# 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) []
diff --git a/hsm-core/hsm-core.cabal b/hsm-core/hsm-core.cabal
new file mode 100644
index 0000000..3242ff6
--- /dev/null
+++ b/hsm-core/hsm-core.cabal
@@ -0,0 +1,15 @@
+cabal-version: 3.8
+author: Paul Oliver
+build-type: Simple
+maintainer: contact@pauloliver.dev
+name: hsm-core
+version: 0.1.0.0
+
+library
+ build-depends:
+ , base
+ , template-haskell
+
+ default-language: GHC2024
+ exposed-modules: Hsm.Core.Serial
+ ghc-options: -O2 -Wall -Werror -Wno-star-is-type -Wunused-packages