haskell/zap/cmd/zapc-haskell/Check.hs

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}

module Check (reportIssues) where

import Zap.Gen.Zap.Schema
import Data.Foldable (for_)
import System.IO (hPutStrLn, stderr)

-- | Scan the code generator request for certain issues, and warn the user
-- if found.
--
-- We still assume the input is *valid*, so these are issues regarding things
-- that our implementation can't handle.
reportIssues :: Parsed CodeGeneratorRequest -> IO ()
reportIssues CodeGeneratorRequest {nodes} =
  let problemFields =
        [ (displayName, name)
          | Node {displayName, union' = Node'struct Node'struct' {fields}} <- nodes,
            Field
              { name,
                union' = Field'slot Field'slot' {hadExplicitDefault, defaultValue}
              } <-
              fields,
            hadExplicitDefault && isPtrValue defaultValue
        ]
   in for_ problemFields $ \(displayName, name) ->
        hPutStrLn stderr $
          concat
            [ "WARNING: the field ",
              show name,
              " in ",
              show displayName,
              "\n",
              " has a custom default value, but haskell-zap does not\n",
              " support this for pointer-valued fields. The custom\n",
              " default will be ignored; please be careful. See:\n",
              "\n",
              "https://github.com/zap-proto/haskell/issues/28\n",
              "\n",
              "for more information.\n"
            ]

isPtrValue :: Parsed Value -> Bool
isPtrValue (Value v) = case v of
  Value'void -> False
  Value'bool _ -> False
  Value'int8 _ -> False
  Value'int16 _ -> False
  Value'int32 _ -> False
  Value'int64 _ -> False
  Value'uint8 _ -> False
  Value'uint16 _ -> False
  Value'uint32 _ -> False
  Value'uint64 _ -> False
  Value'float32 _ -> False
  Value'float64 _ -> False
  Value'enum _ -> False
  _ -> True