Merge pull request #89 from MercuryTechnologies/joseph/add-deprecated-fields

Add deprecated fields support

Author: josephsumabat

.golden/kotlinDeprecatedFieldSpec/golden

@@ -0,0 +1,5 @@
+data class Data(
+    val field0: Int,
+// Deprecated since build 500
+//    val field1: Int? = null,
+)

.golden/swiftDeprecatedFieldSpec/golden

@@ -0,0 +1,5 @@
+struct Data {
+    var field0: Int
+// Deprecated since build 500
+//    var field1: Int?
+}

moat.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.2.
+-- This file has been generated from package.yaml by hpack version 0.37.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -80,6 +80,7 @@ test-suite spec
       BasicNewtypeWithEitherFieldSpec
       BasicRecordSpec
       Common
+      DeprecatedFieldSpec
       DuplicateRecordFieldSpec
       EnumValueClassDocSpec
       EnumValueClassSpec

src/Moat.hs

@@ -74,6 +74,7 @@ module Moat
     omitFields,
     omitCases,
     fieldsRequiredByClients,
+    deprecatedFields,
     strictCases,
     makeBase,
     sumOfProductEncodingOptions,
@@ -509,6 +510,10 @@ data MoatError
       }
   | MissingRequiredFields
       { _missingFields :: [String]
+      , _missingDeprecatedFields :: [String]
+      }
+  | MissingDeprecatedRequiredFields
+      { _missingDeprecatedRequiredFields :: [String]
       }
   | MissingStrictCases
       { _missingCases :: [String]
@@ -577,8 +582,10 @@ prettyMoatError = \case
   ImproperNewtypeConstructorInfo conInfo ->
     "Expected `ConstructorInfo` with single field, but got "
       ++ show conInfo
-  MissingRequiredFields missingFields ->
-    "These fields are required by clients: " ++ L.unwords missingFields
+  MissingRequiredFields missingFields missingDeprecatedFields ->
+    "These fields are required by clients: " ++ L.unwords missingFields ++ " " ++ L.unwords missingDeprecatedFields
+  MissingDeprecatedRequiredFields missingDeprecatedFields ->
+    "These fields need to be added to the required field list due to being necessary on older clients: " ++ L.unwords missingDeprecatedFields
   MissingStrictCases missingCases ->
     "Removing these cases will break clients: " ++ L.unwords missingCases
 
@@ -975,7 +982,8 @@ mkNewtype o@Options {..} typName doc instTys ts = \case
     } -> do
       fieldDocs <- lift $ mapM (getDocWith o) fieldNames
       fields <- zipFields o fieldNames constructorFields fieldDocs
-      matchProxy =<< lift (structExp typName doc instTys dataInterfaces dataProtocols dataAnnotations fields ts makeBase)
+      deprecatedFieldExps <- lift [e|deprecatedFields|]
+      matchProxy =<< lift (structExp typName doc instTys dataInterfaces dataProtocols dataAnnotations fields deprecatedFieldExps ts makeBase)
   ConstructorInfo
     { constructorFields = [field]
     } -> do
@@ -1004,7 +1012,8 @@ mkProd o@Options {..} typName parentDoc instTys ts = \case
     { constructorVariant = NormalConstructor
     , constructorFields = []
     } -> do
-      matchProxy =<< lift (structExp typName parentDoc instTys dataInterfaces dataProtocols dataAnnotations [] ts makeBase)
+      emptyDeprecatedFieldsExp <- lift [e|[]|]
+      matchProxy =<< lift (structExp typName parentDoc instTys dataInterfaces dataProtocols dataAnnotations [] emptyDeprecatedFieldsExp ts makeBase)
   -- single constructor, non-record (Normal)
   ConstructorInfo
     { constructorVariant = NormalConstructor
@@ -1026,17 +1035,30 @@ mkProd o@Options {..} typName parentDoc instTys ts = \case
     } -> do
       fieldDocs <- lift $ mapM (getDocWith o) fieldNames
       fields <- zipFields o fieldNames constructorFields fieldDocs
-      matchProxy =<< lift (structExp typName parentDoc instTys dataInterfaces dataProtocols dataAnnotations fields ts makeBase)
+      deprecatedFieldExp <- lift [e|deprecatedFields|]
+      matchProxy =<< lift (structExp typName parentDoc instTys dataInterfaces dataProtocols dataAnnotations fields deprecatedFieldExp ts makeBase)
 
 -- | 'strictFields' are required to exist in the record and are always included.
 -- 'omitFields' will remove any remaining fields if they are 'Discard'ed.
 zipFields :: Options -> [Name] -> [Type] -> [Maybe String] -> MoatM [Exp]
 zipFields o ns ts ds = do
   let fields = nameStr <$> ns
