From 8b0a3cdffd2f07beccd7f110c50db31b0629a59b Mon Sep 17 00:00:00 2001 From: Neil Mitchell Date: Wed, 17 Apr 2019 14:57:48 +0100 Subject: [PATCH] #97, make sure OneofSubfield generates well-typed code for non-Maybe --- src/Proto3/Suite/DotProto/Generate.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/Proto3/Suite/DotProto/Generate.hs b/src/Proto3/Suite/DotProto/Generate.hs index b8225086..f707d214 100644 --- a/src/Proto3/Suite/DotProto/Generate.hs +++ b/src/Proto3/Suite/DotProto/Generate.hs @@ -868,17 +868,18 @@ messageInstD ctxt parentIdent msgIdent messageParts = do -- Constructor y -> encodeMessageField num (Nested (Just y)) -- for embedded messages -- Constructor y -> encodeMessageField num (ForceEmit y) -- for everything else let mkAlt (OneofSubfield fieldNum conName _ dpType options) = do - let wrapMaybe + let isMaybe | Prim (Named tyName) <- dpType - , Just DotProtoKindMessage <- dotProtoTypeInfoKind <$> M.lookup tyName ctxt - = HsParen . HsApp (HsVar (haskellName "Just")) + = Just DotProtoKindMessage == fmap dotProtoTypeInfoKind (M.lookup tyName ctxt) | otherwise - = forceEmitE + = False - xE <- wrapE ctxt options dpType - . wrapMaybe - $ HsVar (unqual_ "y") + let wrapJust = HsParen . HsApp (HsVar (haskellName "Just")) + xE <- (if isMaybe then id else fmap forceEmitE) + . wrapE ctxt options dpType + . (if isMaybe then wrapJust else id) + $ HsVar (unqual_ "y") pure $ alt_ (HsPApp (unqual_ conName) [patVar "y"]) (HsUnGuardedAlt (apply encodeMessageFieldE [fieldNumberE fieldNum, xE]))