Improve compilation errors.

src/Proto3/Suite/Form.hs

@@ -39,11 +39,14 @@ module Proto3.Suite.Form
   , RecoverRepetition
   , RecoverProtoType
   , MessageFieldType
+  , OptionalMessageFieldType
+  , RepeatedMessageFieldType
   ) where
 
 import Data.Int (Int32, Int64)
 import Data.Kind (Type)
 import Data.Word (Word32, Word64)
+import GHC.Exts (Constraint)
 import GHC.Generics (Generic)
 import GHC.TypeLits (ErrorMessage(..), Nat, Symbol, TypeError)
 import Prelude hiding (String)
@@ -309,7 +312,29 @@ instance MessageFieldType ('Singular 'Implicit) 'Bool Bool
 instance MessageFieldType ('Singular 'Implicit) 'Float Float
 instance MessageFieldType ('Singular 'Implicit) 'Double Double
 instance MessageFieldType ('Singular 'Implicit) ('Enumeration e) (Enumerated e)
-instance MessageFieldType 'Optional ('Message m) (Nested m)
+
+-- | Helps to diagnose the absence of an instance for 'MessageFieldType'
+-- for optional submessages by requiring that the second type parameter
+-- be 'Nested' of the first.  Please try to avoid using this type family
+-- directly; it is exported only to help explain compilation errors.
+type family OptionalMessageFieldType (m :: Type) (haskellType :: Type)
+  where
+    OptionalMessageFieldType m (Nested m) = (() :: Constraint)
+    OptionalMessageFieldType m (Nested a) = TypeError
+      ( 'Text "Expected reflected protobuf submessage type " ':<>: 'ShowType m ':$$:
+        'Text "Actual type: " ':<>: 'ShowType a )
+    OptionalMessageFieldType m haskellType = TypeError
+      ( 'Text "When using a Haskell type to specify an optional protobuf submessage" ':$$:
+        'Text "(as opposed to repeated one or a submessage within a oneof)" ':$$:
+        'Text "you must wrap the Haskell reflection type in Proto3.Suite.Nested." ':$$:
+        'Text "Expected reflected protobuf submessage type " ':<>: 'ShowType m ':$$:
+        'Text "Haskell type provided: " ':<>: 'ShowType haskellType )
+
+instance ( OptionalMessageFieldType m haskellType
+         , RecoverRepetition haskellType ~ 'Optional
+         , RecoverProtoType haskellType ~ 'Message m
+         ) =>
+         MessageFieldType 'Optional ('Message m) haskellType
 
 instance MessageFieldType ('Singular 'Alternative) 'Int32 (ForceEmit Int32)
 instance MessageFieldType ('Singular 'Alternative) 'Int64 (ForceEmit Int64)
@@ -327,7 +352,7 @@ instance MessageFieldType ('Singular 'Alternative) 'Bool (ForceEmit Bool)
 instance MessageFieldType ('Singular 'Alternative) 'Float (ForceEmit Float)
 instance MessageFieldType ('Singular 'Alternative) 'Double (ForceEmit Double)
 instance MessageFieldType ('Singular 'Alternative) ('Enumeration e) (ForceEmit (Enumerated e))
-instance ( RecoverRepetition m ~ ('Singular 'Alternative)
+instance ( RecoverRepetition m ~ 'Singular 'Alternative
          , RecoverProtoType m ~ 'Message m
          ) =>
          MessageFieldType ('Singular 'Alternative) ('Message m) m
@@ -348,7 +373,30 @@ instance MessageFieldType ('Repeated 'Unpacked) 'Bool (UnpackedVec Bool)
 instance MessageFieldType ('Repeated 'Unpacked) 'Float (UnpackedVec Float)
 instance MessageFieldType ('Repeated 'Unpacked) 'Double (UnpackedVec Double)
 instance MessageFieldType ('Repeated 'Unpacked) ('Enumeration e) (UnpackedVec (Enumerated e))
-instance MessageFieldType ('Repeated 'Unpacked) ('Message m) (NestedVec m)
+
+-- | Helps to diagnose the absence of an instance for 'MessageFieldType'
+-- for repeated submessages by requiring that the second type parameter
+-- be 'NestedVec' of the first.  Please try to avoid using this type family
+-- directly; it is exported only to help explain compilation errors.
+type family RepeatedMessageFieldType (m :: Type) (haskellType :: Type)
+  where
+    RepeatedMessageFieldType m (NestedVec m) = (() :: Constraint)
+    RepeatedMessageFieldType m (NestedVec a) = TypeError
+      ( 'Text "Expected reflected protobuf submessage type " ':<>: 'ShowType m ':$$:
+        'Text "Actual type: " ':<>: 'ShowType a )
+    RepeatedMessageFieldType m haskellType = TypeError
+      ( 'Text "When using a Haskell type to specify a repeated protobuf submessage" ':$$:
+        'Text "(as opposed to an optional one or a submessage within a oneof)" ':$$:
+        'Text "you must wrap the Haskell reflection type in Proto3.Suite.NestedVec." ':$$:
+        'Text "Expected reflected protobuf submessage type " ':<>: 'ShowType m ':$$:
+        'Text "Haskell type provided: " ':<>: 'ShowType haskellType )
+
+instance ( RepeatedMessageFieldType m haskellType
+         , RecoverRepetition haskellType ~ 'Repeated 'Unpacked
+         , RecoverProtoType haskellType ~ 'Message m
+         ) =>
+         MessageFieldType ('Repeated 'Unpacked) ('Message m) haskellType
+
 instance ( MessageFieldType ('Singular 'Implicit) k kh
          , MessageFieldType (RepetitionOfMapped v) v vh
          ) =>

src/Proto3/Suite/Form/Encode.hs

@@ -32,9 +32,20 @@ module Proto3.Suite.Form.Encode
   , cachedMessageEncoding
   , Prefix(..)
   , etaPrefix
+  , Fields
+  , cachePrefix
+  , cachedFields
   , Distinct
+  , DistinctCheck
+  , RepeatedNames
+  , RepeatedNames1
+  , Omits
+  , Strip
+  , OccupiedOnly
+  , OccupiedOnly1
   , fieldsToMessage
   , Occupy
+  , Occupy1
   , omitted
   , KnownFieldNumber
   , Field(..)
@@ -249,6 +260,10 @@ associations = field @name @(t (MessageEncoder (Association key value)))
 -- where a mix of techniques is needed, either for compatibility
 -- or during a gradual transition to use of 'Field'.
 --
+-- Note that for optional submessages you must use `Proto3.Suite.Types.Nested`,
+-- and for repeated submessages you must use `Proto3.Suite.Types.NestedVec`.
+-- (For submessages within a @oneof@ you can use the reflection type directly.)
+--
 -- To encode a top-level message instead of a field, use 'messageReflection'.
 newtype Reflection a = Reflection a
 

src/Proto3/Suite/Form/Encode/Core.hs

@@ -37,8 +37,16 @@ module Proto3.Suite.Form.Encode.Core
   , cachePrefix
   , cachedFields
   , Distinct
+  , DistinctCheck
+  , RepeatedNames
+  , RepeatedNames1
+  , Omits
+  , Strip
+  , OccupiedOnly
+  , OccupiedOnly1
   , fieldsToMessage
   , Occupy
+  , Occupy1
   , omitted
   , KnownFieldNumber
   , fieldNumber
@@ -195,6 +203,11 @@ cachedFields = UnsafePrefix . Encode.unsafeFromByteString . untypedFields
 type Distinct (message :: Type) (names :: [Symbol]) =
   DistinctCheck message (RepeatedNames (OccupiedOnly message names))
 
+-- | Reports nonempty output of 'RepeatedNames' as applied to the result of 'OccupiedOnly'.
+--
+-- This type family is an implementation detail of 'Distinct'
+-- that is subject to change, and is exported only to assist
+-- in understanding of compilation errors.
 type family DistinctCheck (message :: Type) (repeated :: [k]) :: Constraint
   where
     DistinctCheck _ '[] = ()
@@ -204,24 +217,41 @@ type family DistinctCheck (message :: Type) (repeated :: [k]) :: Constraint
 
 -- | Given a list of names, returns the non-repeating list
 -- of names that occur more than once in the given list.
+--
+-- This type family is an implementation detail of 'Distinct'
+-- that is subject to change, and is exported only to assist
+-- in understanding of compilation errors.
 type family RepeatedNames (names :: [k]) :: [k]
   where
     RepeatedNames (name ': names) = RepeatedNames1 name names (Omits name names)
     RepeatedNames '[] = '[]
 
+-- | Helps to implement 'RepeatedNames'.
+--
+-- This type family is an implementation detail of 'Distinct'
+-- that is subject to change, and is exported only to assist
+-- in understanding of compilation errors.
 type family RepeatedNames1 (name :: k) (names :: [k]) (omits :: Bool) :: [k]
   where
     RepeatedNames1 _ names 'True = RepeatedNames names
     RepeatedNames1 name names 'False = name ': RepeatedNames (Strip name names)
 
 -- | Is the given name absent from the given list of names?
+--
+-- This type family is an implementation detail of 'RepeatedNames'
+-- that is subject to change, and is exported only to assist
+-- in understanding of compilation errors.
 type family Omits (name :: k) (names :: [k]) :: Bool
   where
     Omits name (name ': names) = 'False
     Omits name (_ ': names) = Omits name names
     Omits name '[] = 'True
 
 -- | Strips all occurrences of the given name, leaving behind all other name occurrences.
+--
+-- This type family is an implementation detail of 'RepeatedNames'
+-- that is subject to change, and is exported only to assist
+-- in understanding of compilation errors.
 type family Strip (name :: k) (names :: [k]) :: [k]
   where
     Strip name (name ': names) = Strip name names
@@ -232,13 +262,22 @@ type family Strip (name :: k) (names :: [k]) :: [k]
 --
 -- We do this in case 'omitted' is used to introduce the names of repeated fields
 -- or fields that are contained within @oneof@s; see the explanatory comments there.
+--
+-- This type family is an implementation detail of 'Distinct'
+-- that is subject to change, and is exported only to assist
+-- in understanding of compilation errors.
 type family OccupiedOnly (message :: Type) (names :: [Symbol]) :: [Symbol]
   where
     OccupiedOnly message (name ': names) =
       OccupiedOnly1 message name names (RepetitionOf message name)
     OccupiedOnly _ '[] =
       '[]
 
+-- | Helps to implement 'OccupiedOnly'.
+--
+-- This type family is an implementation detail of 'Distinct'
+-- that is subject to change, and is exported only to assist
+-- in understanding of compilation errors.
 type family OccupiedOnly1 (message :: Type) (name :: Symbol) (names :: [Symbol])
                           (repetition :: Repetition) :: [Symbol]
   where
@@ -274,6 +313,11 @@ fieldsToMessage = UnsafeMessageEncoder . untypedPrefix
 type Occupy (message :: Type) (name :: Symbol) (names :: [Symbol]) =
   Occupy1 message name names (RepetitionOf message name)
 
+-- | Helps to implement 'Occupy'.
+--
+-- This type family is an implementation detail of 'Occupy'
+-- that is subject to change, and is exported only to assist
+-- in understanding of compilation errors.
 type family Occupy1 (message :: Type) (name :: Symbol) (names :: [Symbol])
                     (repetition :: Repetition) :: [Symbol]
   where