diff options
author | Paul Oliver <contact@pauloliver.dev> | 2025-07-02 15:06:35 +0200 |
---|---|---|
committer | Paul Oliver <contact@pauloliver.dev> | 2025-08-13 23:54:10 +0000 |
commit | 8fe62292f18f4577303a868a8557b0486b218bcb (patch) | |
tree | cb9a9108eea479e932f37d03cf399b680e3886b2 /hsm-core | |
parent | 0be7f1274e0cb8406bd4262b86d5e2e9dda77d7a (diff) |
Code now uses `effectful` to manage side-effects
Diffstat (limited to 'hsm-core')
-rw-r--r-- | hsm-core/Hsm/Core/Serial.hs | 53 | ||||
-rw-r--r-- | hsm-core/hsm-core.cabal | 15 |
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 |