-      missingFields = fieldsRequiredByClients o L.\\ fields
-  if null missingFields
-    then pure $ catMaybes $ zipWith3 mkField ns ts ds
-    else throwError $ MissingRequiredFields missingFields
+      requiredFieldNames = fieldsRequiredByClients o
+      deprecatedFieldNames = fst <$> deprecatedFields o
+      missingFields = requiredFieldNames L.\\ fields
+      missingDeprecatedFields = deprecatedFieldNames L.\\ fields
+      deprecatedNonRequiredFields = deprecatedFieldNames L.\\ requiredFieldNames
+      checkMissingFields =
+        if null missingFields
+          then pure $ catMaybes $ zipWith3 mkField ns ts ds
+          else throwError $ MissingRequiredFields missingFields missingDeprecatedFields
+  case requiredFieldNames of
+    [] -> checkMissingFields
+    _requiredFields ->
+      -- Throw an error if required fields are available but a deprecated field is not included in them
+      case deprecatedNonRequiredFields of
+        [] -> checkMissingFields
+        _xs -> throwError $ MissingDeprecatedRequiredFields deprecatedNonRequiredFields
   where
     mkField :: Name -> Type -> Maybe String -> Maybe Exp
     mkField n t d =
@@ -1650,12 +1672,14 @@ structExp ::
   [Annotation] ->
   -- | fields
   [Exp] ->
+  -- | deprecated fields
+  Exp ->
   -- | tags
   [Exp] ->
   -- | Make base?
   (Bool, Maybe MoatType, [Protocol]) ->
   Q Exp
-structExp name doc tyVars ifaces protos anns fields tags bs = do
+structExp name doc tyVars ifaces protos anns fields deprecatedFields tags bs = do
   structInterfaces_ <- Syntax.lift ifaces
   structAnnotations_ <- Syntax.lift anns
   structProtocols_ <- Syntax.lift protos
