{-# LANGUAGE LambdaCase #-}
module Data.Schema.C where

import           Control.Arrow                ((&&&))
import qualified Data.Char                    as Char
import           Data.Fix                     (Fix (..), foldFix)
import           Data.List.Split              as List
import           Data.Schema                  (Schema, SchemaF (..), Type (..))
import           Prelude                      hiding ((<$>))
import qualified Text.Casing                  as Casing
import           Text.PrettyPrint.ANSI.Leijen

genC :: Schema -> Doc
genC :: Schema -> Doc
genC (Fix (Sum (Just (String
mName, String
dName)) [Schema]
cons)) =
    [Doc] -> Doc
vsep
    ([Doc] -> Doc) -> ([Schema] -> [Doc]) -> [Schema] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
line
    ([Doc] -> [Doc]) -> ([Schema] -> [Doc]) -> [Schema] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> Doc) -> [Schema] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((StructName -> [StructField] -> Doc)
-> (StructName, [StructField]) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry StructName -> [StructField] -> Doc
genDatatype ((StructName, [StructField]) -> Doc)
-> (Schema -> (StructName, [StructField])) -> Schema -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Schema -> (StructName, [StructField])
flattenFields String
ns String
prefix)
    ([Schema] -> Doc) -> [Schema] -> Doc
forall a b. (a -> b) -> a -> b
$ [Schema]
cons
  where
    ns :: String
ns = [String] -> String
namespaceFor (String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
List.splitOn String
"." String
mName)
    prefix :: String
prefix = String
dName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_"
genC Schema
s = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Schema -> String
forall a. Show a => a -> String
show Schema
s

namespaceFor :: [String] -> String
namespaceFor :: [String] -> String
namespaceFor []               = String
""
namespaceFor [String
ns, String
"Types", String
_] = String
ns String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_"
namespaceFor (String
_:[String]
parts)        = [String] -> String
namespaceFor [String]
parts

data StructField = StructField
    { StructField -> Doc
sfField :: Doc
    , StructField -> Type
sfType  :: Type
    }
    deriving (Int -> StructField -> String -> String
[StructField] -> String -> String
StructField -> String
(Int -> StructField -> String -> String)
-> (StructField -> String)
-> ([StructField] -> String -> String)
-> Show StructField
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [StructField] -> String -> String
$cshowList :: [StructField] -> String -> String
show :: StructField -> String
$cshow :: StructField -> String
showsPrec :: Int -> StructField -> String -> String
$cshowsPrec :: Int -> StructField -> String -> String
Show)

data StructName = StructName
    { StructName -> Doc
snType :: Doc
    , StructName -> Doc
snFun  :: Doc
    }
    deriving (Int -> StructName -> String -> String
[StructName] -> String -> String
StructName -> String
(Int -> StructName -> String -> String)
-> (StructName -> String)
-> ([StructName] -> String -> String)
-> Show StructName
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [StructName] -> String -> String
$cshowList :: [StructName] -> String -> String
show :: StructName -> String
$cshow :: StructName -> String
showsPrec :: Int -> StructName -> String -> String
$cshowsPrec :: Int -> StructName -> String -> String
Show)

flattenFields :: String -> String -> Schema -> (StructName, [StructField])
flattenFields :: String -> String -> Schema -> (StructName, [StructField])
flattenFields String
ns String
prefix = SchemaF Schema -> StructName
forall a. SchemaF a -> StructName
conName (SchemaF Schema -> StructName)
-> (Schema -> SchemaF Schema) -> Schema -> StructName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> SchemaF Schema
forall (f :: * -> *). Fix f -> f (Fix f)
unFix (Schema -> StructName)
-> (Schema -> [StructField])
-> Schema
-> (StructName, [StructField])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (SchemaF [StructField] -> [StructField]) -> Schema -> [StructField]
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix SchemaF [StructField] -> [StructField]
go
  where
    go :: SchemaF [StructField] -> [StructField]
go (Atom Type
ty)              = [Doc -> Type -> StructField
StructField Doc
empty Type
ty]
    go (Sum (Just (String
_, String
ty)) [[StructField]]
_) = [Doc -> Type -> StructField
StructField Doc
empty (Type -> StructField) -> Type -> StructField
forall a b. (a -> b) -> a -> b
$ String -> String -> Type
tyName String
ns String
ty]

    go (Field String
name [StructField]
tys)       = (StructField -> StructField) -> [StructField] -> [StructField]
forall a b. (a -> b) -> [a] -> [b]
map (\StructField
ty -> StructField
ty{sfField :: Doc
sfField = String -> Doc
fieldName String
name}) [StructField]
tys
    go (Con String
_ [StructField]
tys)            = [StructField]
tys
    go (Prod [[StructField]]
fields)          = [[StructField]] -> [StructField]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[StructField]]
fields
    go (Sum Maybe DatatypeName
Nothing [[StructField]]
_)        = []
    go SchemaF [StructField]
