24 lines
724 B
Haskell
24 lines
724 B
Haskell
{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
|
|
|
|
module Data.Binary.SerializationLength.TH
|
|
( hasFixedSerializationLength
|
|
) where
|
|
|
|
import Language.Haskell.TH
|
|
|
|
import Data.Binary.SerializationLength.Class
|
|
|
|
|
|
hasFixedSerializationLength :: Name -> Integer -> DecsQ
|
|
-- | Shorthand for defining instances of 'HasFixedSerializationLength', morally:
|
|
--
|
|
-- > hasFixedSerializationLength typeName byteN = [d|
|
|
-- > instance HasFixedSerializiationLength $(typeName) where
|
|
-- > type SerializationLength $(typeName) = $(byteN)
|
|
-- > |]
|
|
hasFixedSerializationLength (return . ConT -> t) (return . LitT . NumTyLit -> i) =
|
|
[d|
|
|
instance HasFixedSerializationLength $(t) where
|
|
type SerializationLength $(t) = $(i)
|
|
|]
|