@@ -1669,6 +1693,7 @@ structExp name doc tyVars ifaces protos anns fields tags bs = do
       , ('structProtocols, structProtocols_)
       , ('structAnnotations, structAnnotations_)
       , ('structFields, ListE fields)
+      , ('structDeprecatedFields, deprecatedFields)
       , ('structPrivateTypes, ListE [])
       , ('structTags, ListE tags)
       ]

src/Moat/Pretty/Kotlin.hs

@@ -6,7 +6,9 @@ where
 import qualified Data.Char as Char
 import Data.Functor ((<&>))
 import Data.List (intercalate)
+import qualified Data.Map as Map
 import Data.Maybe (catMaybes, mapMaybe)
+import Debug.Trace
 import Moat.Pretty.Doc.KDoc
 import Moat.Types
 
@@ -25,6 +27,7 @@ prettyKotlinData = \case
       structInterfaces
       structAnnotations
       structFields
+      structDeprecatedFields
       indents
   MoatEnum {..} ->
     prettyEnum
@@ -64,11 +67,11 @@ prettyTypeDoc indents doc fields =
       kdoc = intercalate "\n" (catMaybes [prettyDoc wrap <$> doc, prettyFieldDoc wrap fields])
    in prettyDocComment wrap indents kdoc
 
-prettyStructFields :: String -> [Field] -> String
-prettyStructFields indents = go
+prettyStructFields :: String -> [Field] -> [(String, Maybe String)] -> String
+prettyStructFields indents fields deprecatedFields = go fields
   where
-    go [] = ""
-    go (Field fieldName ty _ : fs) =
+    deprecatedFieldsMap = Map.fromList deprecatedFields
+    prettyField (Field fieldName ty _) =
       indents
         ++ "val "
         ++ fieldName
@@ -78,7 +81,20 @@ prettyStructFields indents = go
           Optional _ -> " = null"
           _ -> ""
         ++ ",\n"
-        ++ go fs
+    go [] = ""
+    go (field@(Field fieldName _ _) : fs) =
+      traceShow deprecatedFieldsMap $
+        traceShow fieldName $
+          traceShow fields $
+            traceShow fs $
+              case Map.lookup fieldName deprecatedFieldsMap of
+                Just mComment ->
+                  traceShow "test" $
+                    maybe "" (\comment -> "// " ++ comment ++ "\n") mComment
+                      ++ "//"
+                      ++ prettyField field
+                      ++ go fs
+                Nothing -> prettyField field ++ go fs
 
 prettyEnumCases :: String -> [EnumCase] -> String
 prettyEnumCases indents = go
@@ -295,7 +311,7 @@ prettyTaggedObject parentName tyVars anns ifaces cases indents SumOfProductEncod
                       ++ "data class "
                       ++ caseTypeHeader caseNm
                       ++ "(\n"
-                      ++ prettyStructFields doubleIndents fields
+                      ++ prettyStructFields doubleIndents fields []
                       ++ indents
                       ++ ") : "
                       ++ parentTypeHeader
@@ -350,9 +366,10 @@ prettyStruct ::
   -- | fields
   [Field] ->
   -- | indents
+  [(String, Maybe String)] ->
   String ->
   String
-prettyStruct name doc tyVars ifaces anns fields indents =
+prettyStruct name doc tyVars ifaces anns fields deprecatedFields indents =
   prettyTypeDoc noIndent doc fields
     ++ prettyAnnotations Nothing noIndent anns
     ++ body
@@ -368,7 +385,7 @@ prettyStruct name doc tyVars ifaces anns fields indents =
           "data class "
             ++ prettyMoatTypeHeader name (addTyVarBounds tyVars ifaces)
             ++ "(\n"
-            ++ prettyStructFields indents fields
+            ++ prettyStructFields indents fields deprecatedFields
             ++ ")"
 
 prettyEnum ::

src/Moat/Pretty/Swift.hs

@@ -10,6 +10,7 @@ where
 
 import Data.Functor ((<&>))
 import Data.List (intercalate, nub)
+import qualified Data.Map as Map
 import Data.Maybe (catMaybes)
 import Moat.Pretty.Doc.DocC
 import Moat.Types
@@ -52,7 +53,7 @@ prettySwiftDataWith indent = \case
       ++ prettyRawValueAndProtocols Nothing structProtocols
       ++ " {"
       ++ newlineNonEmpty structFields
-      ++ prettyStructFields indents structFields
+      ++ prettyStructFields indents structFields structDeprecatedFields
       ++ newlineNonEmpty structPrivateTypes
       ++ prettyPrivateTypes indents structPrivateTypes
       ++ prettyTags indents structTags
@@ -260,19 +261,29 @@ prettyEnumCases indents unknown cases = go cases ++ unknownCase
       Just caseNm -> indents ++ "case " ++ caseNm ++ "\n"
       Nothing -> ""
 
-prettyStructFields :: String -> [Field] -> String
-prettyStructFields indents = go
+prettyStructFields :: String -> [Field] -> [(String, Maybe String)] -> String
+prettyStructFields indents fields deprecatedFields = go fields
   where
-    go [] = ""
-    go (Field {..} : fs) =
-      prettyTypeDoc indents fieldDoc []
-        ++ indents
+    deprecatedFieldsMap = Map.fromList deprecatedFields
+    prettyField (Field fieldName fieldType _fieldDoc) =
+      indents
         ++ "var "
         ++ fieldName
         ++ ": "
         ++ prettyMoatType fieldType
         ++ "\n"
-        ++ go fs
+    go [] = ""
+    go (field@(Field fieldName _ fieldDoc) : fs) =
+      case Map.lookup fieldName deprecatedFieldsMap of
+        Just mComment ->
+          maybe "" (\comment -> "// " ++ comment ++ "\n") mComment
+            ++ "//"
+            ++ prettyField field
+            ++ go fs
+        Nothing ->
+          prettyTypeDoc indents fieldDoc []
+            ++ prettyField field
+            ++ go fs
 
 prettyNewtypeField :: String -> Field -> String -> String
 prettyNewtypeField indents (Field alias fieldType _) fieldName =

src/Moat/Types.hs

@@ -144,6 +144,7 @@ data MoatData
       --   populated by setting 'makeBase'.
       --
       --   Only used by the Swift backend.
+      , structDeprecatedFields :: [(String, Maybe String)]
       , structTags :: [MoatType]
       -- ^ The tags of the struct. See 'Tag'.
       --
@@ -418,6 +419,13 @@ data Options = Options
   --
   -- This can be used with @omitFields = const Discard@ to ensure fields are
   -- retained for client compatibility.
+  , deprecatedFields :: [(String, Maybe String)]
+  -- ^ These fields are deprecated for clients and a comment with details about the deprecation
+  -- deprecated fields are also required in Haskell
+  --
+  -- This field will generate a mobile type as a comment instead of actual code
+  -- and add the specified comment to the resulting type
+  -- The purpose of this field is to allow fields to be no longer generated
   , strictCases :: [String]
   -- ^ These enum cases are relied upon and must exist in the sum type.
   --
@@ -574,6 +582,7 @@ defaultOptions =
     , omitFields = const Keep
     , omitCases = const Keep
     , fieldsRequiredByClients = []
+    , deprecatedFields = []
     , strictCases = []
     , makeBase = (False, Nothing, [])
     , optionalExpand = False

test/DeprecatedFieldSpec.hs

@@ -0,0 +1,29 @@
+module DeprecatedFieldSpec where
+
+import Common
+import Moat
+import Test.Hspec
+import Test.Hspec.Golden
+
+data Data = Data
+  { field0 :: Int
+  , field1 :: Maybe Int
+  }
+
+mobileGenWith
+  ( defaultOptions
+      { fieldsRequiredByClients = ["field0", "field1"]
+      , omitFields = const Discard
+      , deprecatedFields = [("field1", Just "Deprecated since build 500")]
+      }
+  )
+  ''Data
+
+spec :: Spec
+spec =
+  fdescribe "stays golden" $ do
+    let moduleName = "DeprecatedFieldSpec"
+    it "swift" $
+      defaultGolden ("swift" <> moduleName) (showSwift @Data)
+    it "kotlin" $
+      defaultGolden ("kotlin" <> moduleName) (showKotlin @Data)