Empty                  = []
    go Module{}               = []
    go Schema{}               = []
    go List{}                 = []

    conName :: SchemaF a -> StructName
conName (Con String
name a
_) = StructName :: Doc -> Doc -> StructName
StructName
        { snType :: Doc
snType = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
toCName String
name
        , snFun :: Doc
snFun = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
toCName String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_"
        }
    conName SchemaF a
_ = Doc -> Doc -> StructName
StructName Doc
empty Doc
empty

    -- | @TypeName -> Namespace_Prefix_Type_Name@
    toCName :: String -> String
    toCName :: String -> String
toCName String
name = String
ns String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
toCamelSnake String
name

genDatatype :: StructName -> [StructField] -> Doc
genDatatype :: StructName -> [StructField] -> Doc
genDatatype StructName
sName [StructField]
fields =
    StructName -> [StructField] -> Doc
genHeader StructName
sName [StructField]
fields Doc -> Doc -> Doc
</> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    StructName -> [StructField] -> Doc
genSource StructName
sName [StructField]
fields

genHeader :: StructName -> [StructField] -> Doc
genHeader :: StructName -> [StructField] -> Doc
genHeader StructName
sName [StructField]
fields =
    String -> Doc
text String
"// events.h" Doc -> Doc -> Doc
</>
    StructName -> Doc
genTypedef StructName
sName Doc -> Doc -> Doc
</>
    StructName -> [StructField] -> Doc
genGetterDecls StructName
sName [StructField]
fields

genSource :: StructName -> [StructField] -> Doc
genSource :: StructName -> [StructField] -> Doc
genSource StructName
sName [StructField]
fields =
    String -> Doc
text String
"// events.c" Doc -> Doc -> Doc
</>
    StructName -> [StructField] -> Doc
genStruct StructName
sName [StructField]
fields Doc -> Doc -> Doc
</> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    ([Doc] -> Doc
vcat ([Doc] -> Doc) -> ([StructField] -> [Doc]) -> [StructField] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
line ([Doc] -> [Doc])
-> ([StructField] -> [Doc]) -> [StructField] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructField -> Doc) -> [StructField] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\StructField
field ->
        StructName -> StructField -> Doc
genGetterDefn StructName
sName StructField
field Doc -> Doc -> Doc
</>
        StructName -> StructField -> Doc
genSetterDefn StructName
sName StructField
field) ([StructField] -> Doc) -> [StructField] -> Doc
forall a b. (a -> b) -> a -> b
$ [StructField]
fields)

genTypedef :: StructName -> Doc
genTypedef :: StructName -> Doc
genTypedef (StructName Doc
sName Doc
_) =
    String -> Doc
text String
"typedef struct" Doc -> Doc -> Doc
<+> Doc
sName Doc -> Doc -> Doc
<+> Doc
sName Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

-- | Generate the C struct definition.
genStruct :: StructName -> [StructField] -> Doc
genStruct :: StructName -> [StructField] -> Doc
genStruct (StructName Doc
sName Doc
_) [StructField]
fields =
    String -> Doc
text String
"struct" Doc -> Doc -> Doc
<+> Doc
sName Doc -> Doc -> Doc
<+> Doc -> Doc
braces (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        Int -> Doc -> Doc
indent Int
4 ([Doc] -> Doc
vcat ((StructField -> Doc) -> [StructField] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi) (Doc -> Doc) -> (StructField -> Doc) -> StructField -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructField -> Doc
go) [StructField]
fields))
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
  where
    go :: StructField -> Doc
go (StructField Doc
f Type
TyBool)     = String -> Doc
text String
"bool"     Doc -> Doc -> Doc
<+> Doc
f
    go (StructField Doc
f Type
TyWord8)    = String -> Doc
text String
"uint8_t"  Doc -> Doc -> Doc
<+> Doc
f
    go (StructField Doc
f Type
TyWord16)   = String -> Doc
text String
"uint16_t" Doc -> Doc -> Doc
<+> Doc
f
    go (StructField Doc
f Type
TyWord32)   = String -> Doc
text String
"uint32_t" Doc -> Doc -> Doc
<+> Doc
f
    go (StructField Doc
f Type
TyWord64)   = String -> Doc
text String
"uint64_t" Doc -> Doc -> Doc
<+> Doc
f
    go (StructField Doc
f (TyName String
s)) = String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc
f
    go (StructField Doc
f (TyFixedBin Int
s)) =
        String -> Doc
