content: -- Copyright 2016 Google Inc. All Rights Reserved.
  --
  -- Use of this source code is governed by a BSD-style
  -- license that can be found in the LICENSE file or at
  -- https://developers.google.com/open-source/licenses/bsd
  
  -- | This module builds the actual, generated Haskell file
  -- for a given input .proto file.
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedLabels #-}
  {-# LANGUAGE OverloadedStrings #-}
  module Data.ProtoLens.Compiler.Generate(
      generateModule,
      ) where
  
  
  import Control.Arrow (second)
  import qualified Data.Foldable as F
  import qualified Data.List as List
  import qualified Data.Map as Map
  import Data.Maybe (isJust)
  #if !MIN_VERSION_base(4,11,0)
  import Data.Semigroup ((<>))
  #endif
  import Data.Ord (comparing)
  import qualified Data.Set as Set
  import Data.String (fromString)
  import Data.Text (unpack)
  import qualified Data.Text as T
  import Data.Tuple (swap)
  import GHC.SourceGen
  #if MIN_VERSION_ghc(8,10,0)
  import GHC.Hs (ideclName, ideclAs)
  #else
  import HsSyn (ideclName, ideclAs)
  #endif
  #if MIN_VERSION_ghc(9,10,0)
  import GHC.Parser.Annotation (noAnn)
  #elif MIN_VERSION_ghc(9,2,0)
  import GHC.Parser.Annotation (EpAnn(EpAnnNotUsed), SrcSpanAnn'(SrcSpanAnn))
  #endif
  #if MIN_VERSION_ghc(9,0,0)
  #if MIN_VERSION_ghc(9,6,0)
  import Language.Haskell.Syntax.Module.Name (moduleNameString, mkModuleName)
  #else
  import GHC.Unit.Module.Name (moduleNameString, mkModuleName)
  #endif
  import qualified GHC.Utils.Outputable as Outputable
  import GHC.Types.SrcLoc (unLoc)
  import qualified GHC.Types.SrcLoc as SrcLoc
  #else
  import Module (moduleNameString, mkModuleName)
  import qualified Outputable
  import SrcLoc (unLoc)
  import qualified SrcLoc
  #endif
  import Lens.Family2 ((^.))
  import Text.Printf (printf)
  
  import Proto.Google.Protobuf.Descriptor
      ( EnumValueDescriptorProto
      , FileDescriptorProto
      , FieldDescriptorProto
      , FieldDescriptorProto'Type(..)
      )
  
  import Data.ProtoLens.Compiler.Definitions
  import Data.ProtoLens.Compiler.Generate.Commented
  import Data.ProtoLens.Compiler.Generate.Encoding
  import Data.ProtoLens.Compiler.Generate.Field
      ( hsFieldType
      , hsFieldVectorType
      )
  
  import Data.ProtoLens.Encoding (encodeMessage)
  import qualified Data.ByteString as BS
  
  -- Whether to import the "Runtime" modules or the originals;
  -- e.g., Data.ProtoLens.Runtime.Data.Map vs Data.Map.
  data UseRuntime = UseRuntime | UseOriginal
      deriving (Eq, Read)
  
  -- | Generate a Haskell module for the given input file(s).
  -- input contains all defined names, incl. those in this module
  generateModule :: ModuleNameStr
                 -> FileDescriptorProto -- ^ The complete file descriptor
                 -> [ModuleNameStr]  -- ^ The imported modules
                 -> [ModuleNameStr]  -- ^ The publicly imported modules
                 -> Env OccNameStr      -- ^ Definitions in this file
                 -> Env RdrNameStr     -- ^ Definitions in the imported modules
                 -> [ServiceInfo]
                 -> [CommentedModule]
  generateModule modName fdesc imports publicImports definitions importedEnv services
      = [ CommentedModule pragmas
              (module' (Just modName)
                  (Just $ serviceExports
                          ++ concatMap generateExports (Map.elems definitions)
                          ++ map moduleContents publicImports)
                  (mainImports ++ sharedImports
                      ++ map importQualified (imports List.\\ publicImports)
                      ++ map import' publicImports)
                  [])
            $ concatMap generateDecls (Map.toList definitions)
           ++ map uncommented (concatMap (generateServiceDecls env) services)
           ++ map uncommented packedFileDescriptorProto
        , CommentedModule pragmas
              (module' (Just fieldModName) Nothing
                  (sharedImports ++ map importQualified imports) [])
            $ map uncommented
            $ concatMap generateFieldDecls allLensNames
        ]
    where
      fieldModName = fromString $ moduleNameString (unModuleNameStr modName) ++ "_Fields"
      pragmas =
            [ languagePragma $ List.intercalate ", " $ map fromString
                ["ScopedTypeVariables", "DataKinds", "TypeFamilies",
                 "UndecidableInstances", "GeneralizedNewtypeDeriving",
                 "MultiParamTypeClasses", "FlexibleContexts", "FlexibleInstances",
                 "PatternSynonyms", "MagicHash", "NoImplicitPrelude",
                 "DataKinds", "BangPatterns", "TypeApplications",
                 "OverloadedStrings", "DerivingStrategies"]
                -- Allow unused imports in case we don't import anything from
                -- Data.Text, Data.Int, etc.
            , optionsGhcPragma "-Wno-unused-imports"
              -- haskell-src-exts doesn't support exporting `Foo(..., A, B)`
              -- in a single entry, so we use two: `Foo(..)` and `Foo(A, B)`.
            , optionsGhcPragma "-Wno-duplicate-exports"
              -- Don't warn if empty "import public" modules are reexported.
            , optionsGhcPragma "-Wno-dodgy-exports"
            ]
      mainImports = map (reexported . importQualified)
                      [ "Control.DeepSeq", "Data.ProtoLens.Prism" ]
      sharedImports = map (reexported . importQualified)
                [ "Prelude", "Data.Int", "Data.Monoid", "Data.Word"
                , "Data.ProtoLens"
                , "Data.ProtoLens.Encoding.Bytes"
                , "Data.ProtoLens.Encoding.Growing"
                , "Data.ProtoLens.Encoding.Parser.Unsafe"
                , "Data.ProtoLens.Encoding.Wire"
                , "Data.ProtoLens.Field"
                , "Data.ProtoLens.Message.Enum"
                , "Data.ProtoLens.Service.Types"
                , "Lens.Family2", "Lens.Family2.Unchecked"
                , "Data.Text",  "Data.Map", "Data.ByteString", "Data.ByteString.Char8"
                , "Data.Text.Encoding"
                , "Data.Vector"
                , "Data.Vector.Generic"
                , "Data.Vector.Unboxed"
                , "Text.Read"
                ]
      env = Map.union (unqualifyEnv definitions) importedEnv
      generateDecls (protoName, Message m)
          = generateMessageDecls fieldModName env (stripDotPrefix protoName) m
         ++ map uncommented (concatMap (generatePrisms env) (messageOneofFields m))
      generateDecls (_, Enum e) = map uncommented $ generateEnumDecls e
      generateExports (Message m) = generateMessageExports m
                                 ++ concatMap generatePrismExports (messageOneofFields m)
      generateExports (Enum e) = generateEnumExports e
      serviceExports = fmap generateServiceExports services
      allLensNames = F.toList $ Set.fromList
          [ lensSymbol inst
          | Message m <- Map.elems definitions
          , info <- allMessageFields env m
          , inst <- recordFieldLenses info
          ]
      -- The packedFileDescriptorProto is a file level definition that's
      -- shared across all message definitions.  If there are no
      -- messages, it's omitted since it's only used inside of Message
      -- instances.
      packedFileDescriptorProto
        | null [m | Message m <- Map.elems definitions] = []
        | otherwise = [
            typeSig "packedFileDescriptor" $ var "Data.ByteString.ByteString",
            valBind "packedFileDescriptor" $ string packedFDesc
            ]
        where
          packedFDesc = fmap (toEnum . fromEnum) . BS.unpack . encodeMessage $ fdesc
      -- The Env uses the convention that Message names are prefixed with '.'
      -- (since that's how the FileDescriptorProto refers to them).
      -- Strip that off when defining MessageDescriptor.messageName.
      stripDotPrefix s
          | Just ('.', s') <- T.uncons s = s'
          | otherwise = s
  
  allMessageFields :: Env RdrNameStr -> MessageInfo OccNameStr -> [RecordField]
  allMessageFields env info =
      map (plainRecordField env) (messageFields info)
          ++ map (oneofRecordField env) (messageOneofFields info)
  
  {- We import modules as follows:
  
  1) Modules from proto-lens-runtime: import qualified, strip the prefix:
       import qualified Data.ProtoLens.Runtime.Data.Text as Data.Text
  
  2) Modules from "import" declarations: import qualified:
       import qualified Proto.Foo.Bar
  
  3) Modules from "import public" declarations: import unqualified:
       import Proto.Foo.Bar
     To reexport the imported declarations from the current module via
       module ... (module Proto.Foo.Bar)
     the module Proto.Foo.Bar needs to be unqualified.
     Alternately we could explicitly enumerate every definition being reexported, but
     that would lead to less readable Haddocks and also make codegen a little more
     complicated.
  -}
  
  importQualified :: ModuleNameStr -> ImportDecl'
  importQualified = qualified' . import'
  
  type ModifyImports = ImportDecl' -> ImportDecl'
  
  reexported :: ModifyImports
  reexported imp = imp { ideclName = noLoc m', ideclAs = Just m }
    where
  #if MIN_VERSION_ghc(9,10,0)
      noLoc = SrcLoc.L noAnn
  #elif MIN_VERSION_ghc(9,2,0)
      noLoc = SrcLoc.L (SrcSpanAnn EpAnnNotUsed SrcLoc.noSrcSpan)
  #else
      noLoc = SrcLoc.noLoc
  #endif
      m' = mkModuleName $ "Data.ProtoLens.Runtime." ++ moduleNameString (unLoc m)
      m = ideclName imp
  
  messageComment :: ModuleNameStr -> OccNameStr -> [RecordField] -> Outputable.SDoc
  messageComment fieldModName n fields =
      Outputable.vcat
          $ [Outputable.text "Fields :", ""]
              ++ map item (concatMap recordFieldLenses fields)
    where
      item :: LensInstance -> Outputable.SDoc
      item l = Outputable.text (printf "    * '%s.%s' @:: "
                   (moduleNameStrToString fieldModName)
                   (occNameStrToString $ nameFromSymbol $ lensSymbol l))
               Outputable.<>
                   Outputable.ppr (var "Lens'" @@ t @@ lensFieldType l)
               Outputable.<> Outputable.char '@'
      t = var (unqual n)
  
  generateMessageExports :: MessageInfo OccNameStr -> [IE']
  generateMessageExports m =
      -- Hide the message contructor, but expose "oneof" case constructors.
      thingWith (unqual $ messageName m) []
          : map (thingAll . unqual . oneofTypeName)
                  (messageOneofFields m)
  
  generateServiceDecls :: Env RdrNameStr -> ServiceInfo -> [HsDecl']
  generateServiceDecls env si =
      -- data MyService = MyService
      [ data' serverDataName []
        [ recordCon serverDataName []
        ]
        []
      ] ++
      -- instance Data.ProtoLens.Service.Types.Service MyService where
      --     type ServiceName    MyService = "myService"
      --     type ServicePackage MyService = "some.package"
      --     type ServiceMethods MyService = '["normalMethod", "streamingMethod"]
      --     packedServiceDescriptor _ = ...
      [ instance' (var "Data.ProtoLens.Service.Types.Service" @@ serverRecordType)
          [ tyFamInst "ServiceName" [serverRecordType]
                   . stringTy . T.unpack $ serviceName si
          , tyFamInst "ServicePackage" [serverRecordType]
                   . stringTy . T.unpack $ servicePackage si
          , tyFamInst "ServiceMethods" [serverRecordType]
                   $ listPromotedTy
                        [ stringTy . T.unpack $ methodIdent m
                        | m <- List.sortBy (comparing methodIdent) $ serviceMethods si
                        ]
          , funBind "packedServiceDescriptor" $ match [wildP] $ string svcDescriptor
          ]
      ] ++
      -- instance Data.ProtoLens.Service.Types.HasMethodImpl MyService "normalMethod" where
      --     type MethodInput       MyService "normalMethod" = Foo
      --     type MethodOutput      MyService "normalMethod" = Bar
      --     type IsClientStreaming MyService "normalMethod" = 'False
      --     type IsServerStreaming MyService "normalMethod" = 'False
      [ instance' (var "Data.ProtoLens.Service.Types.HasMethodImpl" @@ serverRecordType @@ instanceHead)
          [ tyFamInst "MethodName" [serverRecordType, instanceHead]
                   . stringTy . T.unpack $ methodName m
          , tyFamInst "MethodInput" [serverRecordType, instanceHead]
                   . lookupType $ methodInput m
          , tyFamInst "MethodOutput" [serverRecordType, instanceHead]
                   . lookupType $ methodOutput m
          , tyFamInst "MethodStreamingType" [serverRecordType, instanceHead]
                   . tyPromotedVar
                   $ case (methodClientStreaming m, methodServerStreaming m) of
                       (False, False) -> "Data.ProtoLens.Service.Types.NonStreaming"
                       (True,  False) -> "Data.ProtoLens.Service.Types.ClientStreaming"
                       (False, True)  -> "Data.ProtoLens.Service.Types.ServerStreaming"
                       (True,  True)  -> "Data.ProtoLens.Service.Types.BiDiStreaming"
          ]
      | m <- serviceMethods si
      , let instanceHead = stringTy (T.unpack $ methodIdent m)
      ]
    where
      svcDescriptor = fmap (toEnum . fromEnum) . BS.unpack . encodeMessage $ serviceDescriptor si
      serverDataName = fromString . T.unpack $ serviceName si
      serverRecordType = var $ unqual serverDataName
  
      lookupType t = case definedType t env of
                         Message msg -> var $ messageName msg
                         Enum _ -> error "Service must have a message type"
  
  
  generateMessageDecls :: ModuleNameStr -> Env RdrNameStr -> T.Text -> MessageInfo OccNameStr -> [CommentedDecl]
  generateMessageDecls fieldModName env protoName info =
      -- data Bar = Bar {
      --    foo :: Baz
      -- }
      [ commented (messageComment fieldModName (messageName info) allFields)
          $ data' dataName []
              [recordCon (messageConstructorName info) $
                  [ (recordFieldName f, strict $ field $ recordFieldType f)
                  | f <- allFields
                  ]
                  ++ [(messageUnknownFields info, strict $ field $ var "Data.ProtoLens.FieldSet")]
              ]
              [derivingStock [var "Prelude.Eq", var "Prelude.Ord"]]
      -- instance Show Bar where
      --   showsPrec __x __s = showChar '{' (showString (showMessageShort __x) (showChar '}' s))
      , uncommented $
          instance' (var "Prelude.Show" @@ dataType)
              [funBind "showsPrec" $ match [bvar "_", bvar "__x", bvar "__s"]
                  $ var "Prelude.showChar" @@ char '{'
                      @@ (var "Prelude.showString"
                              @@ (var "Data.ProtoLens.showMessageShort" @@ var "__x")
                          @@ (var "Prelude.showChar" @@ char '}' @@ var "__s"))]
      ] ++
      -- oneof field data type declarations
      -- proto: message Foo {
      --          oneof bar {
      --            float c = 1;
      --            Sub s = 2;
      --          }
      --        }
      -- haskell: data Foo'Bar = Foo'Bar'c !Prelude.Float
      --                       | Foo'Bar's !Sub
      [ uncommented $ data' (oneofTypeName oneofInfo) []
        [ prefixCon consName [strict $ field $ hsFieldType env f]
        | c <- oneofCases oneofInfo
        , let f = caseField c
        , let consName = caseConstructorName c
        ]
        [derivingStock [var "Prelude.Show", var "Prelude.Eq", var "Prelude.Ord"]]
      | oneofInfo <- messageOneofFields info
      ] ++
      -- instance HasField Foo "foo" Bar
      --   fieldOf _ = ...
      -- Note: for optional fields, this generates an instance both for "foo" and
      -- for "maybe'foo" (see plainRecordField below).
      [ uncommented $ instance'
          (var "Data.ProtoLens.Field.HasField" @@ dataType @@ sym @@ t)
              [funBind "fieldOf" $ match [wildP] $
                  var "Prelude.."
                      @@ rawFieldAccessor (unqual $ recordFieldName li)
                      @@ lensExp i]
      | li <- allFields
      , i <- recordFieldLenses li
      , let t = lensFieldType i
      , let sym = promoteSymbol $ lensSymbol i
      ]
      ++
      -- instance Message.Message Bar where
      [ uncommented $ instance' (var "Data.ProtoLens.Message" @@ dataType)
          $ messageInstance env protoName info
      -- instance NFData Bar where
      , uncommented $ instance' (var "Control.DeepSeq.NFData" @@ dataType)
          [valBind "rnf" $ messageRnfExpr info]
      ] ++
      -- instance NFData Foo'Bar where
      [ uncommented $
          instance' (var "Control.DeepSeq.NFData" @@
                          var (unqual $ oneofTypeName o))
          [funBinds "rnf" $ map oneofRnfMatch $ oneofCases o]
      | o <- messageOneofFields info
      ]
    where
      dataType = var $ unqual dataName
      dataName = messageName info
      allFields = allMessageFields env info
  
  -- oneof Prism declarations
  -- proto: message Foo {
  --          oneof bar {
  --            float c = 1;
  --            Sub s = 2;
  --          }
  --        }
  -- haskell: _Foo'C :: Prism' Bar'C Float
  --          _Foo'S :: Prism' Bar'S Sub
  --
  --  example of the function definition for _Foo'C:
  -- _Foo'C :: Prism' Bar'C Float
  -- _Foo'C
  --   = prism' Bar'C
  --       (\ p__ ->
  --          case p__ of
  --              Bar'C p__val -> Prelude.Just p__val
  --              _otherwise -> Prelude.Nothing)
  generatePrisms :: Env RdrNameStr -> OneofInfo -> [HsDecl']
  generatePrisms env oneofInfo =
      if length cases > 1
         then concatMap (generatePrism altOtherwise) cases
         else concatMap (generatePrism mempty) cases
      where
          cases = oneofCases oneofInfo
          altOtherwise = [match [bvar "_otherwise"] (var "Prelude.Nothing")]
  
          -- Generate type signature
          -- e.g. Prism' Bar'C Float
          generateTypeSig f funName =
              typeSig funName $ var "Data.ProtoLens.Prism.Prism'"
                                  -- The oneof sum type name
                               @@ (var . unqual $ oneofTypeName oneofInfo)
                                  -- The field contained in the sum
                               @@ hsFieldType env f
          -- Generate function definition
          -- Prism' is constructed with Constructor for building value
          -- and Deconstructor and wrapping in Just for getting value
          generateFunDef :: [RawMatch] -> OccNameStr -> HsExpr'
          generateFunDef otherwiseCase consName =
                 var "Data.ProtoLens.Prism.prism'"
                 -- Sum type constructor
              @@ var (unqual consName)
                 -- Case deconstruction
              @@ lambda [bvar "p__"] (
                      case' (var "p__") $
                         match [conP (unqual consName) [bvar "p__val"]]
                               (var "Prelude.Just" @@ var "p__val")
                         -- We want to generate the otherwise case
                         -- depending on the amount of sum type cases there are
                         : otherwiseCase
                      )
          generatePrism :: [RawMatch] -> OneofCase -> [HsDecl']
          generatePrism otherwiseCase oneofCase =
              let consName = caseConstructorName oneofCase
                  prismName = casePrismName oneofCase
              in [ generateTypeSig (caseField oneofCase) prismName
                 , valBind prismName $ generateFunDef otherwiseCase consName
                 ]
  
  generatePrismExports :: OneofInfo -> [IE']
  generatePrismExports = map (var . unqual . casePrismName) . oneofCases
  
  generateEnumExports :: EnumInfo OccNameStr -> [IE']
  generateEnumExports e = [thingAll n, thingWith n aliases] ++ proto3NewType
    where
      n = unqual $ enumName e
      aliases = [enumValueName v | v <- enumValues e, needsManualExport v]
      needsManualExport v = isJust (enumAliasOf v)
      proto3NewType = case enumUnrecognized e of
          Just u -> [var . unqual $ unrecognizedValueName u]
          Nothing -> []
  
  generateServiceExports :: ServiceInfo -> IE'
  generateServiceExports si = thingAll $ unqual $ fromString $ T.unpack $ serviceName si
  
  generateEnumDecls :: EnumInfo OccNameStr -> [HsDecl']
  generateEnumDecls info =
      -- Proto3-only:
      -- newtype FooEnum'UnrecognizedValue = FooEnum'UnrecognizedValue Data.Int.Int32
      --   deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, Prelude.Read)
      [ newtype' (unrecognizedValueName u) []
         (prefixCon (unrecognizedValueName u) [field $ var "Data.Int.Int32"])
         [derivingStock [var "Prelude.Eq", var "Prelude.Ord", var "Prelude.Show"]]
      | Just u <- [unrecognized]
      ]
      ++
  
      -- data FooEnum
      --     = Enum1
      --     | Enum2
      --     | FooEnum'Unrecognized !FooEnum'UnrecognizedValue
      --   deriving (Prelude.Show, Prelude.Eq, Prelude.Ord, Prelude.Read)
      [ data' dataName []
          (  (flip prefixCon [] <$> constructorNames)
          ++ [ prefixCon (unrecognizedName u)
                  [strict $ field $ var $ unqual $ unrecognizedValueName u]
             | Just u <- [unrecognized]
             ]
          )
          [derivingStock [var "Prelude.Show", var "Prelude.Eq", var "Prelude.Ord"]]
  
      -- instance Data.ProtoLens.MessageEnum FooEnum where
      --       maybeToEnum 0 = Prelude.Just Enum1
      --       maybeToEnum 3 = Prelude.Just Enum2
      --       maybeToEnum k
      --         -- Proto3:
      --         = Prelude.Just
      --             (FooEnum'Unrecognized
      --               (FooEnum'UnrecognizedValue (Prelude.fromIntegral k)))
      --         -- Proto2:
      --         = Nothing
      --
      --       showEnum Foo'Enum2 = "Enum2"
      --       showEnum Foo'Enum1 = "Enum1"
      --       showEnum (FooEnum'Unrecognized (FooEnum'UnrecognizedValue k))
      --         = Prelude.show k
      --
      --       readEnum k
      --           | k == "Enum2a" = Prelude.Just Enum2a -- alias
      --           | k == "Enum2" = Prelude.Just Enum2
      --           | k == "Enum1" = Prelude.Just Enum1
      --       readEnum k = Text.Read.readMaybe k >>= maybeToEnum
      , instance' (var "Data.ProtoLens.MessageEnum" @@ dataType)
          [ funBinds "maybeToEnum" $
              [ match [int k] $ var "Prelude.Just" @@ var (unqual c)
              | (c, k) <- constructorNumbers
              ]
              ++
              [ case enumUnrecognized info of
                  Nothing -> match [wildP] $ var "Prelude.Nothing"
                  Just u -> match [bvar "k"]
                              $ var "Prelude.Just" @@
                                  (var (unqual $ unrecognizedName u)
                                  @@ (var (unqual $ unrecognizedValueName u)
                                      @@ (var "Prelude.fromIntegral" @@ var "k")
                                      )
                                  )
              ]
          , funBinds "showEnum" $
              [ match [conP_ (unqual n)] $ string pn
              | v <- filter (null . enumAliasOf) $ enumValues info
              , let n = enumValueName v
              , let pn = T.unpack $ enumValueDescriptor v ^. #name
              ] ++
              [ match [conP (unqual $ unrecognizedName u)
                          [conP (unqual $ unrecognizedValueName u) [bvar "k"]]
                      ]
                  $ var "Prelude.show" @@ var "k"
              | Just u <- [unrecognized]
              ]
          , funBind "readEnum" $ matchGRHSs [bvar "k"] $ guardedRhs $
                [ guard (var "Prelude.==" @@ var "k" @@ string pn)
                      $ var "Prelude.Just" @@ var (unqual n)
                | v <- enumValues info
                , let n = enumValueName v
                , let pn = T.unpack $ enumValueDescriptor v ^. #name
                ]
                ++ [guard (var "Prelude.otherwise") $ var "Prelude.>>="
                                        @@ (var "Text.Read.readMaybe" @@ var "k")
                                        @@ var "Data.ProtoLens.maybeToEnum"]
          ]
  
        -- instance Bounded Foo where
        --    minBound = Foo1
        --    maxBound = FooN
        , instance' (var "Prelude.Bounded" @@ dataType)
            [ valBind "minBound" $ var $ unqual minBoundName
            , valBind "maxBound" $ var $ unqual maxBoundName
            ]
  
        -- instance Enum Foo where
        --    toEnum k = maybe (error ("Foo.toEnum: unknown argument for enum Foo: "
        --                                ++ show k))
        --                  id (maybeToEnum k)
        --    fromEnum Foo1 = 1
        --    fromEnum Foo2 = 2
        --    ..
        --    succ FooN = error "Foo.succ: bad argument FooN."
        --    succ Foo1 = Foo2
        --    succ Foo2 = Foo3
        --    ..
        --    pred Foo1 = error "Foo.succ: bad argument Foo1."
        --    pred Foo2 = Foo1
        --    pred Foo3 = Foo2
        --    ..
        --    enumFrom = messageEnumFrom
        --    enumFromTo = messageEnumFromTo
        --    enumFromThen = messageEnumFromThen
        --    enumFromThenTo = messageEnumFromThenTo
        , instance' (var "Prelude.Enum" @@ dataType)
          [funBind "toEnum" $ match [bvar "k__"]
                    $ var "Prelude.maybe" @@ errorMessageExpr @@ var "Prelude.id"
                          @@ (var "Data.ProtoLens.maybeToEnum" @@ var "k__")
          , funBinds "fromEnum" $
              [ match [conP_ (unqual c)] $ int k
              | (c, k) <- constructorNumbers
              ]
              ++
              [ match [conP (unqual $ unrecognizedName u)
                                  [conP (unqual $ unrecognizedValueName u) [bvar "k"]]
                                  ]
                      $ var "Prelude.fromIntegral" @@ var "k"
              | Just u <- [unrecognized]
              ]
          , succDecl "succ" maxBoundName succPairs
          , succDecl "pred" minBoundName $ map swap succPairs
          , valBind "enumFrom" $ var "Data.ProtoLens.Message.Enum.messageEnumFrom"
          , valBind "enumFromTo" $ var "Data.ProtoLens.Message.Enum.messageEnumFromTo"
          , valBind "enumFromThen" $ var "Data.ProtoLens.Message.Enum.messageEnumFromThen"
          , valBind "enumFromThenTo"
              $ var "Data.ProtoLens.Message.Enum.messageEnumFromThenTo"
          ]
  
      -- instance Data.ProtoLens.FieldDefault Foo where
      --   fieldDefault = FirstEnumValue
      , instance' (var "Data.ProtoLens.FieldDefault" @@ dataType)
          [valBind "fieldDefault" defaultCon]
  
      -- instance NFData Foo where
      --   rnf x__ = seq x__ ()
      -- (Trivial since enum types are already strict)
      , instance' (var "Control.DeepSeq.NFData" @@ dataType)
          [ funBind "rnf" $ match [bvar "x__"]
              $ var "Prelude.seq" @@ var "x__" @@ var "()" ]
      ] ++
  
      -- pattern Enum2a :: FooEnum
      -- pattern Enum2a = Enum2
      concat
          [ [ patSynSig aliasName dataType
            , patSynBind aliasName [] (bvar originalName)
            ]
          | EnumValueInfo
              { enumValueName = aliasName
              , enumAliasOf = Just originalName
              } <- enumValues info
          ]
  
    where
      EnumInfo { enumName = dataName
               , enumUnrecognized = unrecognized
               , enumDescriptor = ed
               } = info
      errorMessage = "toEnum: unknown value for enum " ++ unpack (ed ^. #name)
                        ++ ": "
  
      errorMessageExpr = var "Prelude.error"
                            @@ (var "Prelude.++" @@ string errorMessage
                                @@ (var "Prelude.show" @@ var "k__"))
  
      dataType = var $ unqual dataName
  
      constructors :: [(OccNameStr, EnumValueDescriptorProto)]
      constructors = List.sortBy (comparing ((^. #number) . snd))
                              [(n, d) | EnumValueInfo
                                  { enumValueName = n
                                  , enumValueDescriptor = d
                                  , enumAliasOf = Nothing
                                  } <- enumValues info
                              ]
      constructorNames = map fst constructors
  
      defaultCon = var $ unqual minBoundName
  
      (minBoundName, maxBoundName, succPairs) =
        case constructorNames of
          (c : cs) -> (c, last constructorNames, zip constructorNames cs)
          _ -> error $ "Unexpected empty constructors in " <> show (enumName info)
  
      constructorNumbers = map (second (fromIntegral . (^. #number))) constructors
  
      succDecl :: OccNameStr -> OccNameStr -> [(OccNameStr, OccNameStr)] -> RawInstDecl
      succDecl funName boundName thePairs = funBinds funName $
          match [conP_ (unqual boundName)]
              (var "Prelude.error" @@ string (concat
                  [ occNameStrToString dataName, "."
                  , occNameStrToString funName, ": bad argument "
                  , occNameStrToString boundName
                  , ". This value would be out of bounds."
                  ]))
          :
          [ match [conP_ (unqual from')] $ var $ unqual to
          | (from', to) <- thePairs
          ]
          ++
          [ match [conP (unqual $ unrecognizedName u) [wildP]]
              (var "Prelude.error" @@ string (concat
                  [ occNameStrToString dataName, "."
                  , occNameStrToString funName, ": bad argument: unrecognized value"
  
                  ]))
          | Just u <- [unrecognized]
          ]
  
  generateFieldDecls :: Symbol -> [HsDecl']
  generateFieldDecls xStr =
      -- foo :: forall f s a
      --        . (Functor f, HasLens s x a) => LensLike' f s a
      -- foo = fieldOf @s
      [ typeSig x
            $ forall' [bvar "f", bvar "s", bvar "a"]
            $ [ var "Prelude.Functor" @@ var "f"
              , var "Data.ProtoLens.Field.HasField" @@ var "s" @@ xSym @@ var "a"
              ]
            ==> var "Lens.Family2.LensLike'" @@ var "f" @@ var "s" @@ var "a"
      , valBind x $ fieldOfExp xStr
      ]
    where
      x = nameFromSymbol xStr
      xSym = promoteSymbol xStr
  
  ------------------------------------------
  
  -- | An individual field of the Haskell type corresponding to a proto message.
  data RecordField = RecordField
      { recordFieldName :: OccNameStr  -- ^ The Haskell name of this field (unique
                                 --   within the module).
      , recordFieldType :: HsType'  -- ^ Internal type in the record
      , recordFieldLenses :: [LensInstance]
          -- ^ All of the (overloaded) lenses accessing this record field.
      }
  
  -- | An instance of HasLens' for a particular field.
  data LensInstance = LensInstance
      { lensSymbol :: Symbol
            -- ^ The overloaded name for this lens.
      , lensFieldType :: HsType'
            -- ^ The type pointed to from this lens.
      , lensExp :: HsExpr'
          -- ^ A lens from the recordFieldType to the lensFieldType; i.e.,
          -- from how it's actually stored in the Haskell record to how the
          -- lens views it.
      }
  
  -- | Compile information about the record field type and type/class instances
  -- for this particular field.
  --
  -- Used for "plain" record fields that are not part of a oneof.
  plainRecordField :: Env RdrNameStr -> PlainFieldInfo -> RecordField
  plainRecordField env (PlainFieldInfo kind f) = case kind of
      -- data Foo = Foo { _Foo_bar :: Bar }
      -- type instance Field "bar" Foo = Bar
      RequiredField
          -> recordField baseType
                    [LensInstance
                        { lensSymbol = baseName
                        , lensFieldType = baseType
                        , lensExp = rawAccessor
                        }]
      OptionalValueField
                -> recordField baseType
                      [LensInstance
                        { lensSymbol = baseName
                        , lensFieldType = baseType
                        , lensExp = rawAccessor
                        }]
      -- data Foo = Foo { _Foo_bar :: Maybe Bar }
      -- type instance Field "bar" Foo = Bar
      -- type instance Field "maybe'bar" Foo = Maybe Bar
      OptionalMaybeField ->
                recordField maybeType
                    [LensInstance
                        { lensSymbol = baseName
                        , lensFieldType = baseType
                        , lensExp = maybeAccessor
                        }
                    , LensInstance
                        { lensSymbol = "maybe'" <> baseName
                        , lensFieldType = maybeType
                        , lensExp = rawAccessor
                        }
                    ]
          -- data Foo = Foo { _Foo_bar :: Map Bar Baz }
          -- type instance Field "foo" Foo = Map Bar Baz
      MapField entry ->
              let mapType = var "Data.Map.Map"
                              @@ hsFieldType env (keyField entry)
                              @@ hsFieldType env (valueField entry)
              in recordField mapType
                    [LensInstance
                         { lensSymbol = baseName
                         , lensFieldType = mapType
                         , lensExp = rawAccessor
                         }]
          -- data Foo = Foo { _Foo_bar :: [Bar] }
          -- type instance Field "bar" Foo = [Bar]
      RepeatedField {} ->
              recordField vectorType
                    [ LensInstance
                        { lensSymbol = baseName
                        , lensFieldType = listType
                        , lensExp = vectorAccessor
                        }
                    , LensInstance
                        { lensSymbol = "vec'" <> baseName
                        , lensFieldType = vectorType
                        , lensExp = rawAccessor
                        }
                    ]
    where
      recordField = RecordField (haskellRecordFieldName $ fieldName f)
      baseName = overloadedName $ fieldName f
      fd = fieldDescriptor f
      baseType = hsFieldType env f
      maybeType = var "Prelude.Maybe" @@ baseType
      listType = listTy baseType
      vectorType = hsFieldVectorType f @@ baseType
      rawAccessor = var "Prelude.id"
      maybeAccessor = var "Data.ProtoLens.maybeLens"
                            @@ hsFieldValueDefault env fd
  
  vectorAccessor :: HsExpr'
  vectorAccessor = var "Lens.Family2.Unchecked.lens" @@ getter @@ setter
    where
      getter = var "Data.Vector.Generic.toList"
      setter = lambda [wildP, bvar "y__"]
                  $ var "Data.Vector.Generic.fromList" @@ var "y__"
  
  oneofRecordField :: Env RdrNameStr -> OneofInfo -> RecordField
  oneofRecordField env oneofInfo
      = RecordField
          { recordFieldName = haskellRecordFieldName $ oneofFieldName oneofInfo
          , recordFieldType =
                var "Prelude.Maybe" @@ var (unqual $ oneofTypeName oneofInfo)
          , recordFieldLenses = lenses
          }
    where
      lenses =
          -- Only generate a "maybe" version of this lens,
          -- since oneofs don't have a notion of a "default" case.
          -- data Foo = Foo { _Foo'bar = Maybe Foo'Bar }
          -- type instance Field "maybe'bar" Foo = Maybe Foo'Bar
          LensInstance
            { lensSymbol = "maybe'" <> overloadedName
                                          (oneofFieldName oneofInfo)
            , lensFieldType =
                  var "Prelude.Maybe" @@ var (unqual $ oneofTypeName oneofInfo)
            , lensExp = var "Prelude.id"
            }
          : concat
            -- Generate the same lenses for each sub-field of the oneof
            -- as if they were proto2 optional fields.
            -- type instance Field "bar" Foo = Bar
            -- type instance Field "maybe'bar" Foo = Maybe Bar
              [ [ LensInstance
                  { lensSymbol = maybeName
                  , lensFieldType = var "Prelude.Maybe" @@ baseType
                  , lensExp = oneofFieldAccessor c
                  }
                , LensInstance
                  { lensSymbol = baseName
                  , lensFieldType = baseType
                  , lensExp = var "Prelude.."
                                  @@ oneofFieldAccessor c
                                  @@ (var "Data.ProtoLens.maybeLens"
                                                @@ hsFieldValueDefault env
                                                      (fieldDescriptor f))
                  }
                ]
              | c <- oneofCases oneofInfo
              , let f = caseField c
              , let baseName = overloadedName $ fieldName f
              , let baseType = hsFieldType env f
              , let maybeName = "maybe'" <> baseName
              ]
  
  hsFieldDefault :: Env RdrNameStr -> PlainFieldInfo -> HsExpr'
  hsFieldDefault env f = case plainFieldKind f of
      RequiredField -> hsFieldValueDefault env fd
      OptionalValueField -> hsFieldValueDefault env fd
      OptionalMaybeField -> var "Prelude.Nothing"
      MapField {} -> var "Data.Map.empty"
      RepeatedField {} -> var "Data.Vector.Generic.empty"
    where
      fd = fieldDescriptor (plainFieldInfo f)
  
  hsFieldValueDefault :: Env RdrNameStr -> FieldDescriptorProto -> HsExpr'
  hsFieldValueDefault env fd = case fd ^. #type' of
      FieldDescriptorProto'TYPE_MESSAGE -> var "Data.ProtoLens.defMessage"
      FieldDescriptorProto'TYPE_GROUP -> var "Data.ProtoLens.defMessage"
      FieldDescriptorProto'TYPE_ENUM
          | T.null def -> var "Data.ProtoLens.fieldDefault"
          | Enum e <- definedFieldType fd env
          , Just v <- List.lookup def [ (enumValueDescriptor v ^. #name, enumValueName v)
                                      | v <- enumValues e
                                      ]
              -> var v
          | otherwise -> errorMessage "enum"
      -- The rest of the cases are for scalar fields that have a fieldDefault
      -- instance.
      _ | T.null def -> var "Data.ProtoLens.fieldDefault"
      FieldDescriptorProto'TYPE_BOOL
          | def == "true" -> var "Prelude.True"
          | def == "false" -> var "Prelude.False"
          | otherwise -> errorMessage "bool"
      FieldDescriptorProto'TYPE_STRING
          -> var "Data.Text.pack" @@ string (T.unpack def)
      FieldDescriptorProto'TYPE_BYTES
          -> var "Data.ByteString.pack"
                  @@ list (mkByte . fromEnum <$> T.unpack def)
        where mkByte c
                | c > 0 && c < 255 = int $ fromIntegral c
                | otherwise = errorMessage "bytes"
      FieldDescriptorProto'TYPE_FLOAT -> defaultFrac $ T.unpack def
      FieldDescriptorProto'TYPE_DOUBLE -> defaultFrac $ T.unpack def
      -- Otherwise, assume it's an integral field:
      _ -> defaultInt $ T.unpack def
    where
      def = fd ^. #defaultValue
      errorMessage fieldType
          = error $ "Bad default value " ++ show (T.unpack def)
                      ++ " in default value for " ++ fieldType ++ " field "
                      ++ unpack (fd ^. #name)
      -- float/double fields can use nan, inf and -inf as default values.
      -- The Prelude doesn't provide names for them, so we implement
      -- them as division by zero.
      defaultFrac "nan" = var "Prelude./" @@ frac 0 @@ frac 0
      defaultFrac "inf" = var "Prelude./" @@ frac 1 @@ frac 0
      defaultFrac "-inf" = var "Prelude./" @@ frac (negate 1) @@ frac 0
      defaultFrac s = case reads s of
          [(x, "")] -> frac $ toRational (x :: Double)
          _ -> errorMessage "fractional"
      defaultInt s = case reads s of
          [(x, "")] -> int x
          _ -> errorMessage "integral"
  
  -- | A lens to access an internal field.
  --
  --   lens _Foo_bar (\x__ y__ -> x__ { _Foo_bar = y__ })
  rawFieldAccessor :: RdrNameStr -> HsExpr'
  rawFieldAccessor f = var "Lens.Family2.Unchecked.lens" @@ getter @@ setter
    where
      getter = var f
      setter = lambda [bvar "x__", bvar "y__"]
                      $ recordUpd (var "x__") [(f, var "y__")]
  
  -- | A lens that maps from a oneof sum type to one of its individual cases.
  --
  -- For example, with
  --     data Foo = Bar Int32 | Baz Int64
  --
  -- this will generate a lens of type @Lens' (Maybe Foo) (Maybe Int32)@.
  --
  -- (Recall that oneofs are stored in a proto message as @Maybe Foo@, where
  -- 'Nothing' means that it's either set to an unknown value or unset.)
  --
  -- lens
  --   (\ x__ -> case x__ of
  --       Prelude.Just (Foo'c x__val) -> Prelude.Just x__val
  --       otherwise -> Prelude.Nothing)
  --   (\ _ y__ -> fmap Foo'c y__
  oneofFieldAccessor :: OneofCase -> HsExpr'
  oneofFieldAccessor o
          = var "Lens.Family2.Unchecked.lens" @@ getter @@ setter
    where
      consName = caseConstructorName o
      getter = lambda [bvar "x__"] $
          case' (var "x__")
              [ match [conP "Prelude.Just" [conP (unqual consName) [bvar "x__val"]]]
                  $ var "Prelude.Just" @@ var "x__val"
              , match [bvar "_otherwise"] $ var "Prelude.Nothing"
              ]
      setter = lambda [wildP, bvar "y__"]
                  $ var "Prelude.fmap" @@ var (unqual consName) @@ var "y__"
  
  messageInstance :: Env RdrNameStr -> T.Text -> MessageInfo OccNameStr -> [RawInstDecl]
  messageInstance env protoName m =
      [ funBind "messageName" $ match [wildP] $
            var "Data.Text.pack" @@ string (T.unpack protoName)
      , funBind "packedMessageDescriptor" $ match [wildP] $ string msgDescriptor
      , funBind "packedFileDescriptor" $ match [wildP] $ var "packedFileDescriptor"
      , valBind "fieldsByTag" $
            let' (map (fieldDescriptorVarBind $ messageName m) fields)
                $ var "Data.Map.fromList" @@ list fieldsByTag
      , valBind "unknownFields"
             $ rawFieldAccessor (unqual $ messageUnknownFields m)
      , valBind "defMessage"
             $ recordConE (unqual $ messageConstructorName m) $
                    [ (unqual $ haskellRecordFieldName
                                      $ fieldName $ plainFieldInfo f,
                          hsFieldDefault env f)
                    | f <- messageFields m
                    ] ++
                    [ (unqual $ haskellRecordFieldName $ oneofFieldName o,
                          var "Prelude.Nothing")
                    | o <- messageOneofFields m
                    ] ++
                    [ (unqual $ messageUnknownFields m, var "[]")]
      , valBind "parseMessage" $ generatedParser env m
      , valBind "buildMessage" $ generatedBuilder m
      ]
    where
      msgDescriptor = fmap (toEnum . fromEnum) . BS.unpack . encodeMessage $ messageDescriptor m
      fieldsByTag =
          [tuple
                [ t, fieldDescriptorVar f ]
                | f <- fields
                , let t = var "Data.ProtoLens.Tag"
                            @@ int (fromIntegral
                                        $ fieldDescriptor (plainFieldInfo f) ^. #number)
                ]
      fieldDescriptorVar = var . unqual . fieldDescriptorName
      fieldDescriptorName f
          = nameFromSymbol $ overloadedName (fieldName . plainFieldInfo $ f)
                                  <> "__field_descriptor"
      fieldDescriptorVarBind n f
          = valBind (fieldDescriptorName f)
              $ fieldDescriptorExpr env n f
      fields = messageFields m
                  ++ (messageOneofFields m >>= fmap casePlainField . oneofCases)
      -- The cases of an optional are always treated like proto2 "maybe" fields.
      -- This code here does not apply to proto3 optional fields which
      -- are absent from messageOneofFields, but those get treated as
      -- OptionalMaybeField by fieldKind so they behave the same.
      casePlainField = PlainFieldInfo OptionalMaybeField . caseField
  
  -- | Get the name of the field when used in a text format proto. Groups are
  -- special because their text format field name is the name of their type,
  -- not the name of the field in the descriptor (e.g. "Foo", not "foo").
  textFormatFieldName :: Env RdrNameStr -> FieldDescriptorProto -> T.Text
  textFormatFieldName env descr = case descr ^. #type' of
      FieldDescriptorProto'TYPE_GROUP
          | Message msg <- definedFieldType descr env
                -> messageDescriptor msg ^. #name
          | otherwise -> error $ "expected TYPE_GROUP for type name"
                             ++ T.unpack (descr ^. #typeName)
      _ -> descr ^. #name
  
  fieldDescriptorExpr :: Env RdrNameStr -> OccNameStr -> PlainFieldInfo
                      -> HsExpr'
  fieldDescriptorExpr env n f =
      (var "Data.ProtoLens.FieldDescriptor"
          -- Record the original .proto name for text format
          @@ string (T.unpack $ textFormatFieldName env fd)
          -- Force the type signature since it can't be inferred for Map entry
          -- types.
          @@ (fieldTypeDescriptorExpr (fd ^. #type')
                  @::@
                      (var "Data.ProtoLens.FieldTypeDescriptor"
                          @@ hsFieldType env (plainFieldInfo f)))
          @@ fieldAccessorExpr f)
      -- TODO: why is this type sig needed?
      @::@
      (var "Data.ProtoLens.FieldDescriptor" @@ var (unqual n))
    where
      fd = fieldDescriptor $ plainFieldInfo f
  
  fieldAccessorExpr :: PlainFieldInfo -> HsExpr'
  -- (PlainField Required foo), (OptionalField foo), etc...
  fieldAccessorExpr (PlainFieldInfo kind f) = accessorCon @@ fieldOfExp hsFieldName
  
    where
      accessorCon = case kind of
            RequiredField
                  -> var "Data.ProtoLens.PlainField" @@ var "Data.ProtoLens.Required"
            OptionalValueField
                  -> var "Data.ProtoLens.PlainField" @@ var "Data.ProtoLens.Optional"
            OptionalMaybeField
                  -> var "Data.ProtoLens.OptionalField"
            MapField entry
                    -> var "Data.ProtoLens.MapField"
                           @@ fieldOfExp (overloadedField $ keyField entry)
                           @@ fieldOfExp (overloadedField $ valueField entry)
            RepeatedField packed ->
                  var "Data.ProtoLens.RepeatedField"
                    @@ if packed == Packed
                          then var "Data.ProtoLens.Packed"
                          else var "Data.ProtoLens.Unpacked"
      hsFieldName
          = case kind of
              OptionalMaybeField -> "maybe'" <> overloadedField f
              _ -> overloadedField f
  
  fieldOfExp :: Symbol -> HsExpr'
  fieldOfExp sym = var "Data.ProtoLens.Field.field" `tyApp` promoteSymbol sym
  
  overloadedField :: FieldInfo -> Symbol
  overloadedField = overloadedName . fieldName
  
  fieldTypeDescriptorExpr :: FieldDescriptorProto'Type -> HsExpr'
  fieldTypeDescriptorExpr = \case
      FieldDescriptorProto'TYPE_DOUBLE -> mk "ScalarField" "DoubleField"
      FieldDescriptorProto'TYPE_FLOAT -> mk "ScalarField" "FloatField"
      FieldDescriptorProto'TYPE_INT64 -> mk "ScalarField" "Int64Field"
      FieldDescriptorProto'TYPE_UINT64 -> mk "ScalarField" "UInt64Field"
      FieldDescriptorProto'TYPE_INT32 -> mk "ScalarField" "Int32Field"
      FieldDescriptorProto'TYPE_FIXED64 -> mk "ScalarField" "Fixed64Field"
      FieldDescriptorProto'TYPE_FIXED32 -> mk "ScalarField" "Fixed32Field"
      FieldDescriptorProto'TYPE_BOOL -> mk "ScalarField" "BoolField"
      FieldDescriptorProto'TYPE_STRING -> mk "ScalarField" "StringField"
      FieldDescriptorProto'TYPE_GROUP -> mk "MessageField" "GroupType"
      FieldDescriptorProto'TYPE_MESSAGE -> mk "MessageField" "MessageType"
      FieldDescriptorProto'TYPE_BYTES -> mk "ScalarField" "BytesField"
      FieldDescriptorProto'TYPE_UINT32 -> mk "ScalarField" "UInt32Field"
      FieldDescriptorProto'TYPE_ENUM -> mk "ScalarField" "EnumField"
      FieldDescriptorProto'TYPE_SFIXED32 -> mk "ScalarField" "SFixed32Field"
      FieldDescriptorProto'TYPE_SFIXED64 -> mk "ScalarField" "SFixed64Field"
      FieldDescriptorProto'TYPE_SINT32 -> mk "ScalarField" "SInt32Field"
      FieldDescriptorProto'TYPE_SINT64 -> mk "ScalarField" "SInt64Field"
    where
      mk x y = var (fromString ("Data.ProtoLens." ++ x))
                @@ var (fromString ("Data.ProtoLens." ++ y))
  
  -- | Generate the implementation of NFData.rnf for the given message.
  --
  -- instance NFData Bar where
  --    rnf = \x -> deepseq (_Bar'foo x) (deepseq (_Bar'bar x) ())
  messageRnfExpr :: MessageInfo OccNameStr -> HsExpr'
  messageRnfExpr msg = lambda [bvar "x__"] $ foldr ((@@) . seqField) unit fieldNames
    where
      fieldNames = messageUnknownFields msg
                  : map (haskellRecordFieldName . fieldName . plainFieldInfo)
                         (messageFields msg)
                  ++ map (haskellRecordFieldName . oneofFieldName)
                         (messageOneofFields msg)
      seqField :: OccNameStr -> HsExpr'
      seqField f = var "Control.DeepSeq.deepseq" @@ (var (unqual f) @@ var "x__")
  
  --   rnf (Foo'a x__) = rnf x__
  --   rnf (Bar'b x__) = rnf x__
  oneofRnfMatch :: OneofCase -> RawMatch
  oneofRnfMatch c = match [unqual (caseConstructorName c) `conP` [bvar "x__"]]
                      $ var "Control.DeepSeq.rnf" @@ var "x__"
  