FieldPresence.hs

{- | Resolve Editions field presence before either generator chooses field
carriers. The public parser retains the original source-level labels.
-}
module Proto.Internal.FieldPresence (resolveFieldPresence) where

import Data.List (find)
import Data.Text (Text)
import Proto.IDL.AST
import Proto.IDL.Annotations (lookupSimpleOption)


resolveFieldPresence :: ProtoFile -> Either Text ProtoFile
resolveFieldPresence pf = case protoSyntax pf of
  Editions edition -> do
    filePresence <- presenceOption (featureFieldPresence (featuresForEdition edition)) (protoOptions pf)
    topLevels <- traverse (topLevel filePresence) (protoTopLevels pf)
    pure pf {protoTopLevels = topLevels}
  _ -> Right pf
  where
    topLevel presence = \case
      TLMessage msg -> TLMessage <$> message presence msg
      TLExtend name fields -> TLExtend name <$> traverse (field presence) fields
      other -> Right other
    message presence msg = do
      elements <- traverse (element presence) (msgElements msg)
      pure msg {msgElements = elements}
    element presence = \case
      MEField fd -> MEField <$> field presence fd
      MEMessage msg -> MEMessage <$> message presence msg
      MEExtend name fields -> MEExtend name <$> traverse (field presence) fields
      other -> Right other
    field presence fd = case fieldLabel fd of
      Just Repeated -> Right fd
      _ -> do
        resolved <- presenceOption presence (fieldOptions fd)
        pure
          fd
            { fieldLabel = case resolved of
                ExplicitPresence -> Just Optional
                ImplicitPresence -> Nothing
                LegacyRequired -> Just Required
            }


-- Field presence is scoped to files and fields, not enclosing messages.
-- Accept both dotted and aggregate feature-option spellings.
presenceOption :: FieldPresenceFeature -> [OptionDef] -> Either Text FieldPresenceFeature
presenceOption fallback opts = case setting of
  Nothing -> Right fallback
  Just (CIdent "EXPLICIT") -> Right ExplicitPresence
  Just (CIdent "IMPLICIT") -> Right ImplicitPresence
  Just (CIdent "LEGACY_REQUIRED") ->
    Left "features.field_presence = LEGACY_REQUIRED is not supported by the code generators"
  Just _ -> Left "features.field_presence must be EXPLICIT or IMPLICIT"
  where
    setting = case find isPresence opts of
      Just option -> Just (optValue option)
      Nothing -> case lookupSimpleOption "features" opts of
        Just (CAggregate values) -> lookup "field_presence" values
        _ -> Nothing

    isPresence option = case optNameParts (optName option) of
      [SimpleOption "features", SimpleOption "field_presence"] -> True
      [SimpleOption "features.field_presence"] -> True
      _ -> False