text String
"uint8_t" Doc -> Doc -> Doc
<+> Doc
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets (Int -> Doc
int Int
s)
    go (StructField Doc
f Type
TyBin) =
        String -> Doc
text String
"uint8_t *" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi Doc -> Doc -> Doc
</>
        String -> Doc
text String
"uint32_t " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"_size"

eventParam :: Doc -> Doc -> Doc -> Doc
eventParam :: Doc -> Doc -> Doc -> Doc
eventParam Doc
qual Doc
sName Doc
params =
    Doc -> Doc
parens (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
indent Int
4 (Doc
qual Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
sName Doc -> Doc -> Doc
<+> String -> Doc
text String
"*event" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
params))

getterDecl :: Doc -> Doc -> String -> Doc -> Doc
getterDecl :: Doc -> Doc -> String -> Doc -> Doc
getterDecl Doc
sName Doc
fName String
ty Doc
f =
    String -> Doc
text String
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
fName Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"get_" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> Doc -> Doc
eventParam (String -> Doc
text String
"const ") Doc
sName Doc
empty

setterDecl :: Doc -> Doc -> String -> Doc -> Doc -> Doc
setterDecl :: Doc -> Doc -> String -> Doc -> Doc -> Doc
setterDecl Doc
sName Doc
fName String
ty Doc
f Doc
params =
    String -> Doc
text String
"static void" Doc -> Doc -> Doc
<+> Doc
fName Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"set_" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> Doc -> Doc
eventParam Doc
empty Doc
sName (String -> Doc
text (String
", " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
ty String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"value") Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
params)

getterDeclFor :: (String -> Doc -> Doc) -> StructField -> Doc
getterDeclFor :: (String -> Doc -> Doc) -> StructField -> Doc
getterDeclFor String -> Doc -> Doc
decl = \case
    (StructField Doc
f Type
TyBool)       -> String -> Doc -> Doc
decl String
"bool "     Doc
f
    (StructField Doc
f Type
TyWord8)      -> String -> Doc -> Doc
decl String
"uint8_t "  Doc
f
    (StructField Doc
f Type
TyWord16)     -> String -> Doc -> Doc
decl String
"uint16_t " Doc
f
    (StructField Doc
f Type
TyWord32)     -> String -> Doc -> Doc
decl String
"uint32_t " Doc
f
    (StructField Doc
f Type
TyWord64)     -> String -> Doc -> Doc
decl String
"uint64_t " Doc
f
    (StructField Doc
f (TyName String
s))   -> String -> Doc -> Doc
decl (String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" ")  Doc
f
    (StructField Doc
f TyFixedBin{}) -> String -> Doc -> Doc
decl String
"const uint8_t *" Doc
f
    (StructField Doc
f Type
TyBin) ->
        String -> Doc -> Doc
decl String
"const uint8_t *" Doc
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi Doc -> Doc -> Doc
</>
        String -> Doc -> Doc
decl String
"uint32_t " (Doc
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"_size")

genGetterDecls :: StructName -> [StructField] -> Doc
genGetterDecls :: StructName -> [StructField] -> Doc
genGetterDecls (StructName Doc
sName Doc
fName) [StructField]
fields =
    [Doc] -> Doc
vcat ((StructField -> Doc) -> [StructField] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi) (Doc -> Doc) -> (StructField -> Doc) -> StructField -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc -> Doc) -> StructField -> Doc
getterDeclFor String -> Doc -> Doc
decl) [StructField]
fields)
  where
    decl :: String -> Doc -> Doc
decl = Doc -> Doc -> String -> Doc -> Doc
getterDecl Doc
sName Doc
fName

genGetterDefn :: StructName -> StructField -> Doc
genGetterDefn :: StructName -> StructField -> Doc
genGetterDefn (StructName Doc
sName Doc
fName) = (String -> Doc -> Doc) -> StructField -> Doc
getterDeclFor String -> Doc -> Doc
defn
  where
    defn :: String -> Doc -> Doc
defn String
ty Doc
f = Doc -> Doc -> String -> Doc -> Doc
getterDecl Doc
sName Doc
fName String
ty Doc
f Doc -> Doc -> Doc
</> Doc -> Doc
braces
        (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
indent Int
4 (String -> Doc
text String
"return event->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line)

genSetterDefn :: StructName -> StructField -> Doc
genSetterDefn :: StructName -> StructField -> Doc
genSetterDefn (StructName Doc
sName Doc
fName) = StructField -> Doc
go
  where
    defn :: Doc -> (Doc -> Doc) -> String -> Doc -> Doc
defn Doc
params Doc -> Doc
body String
ty Doc
field = Doc -> Doc -> String -> Doc -> Doc -> Doc
setterDecl Doc
sName Doc
fName String
ty Doc
field Doc
params Doc -> Doc -> Doc
</> Doc -> Doc
braces
        (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
indent Int
4 (Doc -> Doc
body Doc
field) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line)

    setValue :: Doc -> Doc
setValue Doc
field = String -> Doc
text String
"event->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
field Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" = value" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    simpleDefn :: String -> Doc -> Doc
simpleDefn = Doc -> (Doc -> Doc) -> String -> Doc -> Doc
defn Doc
empty Doc -> Doc
setValue

    setFixedBin :: Int -> Doc -> Doc
setFixedBin Int
n Doc
field =
        String -> Doc
text String
"memcpy" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (String -> Doc
text String
"event->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
field Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
", value, " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
int Int
n) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    setBin :: Doc -> Doc
setBin Doc
field =
        String -> Doc
text String
"assert(event != nullptr);" Doc -> Doc -> Doc
</>
        Doc
line Doc -> Doc -> Doc
</>
        String -> Doc
text String
"if (event->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
field Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" != nullptr)" Doc -> Doc -> Doc
<+> Doc -> Doc
braces (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
            Int -> Doc -> Doc
indent Int
4 (
                String -> Doc
text String
"free(event->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
field Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
");" Doc -> Doc -> Doc
</>
                String -> Doc
text String
"event->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
field Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" = nullptr;" Doc -> Doc -> Doc
</>
                String -> Doc
text String
"event->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
field Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"_size = 0;"
            ) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line) Doc -> Doc -> Doc
</>
        Doc
line Doc -> Doc -> Doc
</>
        String -> Doc
text String
"event->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
field Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" = (uint8_t *)malloc(size);" Doc -> Doc -> Doc
</>
        Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        String -> Doc
text String
"if (event->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
field Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" == nullptr)" Doc -> Doc -> Doc
<+> Doc -> Doc
braces (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
            Int -> Doc -> Doc
indent Int
4 (
                String -> Doc
text String
"return false;"
            ) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line) Doc -> Doc -> Doc
</>
        Doc
line Doc -> Doc -> Doc
</>
        String -> Doc
text String
"memcpy" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (String -> Doc
text String
"event->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
field Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
", value, size") Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi Doc -> Doc -> Doc
</>
        String -> Doc
text String
"event->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
field Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"_size = size;" Doc -> Doc -> Doc
</>
        String -> Doc
text String
"return true;"

    go :: StructField -> Doc
go (StructField Doc
field Type
TyBool)       = String -> Doc -> Doc
simpleDefn String
"bool "     Doc
field
    go (StructField Doc
field Type
TyWord8)      = String -> Doc -> Doc
simpleDefn String
"uint8_t "  Doc
field
    go (StructField Doc
field Type
TyWord16)     = String -> Doc -> Doc
simpleDefn String
"uint16_t " Doc
field
    go (StructField Doc
field Type
TyWord32)     = String -> Doc -> Doc
simpleDefn String
"uint32_t " Doc
field
    go (StructField Doc
field Type
TyWord64)     = String -> Doc -> Doc
simpleDefn String
"uint64_t " Doc
field
    go (StructField Doc
field (TyName String
s))   = String -> Doc -> Doc
simpleDefn (String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" ")  Doc
field
    go (StructField Doc
field (TyFixedBin Int
n)) =
        Doc -> (Doc -> Doc) -> String -> Doc -> Doc
defn Doc
empty (Int -> Doc -> Doc
setFixedBin Int
n) String
"const uint8_t *" Doc
field
    go (StructField Doc
field Type
TyBin) =
        Doc -> (Doc -> Doc) -> String -> Doc -> Doc
defn (String -> Doc
text String
", uint32_t size") Doc -> Doc
setBin String
"const uint8_t *" Doc
field

-- | @fieldName' -> field_name@
fieldName :: String -> Doc
fieldName :: String -> Doc
fieldName = String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\'') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier String -> String
Casing.toQuietSnake (Identifier String -> String)
-> (String -> Identifier String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Identifier String
Casing.fromHumps

tyName :: String -> String -> Type
tyName :: String -> String -> Type
tyName String
ns = String -> Type
TyName (String -> Type) -> (String -> String) -> String -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
ns String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
toCamelSnake

-- | @TypeName -> Type_Name@
toCamelSnake :: String -> String
toCamelSnake :: String -> String
toCamelSnake = Identifier String -> String
Casing.toSnake (Identifier String -> String)
-> (String -> Identifier String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Identifier String
Casing.fromHumps