{-# LANGUAGE NamedFieldPuns, RecordWildCards, ViewPatterns, CPP #-}
-- This module uses the Reflection data structures (ProtoInfo,EnumInfo,DescriptorInfo) to
-- build an AST using Language.Haskell.Syntax.  This get quite verbose, so a large number
-- of helper functions (and operators) are defined to aid in specifying the output code.
--
-- Note that this may eventually also generate hs-boot files to allow
-- for breaking mutual recursion.
--
-- Mangling: For the current moment, assume the mangling is done in a prior pass:
--   (*) Uppercase all module names and type names and enum constants
--   (*) lowercase all field names
--   (*) add a prime after all field names than conflict with reserved words
--
-- The names are also assumed to have become fully-qualified, and all
-- the optional type codes have been set.
--
module Text.ProtocolBuffers.ProtoCompile.Gen(protoModule,descriptorModules,enumModule,oneofModule,prettyPrint) where

import Text.DescriptorProtos.FieldDescriptorProto.Type hiding (Type)

import Text.ProtocolBuffers.Basic
import Text.ProtocolBuffers.Identifiers
import Text.ProtocolBuffers.Reflections(KeyInfo,HsDefault(..),SomeRealFloat(..),DescriptorInfo(..),ProtoInfo(..),OneofInfo(..),EnumInfo(..),ProtoName(..),ProtoFName(..),FieldInfo(..))

import Text.ProtocolBuffers.ProtoCompile.BreakRecursion(Result(..),VertexKind(..),pKey,pfKey,getKind,Part(..))

import Data.Monoid ((<>))
import qualified Data.ByteString.Lazy.Char8 as LC(unpack)
import qualified Data.Foldable as F(foldr,toList)
import Data.List(sortBy,foldl',foldl1',group,sort,union)
import Data.Function(on)
import Language.Haskell.Exts.Pretty(prettyPrint)
import Language.Haskell.Exts.Syntax hiding (Int,String)
import Language.Haskell.Exts.Syntax as Hse
import Data.Char(isLower,isUpper)
import qualified Data.Map as M
import Data.Maybe(mapMaybe)
import Data.List (dropWhileEnd)
import           Data.Sequence (ViewL(..),(><))
import qualified Data.Sequence as Seq(null,length,viewl)
import qualified Data.Set as S
import System.FilePath(joinPath)

ecart :: String -> a -> a
ecart :: String -> a -> a
ecart String
_ a
x = a
x

default (Int)

-- -- -- -- Helper functions

imp :: String -> a
imp :: String -> a
imp String
s = String -> a
forall a. HasCallStack => String -> a
error (String
"Impossible? Text.ProtocolBuffers.ProtoCompile.Gen."String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s)

nubSort :: Ord a => [a] -> [a]
nubSort :: [a] -> [a]
nubSort = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. [a] -> a
head ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort

noWhere :: Maybe (Binds ())
noWhere :: Maybe (Binds ())
noWhere = Maybe (Binds ())
forall a. Maybe a
Nothing

whereBinds :: Binds () -> Maybe (Binds ())
whereBinds :: Binds () -> Maybe (Binds ())
whereBinds = Binds () -> Maybe (Binds ())
forall a. a -> Maybe a
Just


($$) :: Exp () -> Exp () -> Exp ()
$$ :: Exp () -> Exp () -> Exp ()
($$) = () -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
App ()

infixl 1 $$

litStr :: String -> Exp ()
litStr :: String -> Exp ()
litStr String
s = () -> Literal () -> Exp ()
forall l. l -> Literal l -> Exp l
Lit () (Literal () -> Exp ()) -> Literal () -> Exp ()
forall a b. (a -> b) -> a -> b
$ () -> String -> String -> Literal ()
forall l. l -> String -> String -> Literal l
Hse.String () String
s String
s

litIntP :: Integral x => x -> Pat ()
litIntP :: x -> Pat ()
litIntP (x -> Integer
forall a. Integral a => a -> Integer
toInteger -> Integer
x)
    | Integer
xInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<Integer
0 = () -> Pat () -> Pat ()
forall l. l -> Pat l -> Pat l
PParen () (Pat () -> Pat ()) -> Pat () -> Pat ()
forall a b. (a -> b) -> a -> b
$ () -> Sign () -> Literal () -> Pat ()
forall l. l -> Sign l -> Literal l -> Pat l
PLit () (() -> Sign ()
forall l. l -> Sign l
Signless ()) (() -> Integer -> String -> Literal ()
forall l. l -> Integer -> String -> Literal l
Hse.Int () Integer
x (Integer -> String
forall a. Show a => a -> String
show Integer
x))
    | Bool
otherwise = () -> Sign () -> Literal () -> Pat ()
forall l. l -> Sign l -> Literal l -> Pat l
PLit () (() -> Sign ()
forall l. l -> Sign l
Signless ()) (() -> Integer -> String -> Literal ()
forall l. l -> Integer -> String -> Literal l
Hse.Int () Integer
x (Integer -> String
forall a. Show a => a -> String
show Integer
x))

-- Pin down the type inference
litIntP' :: Int -> Pat ()
litIntP' :: Int -> Pat ()
litIntP' = Int -> Pat ()
forall x. Integral x => x -> Pat ()
litIntP

litInt :: Integral x => x -> Exp ()
litInt :: x -> Exp ()
litInt (x -> Integer
forall a. Integral a => a -> Integer
toInteger -> Integer
x)
    | Integer
xInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<Integer
0 = () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ () -> Literal () -> Exp ()
forall l. l -> Literal l -> Exp l
Lit () (() -> Integer -> String -> Literal ()
forall l. l -> Integer -> String -> Literal l
Hse.Int () Integer
x (Integer -> String
forall a. Show a => a -> String
show Integer
x))
    | Bool
otherwise = () -> Literal () -> Exp ()
forall l. l -> Literal l -> Exp l
Lit () (() -> Integer -> String -> Literal ()
forall l. l -> Integer -> String -> Literal l
Hse.Int () Integer
x (Integer -> String
forall a. Show a => a -> String
show Integer
x))

litInt' :: Int -> Exp ()
litInt' :: Int -> Exp ()
litInt' = Int -> Exp ()
forall x. Integral x => x -> Exp ()
litInt

typeApp :: String -> Type () -> Type ()
typeApp :: String -> Type () -> Type ()
typeApp String
s = () -> Type () -> Type () -> Type ()
forall l. l -> Type l -> Type l -> Type l
TyApp () (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (String -> QName ()
private String
s))

-- private is for Text.ProtocolBuffers.Header, prelude is for Prelude, local is unqualified
private :: String -> QName ()
private :: String -> QName ()
private String
t = () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"P'") (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
t)

prelude :: String -> QName ()
prelude :: String -> QName ()
prelude String
t = () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude'") (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
t)

local :: String -> QName ()
local :: String -> QName ()
local String
t = () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
t)

localField :: DescriptorInfo -> String -> QName ()
localField :: DescriptorInfo -> String -> QName ()
localField DescriptorInfo
di String
t = () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (DescriptorInfo -> String -> Name ()
fieldIdent DescriptorInfo
di String
t)

-- pvar and preludevar and lvar are for lower-case identifiers
isVar :: String -> Bool
isVar :: String -> Bool
isVar (Char
x:String
_) = Char -> Bool
isLower Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'
isVar String
_ = Bool
False

isCon :: String -> Bool
isCon :: String -> Bool
isCon (Char
x:String
_) = Char -> Bool
isUpper Char
x
isCon String
_ = Bool
False

pvar :: String -> Exp ()
pvar :: String -> Exp ()
pvar String
t | String -> Bool
isVar String
t = () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (String -> QName ()
private String
t)
       | Bool
otherwise = String -> Exp ()
forall a. HasCallStack => String -> a
error (String -> Exp ()) -> String -> Exp ()
forall a b. (a -> b) -> a -> b
$ String
"hprotoc Gen.hs assertion failed: pvar expected lower-case first letter in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
t

preludevar :: String -> Exp ()
preludevar :: String -> Exp ()
preludevar String
t | String -> Bool
isVar String
t = () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (String -> QName ()
prelude String
t)
             | Bool
otherwise = String -> Exp ()
forall a. HasCallStack => String -> a
error (String -> Exp ()) -> String -> Exp ()
forall a b. (a -> b) -> a -> b
$ String
"hprotoc Gen.hs assertion failed: preludevar expected lower-case first letter in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
t

lvar :: String -> Exp ()
lvar :: String -> Exp ()
lvar String
t | String -> Bool
isVar String
t = () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (String -> QName ()
local String
t)
       | Bool
otherwise = String -> Exp ()
forall a. HasCallStack => String -> a
error (String -> Exp ()) -> String -> Exp ()
forall a b. (a -> b) -> a -> b
$ String
"hprotoc Gen.hs assertion failed: lvar expected lower-case first letter in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
t

-- pcon and preludecon and lcon are for upper-case identifiers
pcon :: String -> Exp ()
pcon :: String -> Exp ()
pcon String
t | String -> Bool
isCon String
t = () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Con () (String -> QName ()
private String
t)
       | Bool
otherwise = String -> Exp ()
forall a. HasCallStack => String -> a
error (String -> Exp ()) -> String -> Exp ()
forall a b. (a -> b) -> a -> b
$ String
"hprotoc Gen.hs assertion failed: pcon expected upper-case first letter in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
t

preludecon :: String -> Exp ()
preludecon :: String -> Exp ()
preludecon String
t | String -> Bool
isCon String
t = () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Con () (String -> QName ()
prelude String
t)
             | Bool
otherwise = String -> Exp ()
forall a. HasCallStack => String -> a
error (String -> Exp ()) -> String -> Exp ()
forall a b. (a -> b) -> a -> b
$ String
"hprotoc Gen.hs assertion failed: preludecon expected upper-case first letter in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
t

lcon :: String -> Exp ()
lcon :: String -> Exp ()
lcon String
t | String -> Bool
isCon String
t = () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Con () (String -> QName ()
local String
t)
       | Bool
otherwise = String -> Exp ()
forall a. HasCallStack => String -> a
error (String -> Exp ()) -> String -> Exp ()
forall a b. (a -> b) -> a -> b
$ String
"hprotoc Gen.hs assertion failed: lcon expected upper-case first letter in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
t

-- patvar is a pattern that binds a new lower-case variable name
patvar :: String -> Pat ()
patvar :: String -> Pat ()
patvar String
t | String -> Bool
isVar String
t = () -> Name () -> Pat ()
forall l. l -> Name l -> Pat l
PVar () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
t)
         | Bool
otherwise = String -> Pat ()
forall a. HasCallStack => String -> a
error (String -> Pat ()) -> String -> Pat ()
forall a b. (a -> b) -> a -> b
$ String
"hprotoc Gen.hs assertion failed: patvar expected lower-case first letter in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
t

match :: String -> [Pat ()] -> Exp () -> Match ()
match :: String -> [Pat ()] -> Exp () -> Match ()
match String
s [Pat ()]
p Exp ()
r = () -> Name () -> [Pat ()] -> Rhs () -> Maybe (Binds ()) -> Match ()
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
s) [Pat ()]
p (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () Exp ()
r) Maybe (Binds ())
noWhere

inst :: String -> [Pat ()] -> Exp () -> InstDecl ()
inst :: String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
s [Pat ()]
p Exp ()
r  = () -> Decl () -> InstDecl ()
forall l. l -> Decl l -> InstDecl l
InsDecl () (Decl () -> InstDecl ()) -> Decl () -> InstDecl ()
forall a b. (a -> b) -> a -> b
$ () -> [Match ()] -> Decl ()
forall l. l -> [Match l] -> Decl l
FunBind () [String -> [Pat ()] -> Exp () -> Match ()
match String
s [Pat ()]
p Exp ()
r]

defun :: String -> [Pat ()] -> Exp () -> Decl ()
defun :: String -> [Pat ()] -> Exp () -> Decl ()
defun String
s [Pat ()]
p Exp ()
r  = () -> [Match ()] -> Decl ()
forall l. l -> [Match l] -> Decl l
FunBind () [String -> [Pat ()] -> Exp () -> Match ()
match String
s [Pat ()]
p Exp ()
r]

mkOp :: String -> Exp () -> Exp () -> Exp ()
mkOp :: String -> Exp () -> Exp () -> Exp ()
mkOp String
s Exp ()
a Exp ()
b = () -> Exp () -> QOp () -> Exp () -> Exp ()
forall l. l -> Exp l -> QOp l -> Exp l -> Exp l
InfixApp () Exp ()
a (() -> QName () -> QOp ()
forall l. l -> QName l -> QOp l
QVarOp () (() -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (() -> String -> Name ()
forall l. l -> String -> Name l
Symbol () String
s))) Exp ()
b

compose :: Exp () -> Exp () -> Exp ()
compose :: Exp () -> Exp () -> Exp ()
compose = String -> Exp () -> Exp () -> Exp ()
mkOp String
"."

fqMod :: ProtoName -> String
fqMod :: ProtoName -> String
fqMod (ProtoName FIName Utf8
_ [MName String]
a [MName String]
b MName String
c) = [MName String] -> String
joinMod ([MName String] -> String) -> [MName String] -> String
forall a b. (a -> b) -> a -> b
$ [MName String]
a[MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++[MName String]
b[MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++[MName String
c]

-- importPN takes the Result to look up the target info, it takes the
-- current MKey (pKey of protoName, no 'Key appended), and Part to
-- identify the module being created.  The ProtoName is the target
-- TYPE that is needed.
importPN :: Result -> ModuleName () -> Part -> ProtoName -> Maybe (ImportDecl ())
importPN :: Result
-> ModuleName () -> Part -> ProtoName -> Maybe (ImportDecl ())
importPN Result
r selfMod :: ModuleName ()
selfMod@(ModuleName () String
self) Part
part ProtoName
pn =
  let o :: MKey
o = ProtoName -> MKey
pKey ProtoName
pn
      m1 :: ModuleName ()
m1 = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () ([MName String] -> String
joinMod (ProtoName -> [MName String]
haskellPrefix ProtoName
pn [MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++ ProtoName -> [MName String]
parentModule ProtoName
pn [MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++ [ProtoName -> MName String
baseName ProtoName
pn]))
      m2 :: ModuleName ()
m2 = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () ([MName String] -> String
joinMod (ProtoName -> [MName String]
parentModule ProtoName
pn))
      fromSource :: Bool
fromSource = (MKey, Part, MKey) -> Set (MKey, Part, MKey) -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member (String -> MKey
forall a. a -> FMName a
FMName String
self,Part
part,MKey
o) (Result -> Set (MKey, Part, MKey)
rIBoot Result
r)
      iabs :: ImportSpec ()
iabs = () -> Namespace () -> Name () -> ImportSpec ()
forall l. l -> Namespace l -> Name l -> ImportSpec l
IAbs () (() -> Namespace ()
forall l. l -> Namespace l
NoNamespace ()) (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () (MName String -> String
forall a. MName a -> a
mName (ProtoName -> MName String
baseName ProtoName
pn)))
      ans :: Maybe (ImportDecl ())
ans = if ModuleName ()
m1 ModuleName () -> ModuleName () -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName ()
selfMod Bool -> Bool -> Bool
&& Part
part Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
/= Part
KeyFile then Maybe (ImportDecl ())
forall a. Maybe a
Nothing
              else ImportDecl () -> Maybe (ImportDecl ())
forall a. a -> Maybe a
Just (ImportDecl () -> Maybe (ImportDecl ()))
-> ImportDecl () -> Maybe (ImportDecl ())
forall a b. (a -> b) -> a -> b
$ ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () ModuleName ()
m1 Bool
True Bool
fromSource Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just ModuleName ()
m2)
                            (ImportSpecList () -> Maybe (ImportSpecList ())
forall a. a -> Maybe a
Just (() -> Bool -> [ImportSpec ()] -> ImportSpecList ()
forall l. l -> Bool -> [ImportSpec l] -> ImportSpecList l
ImportSpecList () Bool
False [ImportSpec ()
iabs]))
  in String -> Maybe (ImportDecl ()) -> Maybe (ImportDecl ())
forall a. String -> a -> a
ecart ([String] -> String
unlines ([String] -> String)
-> ([(String, String)] -> [String]) -> [(String, String)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ (String
a,String
b) -> String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
b) ([(String, String)] -> String) -> [(String, String)] -> String
forall a b. (a -> b) -> a -> b
$
                 [(String
"selfMod",ModuleName () -> String
forall a. Show a => a -> String
show ModuleName ()
selfMod)
                 ,(String
"part",Part -> String
forall a. Show a => a -> String
show Part
part)
                 ,(String
"pn",ProtoName -> String
forall a. Show a => a -> String
show ProtoName
pn)
                 ,(String
"o",MKey -> String
forall a. Show a => a -> String
show MKey
o)
                 ,(String
"m1",ModuleName () -> String
forall a. Show a => a -> String
show ModuleName ()
m1)
                 ,(String
"m2",ModuleName () -> String
forall a. Show a => a -> String
show ModuleName ()
m2)
                 ,(String
"fromSource",Bool -> String
forall a. Show a => a -> String
show Bool
fromSource)
                 ,(String
"ans",Maybe (ImportDecl ()) -> String
forall a. Show a => a -> String
show Maybe (ImportDecl ())
ans)]) (Maybe (ImportDecl ()) -> Maybe (ImportDecl ()))
-> Maybe (ImportDecl ()) -> Maybe (ImportDecl ())
forall a b. (a -> b) -> a -> b
$
     Maybe (ImportDecl ())
ans

importPFN :: Result -> ModuleName () -> ProtoFName -> Maybe (ImportDecl ())
importPFN :: Result -> ModuleName () -> ProtoFName -> Maybe (ImportDecl ())
importPFN Result
r m :: ModuleName ()
m@(ModuleName () String
self) ProtoFName
pfn =
  let o :: MKey
o@(FMName String
_other) = ProtoFName -> MKey
pfKey ProtoFName
pfn
      m1 :: ModuleName ()
m1@(ModuleName () String
m1') = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () ([MName String] -> String
joinMod (ProtoFName -> [MName String]
haskellPrefix' ProtoFName
pfn [MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++ ProtoFName -> [MName String]
parentModule' ProtoFName
pfn))
      m2 :: ModuleName ()
m2 = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () ([MName String] -> String
joinMod (ProtoFName -> [MName String]
parentModule' ProtoFName
pfn))
      spec :: Maybe (ImportSpecList ())
spec = ImportSpecList () -> Maybe (ImportSpecList ())
forall a. a -> Maybe a
Just (() -> Bool -> [ImportSpec ()] -> ImportSpecList ()
forall l. l -> Bool -> [ImportSpec l] -> ImportSpecList l
ImportSpecList () Bool
False [() -> Name () -> ImportSpec ()
forall l. l -> Name l -> ImportSpec l
IVar () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () (FName String -> String
forall a. FName a -> a
fName (ProtoFName -> FName String
baseName' ProtoFName
pfn)))])
      kind :: VertexKind
kind = Result -> MKey -> VertexKind
getKind Result
r MKey
o
      fromAlt :: Bool
fromAlt = (MKey, MKey) -> Set (MKey, MKey) -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member (String -> MKey
forall a. a -> FMName a
FMName String
self,String -> MKey
forall a. a -> FMName a
FMName String
m1') (Result -> Set (MKey, MKey)
rIKey Result
r)
      m1key :: ModuleName ()
m1key = if VertexKind
kind VertexKind -> VertexKind -> Bool
forall a. Eq a => a -> a -> Bool
== VertexKind
SplitKeyTypeBoot Bool -> Bool -> Bool
&& Bool
fromAlt
                then ModuleName () -> ModuleName ()
keyFile ModuleName ()
m1
                else ModuleName ()
m1
      qualifiedFlag :: Bool
qualifiedFlag = (ModuleName ()
m1 ModuleName () -> ModuleName () -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleName ()
m)
      qualifiedName :: Maybe (ModuleName ())
qualifiedName | Bool
qualifiedFlag = if ModuleName ()
m2ModuleName () -> ModuleName () -> Bool
forall a. Eq a => a -> a -> Bool
/=ModuleName ()
m1key then ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just ModuleName ()
m2 else Maybe (ModuleName ())
forall a. Maybe a
Nothing
                    | Bool
otherwise = Maybe (ModuleName ())
forall a. Maybe a
Nothing
      sourceFlag :: Bool
sourceFlag = (VertexKind
kind VertexKind -> VertexKind -> Bool
forall a. Eq a => a -> a -> Bool
== VertexKind
KeyTypeBoot) Bool -> Bool -> Bool
&& Bool
fromAlt
      ans :: Maybe (ImportDecl ())
ans = if Bool -> Bool
not Bool
qualifiedFlag Bool -> Bool -> Bool
&& VertexKind
kind VertexKind -> VertexKind -> Bool
forall a. Eq a => a -> a -> Bool
/= VertexKind
SplitKeyTypeBoot then Maybe (ImportDecl ())
forall a. Maybe a
Nothing else ImportDecl () -> Maybe (ImportDecl ())
forall a. a -> Maybe a
Just (ImportDecl () -> Maybe (ImportDecl ()))
-> ImportDecl () -> Maybe (ImportDecl ())
forall a b. (a -> b) -> a -> b
$
              ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () ModuleName ()
m1key Bool
qualifiedFlag Bool
sourceFlag Bool
False Maybe String
forall a. Maybe a
Nothing Maybe (ModuleName ())
qualifiedName Maybe (ImportSpecList ())
spec
  in String -> Maybe (ImportDecl ()) -> Maybe (ImportDecl ())
forall a. String -> a -> a
ecart ([String] -> String
unlines ([String] -> String)
-> ([(String, String)] -> [String]) -> [(String, String)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ (String
a,String
b) -> String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
b) ([(String, String)] -> String) -> [(String, String)] -> String
forall a b. (a -> b) -> a -> b
$
                [(String
"m",ModuleName () -> String
forall a. Show a => a -> String
show ModuleName ()
m)
                ,(String
"pfn",ProtoFName -> String
forall a. Show a => a -> String
show ProtoFName
pfn)
                ,(String
"o",MKey -> String
forall a. Show a => a -> String
show MKey
o)
                ,(String
"m1",ModuleName () -> String
forall a. Show a => a -> String
show ModuleName ()
m1)
                ,(String
"m2",ModuleName () -> String
forall a. Show a => a -> String
show ModuleName ()
m2)
                ,(String
"kind",VertexKind -> String
forall a. Show a => a -> String
show VertexKind
kind)
                ,(String
"ans",Maybe (ImportDecl ()) -> String
forall a. Show a => a -> String
show Maybe (ImportDecl ())
ans)]) (Maybe (ImportDecl ()) -> Maybe (ImportDecl ()))
-> Maybe (ImportDecl ()) -> Maybe (ImportDecl ())
forall a b. (a -> b) -> a -> b
$
     Maybe (ImportDecl ())
ans


importO :: Result -> ModuleName () -> Part -> OneofInfo -> Maybe [ImportDecl ()]
importO :: Result
-> ModuleName () -> Part -> OneofInfo -> Maybe [ImportDecl ()]
importO Result
r selfMod :: ModuleName ()
selfMod@(ModuleName () String
self) Part
part OneofInfo
oi =
  let pn :: ProtoName
pn = OneofInfo -> ProtoName
oneofName OneofInfo
oi
      o :: MKey
o = ProtoName -> MKey
pKey ProtoName
pn
      m1 :: ModuleName ()
m1 = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () ([MName String] -> String
joinMod (ProtoName -> [MName String]
haskellPrefix ProtoName
pn [MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++ ProtoName -> [MName String]
parentModule ProtoName
pn [MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++ [ProtoName -> MName String
baseName ProtoName
pn]))
      m2 :: ModuleName ()
m2 = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () ([MName String] -> String
joinMod (ProtoName -> [MName String]
parentModule ProtoName
pn))
      m3 :: ModuleName ()
m3 = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () ([MName String] -> String
joinMod (ProtoName -> [MName String]
parentModule ProtoName
pn [MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++ [ProtoName -> MName String
baseName ProtoName
pn]))
      fromSource :: Bool
fromSource = (MKey, Part, MKey) -> Set (MKey, Part, MKey) -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member (String -> MKey
forall a. a -> FMName a
FMName String
self,Part
part,MKey
o) (Result -> Set (MKey, Part, MKey)
rIBoot Result
r)
      iabs1 :: ImportSpec ()
iabs1 = () -> Namespace () -> Name () -> ImportSpec ()
forall l. l -> Namespace l -> Name l -> ImportSpec l
IAbs () (() -> Namespace ()
forall l. l -> Namespace l
NoNamespace ()) (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () (MName String -> String
forall a. MName a -> a
mName (ProtoName -> MName String
baseName ProtoName
pn)))
      iabsget :: [ImportSpec ()]
iabsget = ((ProtoName, FieldInfo) -> ImportSpec ())
-> [(ProtoName, FieldInfo)] -> [ImportSpec ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> Namespace () -> Name () -> ImportSpec ()
forall l. l -> Namespace l -> Name l -> ImportSpec l
IAbs () (() -> Namespace ()
forall l. l -> Namespace l
NoNamespace ()) (Name () -> ImportSpec ())
-> ((ProtoName, FieldInfo) -> Name ())
-> (ProtoName, FieldInfo)
-> ImportSpec ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> String -> Name ()
forall l. l -> String -> Name l
Ident () (String -> Name ())
-> ((ProtoName, FieldInfo) -> String)
-> (ProtoName, FieldInfo)
-> Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, ProtoName) -> String
forall a b. (a, b) -> a
fst ((String, ProtoName) -> String)
-> ((ProtoName, FieldInfo) -> (String, ProtoName))
-> (ProtoName, FieldInfo)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtoName, FieldInfo) -> (String, ProtoName)
oneofGet) ([(ProtoName, FieldInfo)] -> [ImportSpec ()])
-> (OneofInfo -> [(ProtoName, FieldInfo)])
-> OneofInfo
-> [ImportSpec ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)])
-> (OneofInfo -> Seq (ProtoName, FieldInfo))
-> OneofInfo
-> [(ProtoName, FieldInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  OneofInfo -> Seq (ProtoName, FieldInfo)
oneofFields (OneofInfo -> [ImportSpec ()]) -> OneofInfo -> [ImportSpec ()]
forall a b. (a -> b) -> a -> b
$ OneofInfo
oi
      ithall :: ImportSpec ()
ithall = () -> Name () -> ImportSpec ()
forall l. l -> Name l -> ImportSpec l
IThingAll () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () (MName String -> String
forall a. MName a -> a
mName (ProtoName -> MName String
baseName ProtoName
pn)))

      ans1 :: ImportDecl ()
ans1 = ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () ModuleName ()
m1 Bool
True Bool
fromSource Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just ModuleName ()
m2)
                (ImportSpecList () -> Maybe (ImportSpecList ())
forall a. a -> Maybe a
Just (() -> Bool -> [ImportSpec ()] -> ImportSpecList ()
forall l. l -> Bool -> [ImportSpec l] -> ImportSpecList l
ImportSpecList () Bool
False [ImportSpec ()
iabs1]))
      ans2 :: ImportDecl ()
ans2 = ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () ModuleName ()
m1 Bool
True Bool
fromSource Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just ModuleName ()
m3)
                (ImportSpecList () -> Maybe (ImportSpecList ())
forall a. a -> Maybe a
Just (() -> Bool -> [ImportSpec ()] -> ImportSpecList ()
forall l. l -> Bool -> [ImportSpec l] -> ImportSpecList l
ImportSpecList () Bool
False (ImportSpec ()
ithallImportSpec () -> [ImportSpec ()] -> [ImportSpec ()]
forall a. a -> [a] -> [a]
:[ImportSpec ()]
iabsget)))
  in  if ModuleName ()
m1 ModuleName () -> ModuleName () -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName ()
selfMod Bool -> Bool -> Bool
&& Part
part Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
/= Part
KeyFile
        then Maybe [ImportDecl ()]
forall a. Maybe a
Nothing
        else [ImportDecl ()] -> Maybe [ImportDecl ()]
forall a. a -> Maybe a
Just [ImportDecl ()
ans1,ImportDecl ()
ans2]

-- Several items might be taken from the same module, combine these statements
mergeImports :: [ImportDecl ()] -> [ImportDecl ()]
mergeImports :: [ImportDecl ()] -> [ImportDecl ()]
mergeImports [ImportDecl ()]
importsIn =
  let idKey :: ImportDecl l
-> (ModuleName l, Bool, Bool, Maybe (ModuleName l),
    Maybe [ImportSpec l])
idKey ImportDecl{l
Bool
Maybe String
Maybe (ModuleName l)
Maybe (ImportSpecList l)
ModuleName l
importAnn :: forall l. ImportDecl l -> l
importModule :: forall l. ImportDecl l -> ModuleName l
importQualified :: forall l. ImportDecl l -> Bool
importSrc :: forall l. ImportDecl l -> Bool
importSafe :: forall l. ImportDecl l -> Bool
importPkg :: forall l. ImportDecl l -> Maybe String
importAs :: forall l. ImportDecl l -> Maybe (ModuleName l)
importSpecs :: forall l. ImportDecl l -> Maybe (ImportSpecList l)
importSpecs :: Maybe (ImportSpecList l)
importAs :: Maybe (ModuleName l)
importPkg :: Maybe String
importSafe :: Bool
importSrc :: Bool
importQualified :: Bool
importModule :: ModuleName l
importAnn :: l
..} = (ModuleName l
importModule,Bool
importQualified,Bool
importSrc,Maybe (ModuleName l)
importAs,(ImportSpecList l -> [ImportSpec l])
-> Maybe (ImportSpecList l) -> Maybe [ImportSpec l]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ImportSpecList l
_ Bool
_ [ImportSpec l]
xs) -> [ImportSpec l]
xs) Maybe (ImportSpecList l)
importSpecs)
      mergeImports' :: ImportDecl () -> ImportDecl () -> ImportDecl ()
mergeImports' ImportDecl{importSpecs :: forall l. ImportDecl l -> Maybe (ImportSpecList l)
importSpecs=Just (ImportSpecList () Bool
hiding [ImportSpec ()]
xs), Bool
Maybe String
Maybe (ModuleName ())
()
ModuleName ()
importAs :: Maybe (ModuleName ())
importPkg :: Maybe String
importSafe :: Bool
importSrc :: Bool
importQualified :: Bool
importModule :: ModuleName ()
importAnn :: ()
importAnn :: forall l. ImportDecl l -> l
importModule :: forall l. ImportDecl l -> ModuleName l
importQualified :: forall l. ImportDecl l -> Bool
importSrc :: forall l. ImportDecl l -> Bool
importSafe :: forall l. ImportDecl l -> Bool
importPkg :: forall l. ImportDecl l -> Maybe String
importAs :: forall l. ImportDecl l -> Maybe (ModuleName l)
..} ImportDecl{importSpecs :: forall l. ImportDecl l -> Maybe (ImportSpecList l)
importSpecs=Just (ImportSpecList () Bool
_ [ImportSpec ()]
ys)} =
          ImportDecl :: forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl{importSpecs :: Maybe (ImportSpecList ())
importSpecs=ImportSpecList () -> Maybe (ImportSpecList ())
forall a. a -> Maybe a
Just (() -> Bool -> [ImportSpec ()] -> ImportSpecList ()
forall l. l -> Bool -> [ImportSpec l] -> ImportSpecList l
ImportSpecList () Bool
hiding ([ImportSpec ()]
xs [ImportSpec ()] -> [ImportSpec ()] -> [ImportSpec ()]
forall a. Eq a => [a] -> [a] -> [a]
`union` [ImportSpec ()]
ys)), Bool
Maybe String
Maybe (ModuleName ())
()
ModuleName ()
importAs :: Maybe (ModuleName ())
importPkg :: Maybe String
importSafe :: Bool
importSrc :: Bool
importQualified :: Bool
importModule :: ModuleName ()
importAnn :: ()
importAnn :: ()
importModule :: ModuleName ()
importQualified :: Bool
importSrc :: Bool
importSafe :: Bool
importPkg :: Maybe String
importAs :: Maybe (ModuleName ())
..}
      mergeImports' ImportDecl ()
i ImportDecl ()
_ = ImportDecl ()
i -- identical, so drop one
      combined :: Map
  (ModuleName (), Bool, Bool, Maybe (ModuleName ()),
   Maybe [ImportSpec ()])
  (ImportDecl ())
combined = (ImportDecl () -> ImportDecl () -> ImportDecl ())
-> [((ModuleName (), Bool, Bool, Maybe (ModuleName ()),
      Maybe [ImportSpec ()]),
     ImportDecl ())]
-> Map
     (ModuleName (), Bool, Bool, Maybe (ModuleName ()),
      Maybe [ImportSpec ()])
     (ImportDecl ())
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith ImportDecl () -> ImportDecl () -> ImportDecl ()
mergeImports' ([((ModuleName (), Bool, Bool, Maybe (ModuleName ()),
    Maybe [ImportSpec ()]),
   ImportDecl ())]
 -> Map
      (ModuleName (), Bool, Bool, Maybe (ModuleName ()),
       Maybe [ImportSpec ()])
      (ImportDecl ()))
-> ([ImportDecl ()]
    -> [((ModuleName (), Bool, Bool, Maybe (ModuleName ()),
          Maybe [ImportSpec ()]),
         ImportDecl ())])
-> [ImportDecl ()]
-> Map
     (ModuleName (), Bool, Bool, Maybe (ModuleName ()),
      Maybe [ImportSpec ()])
     (ImportDecl ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImportDecl ()
 -> ((ModuleName (), Bool, Bool, Maybe (ModuleName ()),
      Maybe [ImportSpec ()]),
     ImportDecl ()))
-> [ImportDecl ()]
-> [((ModuleName (), Bool, Bool, Maybe (ModuleName ()),
      Maybe [ImportSpec ()]),
     ImportDecl ())]
forall a b. (a -> b) -> [a] -> [b]
map (\ ImportDecl ()
i -> (ImportDecl ()
-> (ModuleName (), Bool, Bool, Maybe (ModuleName ()),
    Maybe [ImportSpec ()])
forall l.
ImportDecl l
-> (ModuleName l, Bool, Bool, Maybe (ModuleName l),
    Maybe [ImportSpec l])
idKey ImportDecl ()
i,ImportDecl ()
i)) ([ImportDecl ()]
 -> Map
      (ModuleName (), Bool, Bool, Maybe (ModuleName ()),
       Maybe [ImportSpec ()])
      (ImportDecl ()))
-> [ImportDecl ()]
-> Map
     (ModuleName (), Bool, Bool, Maybe (ModuleName ()),
      Maybe [ImportSpec ()])
     (ImportDecl ())
forall a b. (a -> b) -> a -> b
$ [ImportDecl ()]
importsIn
  in Map
  (ModuleName (), Bool, Bool, Maybe (ModuleName ()),
   Maybe [ImportSpec ()])
  (ImportDecl ())
-> [ImportDecl ()]
forall k a. Map k a -> [a]
M.elems Map
  (ModuleName (), Bool, Bool, Maybe (ModuleName ()),
   Maybe [ImportSpec ()])
  (ImportDecl ())
combined

keyFile :: ModuleName () -> ModuleName ()
keyFile :: ModuleName () -> ModuleName ()
keyFile (ModuleName () String
s) = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () (String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'Key")

joinMod :: [MName String] -> String
joinMod :: [MName String] -> String
joinMod [] = String
""
joinMod [MName String]
ms = MKey -> String
forall a. FMName a -> a
fmName (MKey -> String) -> MKey -> String
forall a b. (a -> b) -> a -> b
$ (MKey -> MKey -> MKey) -> [MKey] -> MKey
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 MKey -> MKey -> MKey
forall a. Dotted a => FMName a -> FMName a -> FMName a
dotFM ([MKey] -> MKey)
-> ([MName String] -> [MKey]) -> [MName String] -> MKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MName String -> MKey) -> [MName String] -> [MKey]
forall a b. (a -> b) -> [a] -> [b]
map MName String -> MKey
forall a. Dotted a => MName a -> FMName a
promoteFM ([MName String] -> MKey) -> [MName String] -> MKey
forall a b. (a -> b) -> a -> b
$ [MName String]
ms

baseIdent :: ProtoName -> Name ()
baseIdent :: ProtoName -> Name ()
baseIdent = () -> String -> Name ()
forall l. l -> String -> Name l
Ident () (String -> Name ())
-> (ProtoName -> String) -> ProtoName -> Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MName String -> String
forall a. MName a -> a
mName (MName String -> String)
-> (ProtoName -> MName String) -> ProtoName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoName -> MName String
baseName
baseIdent' :: ProtoFName -> Name ()
baseIdent' :: ProtoFName -> Name ()
baseIdent' ProtoFName
pfn = () -> String -> Name ()
forall l. l -> String -> Name l
Ident () (String -> Name ()) -> String -> Name ()
forall a b. (a -> b) -> a -> b
$ ProtoFName -> String
baseNamePrefix' ProtoFName
pfn String -> String -> String
forall a. [a] -> [a] -> [a]
++ FName String -> String
forall a. FName a -> a
fName (ProtoFName -> FName String
baseName' ProtoFName
pfn)

fieldIdent :: DescriptorInfo -> String -> Name ()
fieldIdent :: DescriptorInfo -> String -> Name ()
fieldIdent DescriptorInfo
di String
str | DescriptorInfo -> Bool
makeLenses DescriptorInfo
di = () -> String -> Name ()
forall l. l -> String -> Name l
Ident () (Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:String
str)
                  | Bool
otherwise = () -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
str

qualName :: ProtoName -> QName ()
qualName :: ProtoName -> QName ()
qualName p :: ProtoName
p@(ProtoName FIName Utf8
_ [MName String]
_prefix [] MName String
_base) = () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (ProtoName -> Name ()
baseIdent ProtoName
p)
qualName p :: ProtoName
p@(ProtoName FIName Utf8
_ [MName String]
_prefix ([MName String]
parents) MName String
_base) = () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () ([MName String] -> String
joinMod [MName String]
parents)) (ProtoName -> Name ()
baseIdent ProtoName
p)

qualFName :: ProtoFName -> QName ()
qualFName :: ProtoFName -> QName ()
qualFName p :: ProtoFName
p@(ProtoFName FIName Utf8
_ [MName String]
_prefix [] FName String
_base String
_basePrefix) = () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (ProtoFName -> Name ()
baseIdent' ProtoFName
p)
qualFName p :: ProtoFName
p@(ProtoFName FIName Utf8
_ [MName String]
_prefix [MName String]
parents FName String
_base String
_basePrefix) = () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () ([MName String] -> String
joinMod [MName String]
parents)) (ProtoFName -> Name ()
baseIdent' ProtoFName
p)

unqualName :: ProtoName -> QName ()
unqualName :: ProtoName -> QName ()
unqualName ProtoName
p = () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (ProtoName -> Name ()
baseIdent ProtoName
p)

unqualFName :: ProtoFName -> QName ()
unqualFName :: ProtoFName -> QName ()
unqualFName ProtoFName
p = () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (ProtoFName -> Name ()
baseIdent' ProtoFName
p)

mayQualName :: ProtoName -> ProtoFName -> QName ()
mayQualName :: ProtoName -> ProtoFName -> QName ()
mayQualName (ProtoName FIName Utf8
_ [MName String]
c'prefix [MName String]
c'parents MName String
c'base) name :: ProtoFName
name@(ProtoFName FIName Utf8
_ [MName String]
prefix [MName String]
parents FName String
_base String
_basePrefix) =
  if [MName String] -> String
joinMod ([MName String]
c'prefix[MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++[MName String]
c'parents[MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++[MName String
c'base]) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [MName String] -> String
joinMod ([MName String]
prefix[MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++[MName String]
parents)
    then () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (ProtoFName -> Name ()
baseIdent' ProtoFName
name) -- name is local, make UnQual
    else ProtoFName -> QName ()
qualFName ProtoFName
name           -- name is imported, make Qual


--------------------------------------------
-- utility for OneofInfo
--------------------------------------------

oneofCon :: (ProtoName,FieldInfo) -> Exp ()
oneofCon :: (ProtoName, FieldInfo) -> Exp ()
oneofCon (ProtoName
name,FieldInfo
_) = () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Con () (ProtoName -> QName ()
qualName ProtoName
name)

oneofPat :: (ProtoName,FieldInfo) -> (Pat (),Pat ())
oneofPat :: (ProtoName, FieldInfo) -> (Pat (), Pat ())
oneofPat (ProtoName
name,FieldInfo
fi) =
  let fName :: Name ()
fName@(Ident () String
_fname) = ProtoFName -> Name ()
baseIdent' (FieldInfo -> ProtoFName
fieldName FieldInfo
fi)
  in (() -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () (ProtoName -> QName ()
qualName ProtoName
name) [() -> Name () -> Pat ()
forall l. l -> Name l -> Pat l
PVar () Name ()
fName],() -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () (ProtoName -> QName ()
unqualName ProtoName
name) [() -> Name () -> Pat ()
forall l. l -> Name l -> Pat l
PVar () Name ()
fName])

oneofRec :: (ProtoName,FieldInfo) -> (Exp (),Exp ())
oneofRec :: (ProtoName, FieldInfo) -> (Exp (), Exp ())
oneofRec (ProtoName
_,FieldInfo
fi) =
  let (Ident () String
fname) = ProtoFName -> Name ()
baseIdent' (FieldInfo -> ProtoFName
fieldName FieldInfo
fi)
  in (String -> Exp ()
litStr String
fname,String -> Exp ()
lvar String
fname)

oneofGet :: (ProtoName,FieldInfo) -> (String,ProtoName)
oneofGet :: (ProtoName, FieldInfo) -> (String, ProtoName)
oneofGet (ProtoName
p,FieldInfo
fi) =
  let Ident () String
fname = ProtoFName -> Name ()
baseIdent' (FieldInfo -> ProtoFName
fieldName FieldInfo
fi)
      unqual :: String
unqual = String
"get'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fname
      p' :: ProtoName
p' = ProtoName
p { baseName :: MName String
baseName = String -> MName String
forall a. a -> MName a
MName String
unqual }
  in (String
unqual,ProtoName
p')

--------------------------------------------
-- Define LANGUAGE options as [ModulePramga]
--------------------------------------------
modulePragmas :: Bool -> [ModulePragma ()]
modulePragmas :: Bool -> [ModulePragma ()]
modulePragmas Bool
templateHaskell =
  [ () -> [Name ()] -> ModulePragma ()
forall l. l -> [Name l] -> ModulePragma l
LanguagePragma () ((String -> Name ()) -> [String] -> [Name ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> String -> Name ()
forall l. l -> String -> Name l
Ident ()) ([String] -> [Name ()]) -> [String] -> [Name ()]
forall a b. (a -> b) -> a -> b
$
      [String]
thPragma [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"BangPatterns",String
"DeriveDataTypeable",String
"DeriveGeneric",String
"FlexibleInstances",String
"MultiParamTypeClasses",String
"OverloadedStrings"]
    )
  , () -> Maybe Tool -> String -> ModulePragma ()
forall l. l -> Maybe Tool -> String -> ModulePragma l
OptionsPragma () (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
GHC) String
" -w "
  ]
  where thPragma :: [String]
thPragma | Bool
templateHaskell = [String
"TemplateHaskell"]
                 | Bool
otherwise       = []

--------------------------------------------
-- OneofDescriptorProto module creation
--------------------------------------------
oneofModule :: Result -> OneofInfo -> Module ()
oneofModule :: Result -> OneofInfo -> Module ()
oneofModule Result
result OneofInfo
oi
  = ()
-> Maybe (ModuleHead ())
-> [ModulePragma ()]
-> [ImportDecl ()]
-> [Decl ()]
-> Module ()
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
Module () (ModuleHead () -> Maybe (ModuleHead ())
forall a. a -> Maybe a
Just (()
-> ModuleName ()
-> Maybe (WarningText ())
-> Maybe (ExportSpecList ())
-> ModuleHead ()
forall l.
l
-> ModuleName l
-> Maybe (WarningText l)
-> Maybe (ExportSpecList l)
-> ModuleHead l
ModuleHead () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () (ProtoName -> String
fqMod ProtoName
protoName)) Maybe (WarningText ())
forall a. Maybe a
Nothing Maybe (ExportSpecList ())
forall a. Maybe a
Nothing)) (Bool -> [ModulePragma ()]
modulePragmas (Bool -> [ModulePragma ()]) -> Bool -> [ModulePragma ()]
forall a b. (a -> b) -> a -> b
$ OneofInfo -> Bool
oneofMakeLenses OneofInfo
oi)
         [ImportDecl ()]
imports (OneofInfo -> [Decl ()]
oneofDecls OneofInfo
oi)
  where protoName :: ProtoName
protoName = OneofInfo -> ProtoName
oneofName OneofInfo
oi
        typs :: [ProtoName]
typs = (FieldInfo -> Maybe ProtoName) -> [FieldInfo] -> [ProtoName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FieldInfo -> Maybe ProtoName
typeName ([FieldInfo] -> [ProtoName])
-> (OneofInfo -> [FieldInfo]) -> OneofInfo -> [ProtoName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq FieldInfo -> [FieldInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq FieldInfo -> [FieldInfo])
-> (OneofInfo -> Seq FieldInfo) -> OneofInfo -> [FieldInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ProtoName, FieldInfo) -> FieldInfo)
-> Seq (ProtoName, FieldInfo) -> Seq FieldInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProtoName, FieldInfo) -> FieldInfo
forall a b. (a, b) -> b
snd (Seq (ProtoName, FieldInfo) -> Seq FieldInfo)
-> (OneofInfo -> Seq (ProtoName, FieldInfo))
-> OneofInfo
-> Seq FieldInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofInfo -> Seq (ProtoName, FieldInfo)
oneofFields (OneofInfo -> [ProtoName]) -> OneofInfo -> [ProtoName]
forall a b. (a -> b) -> a -> b
$ OneofInfo
oi
        imports :: [ImportDecl ()]
imports = (Bool -> Bool -> Bool -> [ImportDecl ()]
standardImports Bool
False Bool
False (OneofInfo -> Bool
oneofMakeLenses OneofInfo
oi))
                  [ImportDecl ()] -> [ImportDecl ()] -> [ImportDecl ()]
forall a. [a] -> [a] -> [a]
++ ([ImportDecl ()] -> [ImportDecl ()]
mergeImports ((ProtoName -> Maybe (ImportDecl ()))
-> [ProtoName] -> [ImportDecl ()]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Result
-> ModuleName () -> Part -> ProtoName -> Maybe (ImportDecl ())
importPN Result
result (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () (ProtoName -> String
fqMod ProtoName
protoName)) Part
Normal) [ProtoName]
typs))


oneofDecls :: OneofInfo -> [Decl ()]
oneofDecls :: OneofInfo -> [Decl ()]
oneofDecls OneofInfo
oi = (OneofInfo -> Decl ()
oneofX OneofInfo
oi Decl () -> [Decl ()] -> [Decl ()]
forall a. a -> [a] -> [a]
: OneofInfo -> [Decl ()]
oneofFuncs OneofInfo
oi) [Decl ()] -> [Decl ()] -> [Decl ()]
forall a. [a] -> [a] -> [a]
++ [Decl ()]
lenses [Decl ()] -> [Decl ()] -> [Decl ()]
forall a. [a] -> [a] -> [a]
++ [Decl ()]
instances
  where
    mkPrisms :: Exp ()
mkPrisms = () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (() -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Control.Lens.TH") (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"makePrisms"))
    lenses :: [Decl ()]
lenses | OneofInfo -> Bool
oneofMakeLenses OneofInfo
oi = [() -> Exp () -> Decl ()
forall l. l -> Exp l -> Decl l
SpliceDecl () (Exp ()
mkFun Exp () -> Exp () -> Exp ()
$$ () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
TypQuote () (ProtoName -> QName ()
unqualName (OneofInfo -> ProtoName
oneofName OneofInfo
oi))) |
                                   Exp ()
mkFun <- [Exp ()
mkLenses, Exp ()
mkPrisms]]
           | Bool
otherwise = []
    instances :: [Decl ()]
instances = [ OneofInfo -> Decl ()
instanceDefaultOneof OneofInfo
oi
                , OneofInfo -> Decl ()
instanceMergeableOneof OneofInfo
oi
                ]

oneofX :: OneofInfo -> Decl ()
oneofX :: OneofInfo -> Decl ()
oneofX OneofInfo
oi = ()
-> DataOrNew ()
-> Maybe (Context ())
-> DeclHead ()
-> [QualConDecl ()]
-> [Deriving ()]
-> Decl ()
forall l.
l
-> DataOrNew l
-> Maybe (Context l)
-> DeclHead l
-> [QualConDecl l]
-> [Deriving l]
-> Decl l
DataDecl () (() -> DataOrNew ()
forall l. l -> DataOrNew l
DataType ()) Maybe (Context ())
forall a. Maybe a
Nothing (() -> Name () -> DeclHead ()
forall l. l -> Name l -> DeclHead l
DHead () (ProtoName -> Name ()
baseIdent (OneofInfo -> ProtoName
oneofName OneofInfo
oi)))
              (((ProtoName, FieldInfo) -> QualConDecl ())
-> [(ProtoName, FieldInfo)] -> [QualConDecl ()]
forall a b. (a -> b) -> [a] -> [b]
map (ProtoName, FieldInfo) -> QualConDecl ()
oneofValueX (Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (OneofInfo -> Seq (ProtoName, FieldInfo)
oneofFields OneofInfo
oi) ))
              (Deriving () -> [Deriving ()]
forall (m :: * -> *) a. Monad m => a -> m a
return Deriving ()
derives)
  where oneofValueX :: (ProtoName, FieldInfo) -> QualConDecl ()
oneofValueX (ProtoName
pname,FieldInfo
fi) = ()
-> Maybe [TyVarBind ()]
-> Maybe (Context ())
-> ConDecl ()
-> QualConDecl ()
forall l.
l
-> Maybe [TyVarBind l]
-> Maybe (Context l)
-> ConDecl l
-> QualConDecl l
QualConDecl () Maybe [TyVarBind ()]
forall a. Maybe a
Nothing Maybe (Context ())
forall a. Maybe a
Nothing ConDecl ()
con
          where con :: ConDecl ()
con = () -> Name () -> [FieldDecl ()] -> ConDecl ()
forall l. l -> Name l -> [FieldDecl l] -> ConDecl l
RecDecl () (ProtoName -> Name ()
baseIdent ProtoName
pname) [FieldDecl ()
fieldX]
                fieldX :: FieldDecl ()
fieldX = () -> [Name ()] -> Type () -> FieldDecl ()
forall l. l -> [Name l] -> Type l -> FieldDecl l
FieldDecl () [ProtoFName -> Name ()
baseIdent' (ProtoFName -> Name ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName (FieldInfo -> Name ()) -> FieldInfo -> Name ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
fi] (() -> Type () -> Type ()
forall l. l -> Type l -> Type l
TyParen () (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () QName ()
typed ))
                typed :: QName ()
typed = case Int -> Maybe String
useType (FieldType -> Int
getFieldType (FieldInfo -> FieldType
typeCode FieldInfo
fi)) of
                          Just String
s -> String -> QName ()
private String
s
                          Maybe String
Nothing -> case FieldInfo -> Maybe ProtoName
typeName FieldInfo
fi of
                                       Just ProtoName
s -> ProtoName -> QName ()
qualName ProtoName
s
                                       Maybe ProtoName
Nothing -> String -> QName ()
forall a. String -> a
imp (String -> QName ()) -> String -> QName ()
forall a b. (a -> b) -> a -> b
$ String
"No Name for Field!\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FieldInfo -> String
forall a. Show a => a -> String
show FieldInfo
fi

oneofFuncs :: OneofInfo -> [Decl ()]
oneofFuncs :: OneofInfo -> [Decl ()]
oneofFuncs OneofInfo
oi = ((ProtoName, FieldInfo) -> Decl ())
-> [(ProtoName, FieldInfo)] -> [Decl ()]
forall a b. (a -> b) -> [a] -> [b]
map (ProtoName, FieldInfo) -> Decl ()
mkfuns (Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (OneofInfo -> Seq (ProtoName, FieldInfo)
oneofFields OneofInfo
oi))
  where mkfuns :: (ProtoName, FieldInfo) -> Decl ()
mkfuns (ProtoName, FieldInfo)
f = String -> [Pat ()] -> Exp () -> Decl ()
defun ((String, ProtoName) -> String
forall a b. (a, b) -> a
fst ((ProtoName, FieldInfo) -> (String, ProtoName)
oneofGet (ProtoName, FieldInfo)
f)) [String -> Pat ()
patvar String
"x"] (Exp () -> Decl ()) -> Exp () -> Decl ()
forall a b. (a -> b) -> a -> b
$
                     () -> Exp () -> [Alt ()] -> Exp ()
forall l. l -> Exp l -> [Alt l] -> Exp l
Case () (String -> Exp ()
lvar String
"x")
                       [ () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () ((Pat (), Pat ()) -> Pat ()
forall a b. (a, b) -> b
snd ((ProtoName, FieldInfo) -> (Pat (), Pat ())
oneofPat (ProtoName, FieldInfo)
f))
                         (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (String -> Exp ()
preludecon String
"Just" Exp () -> Exp () -> Exp ()
$$ (Exp (), Exp ()) -> Exp ()
forall a b. (a, b) -> b
snd ((ProtoName, FieldInfo) -> (Exp (), Exp ())
oneofRec (ProtoName, FieldInfo)
f))) Maybe (Binds ())
noWhere
                       , () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (() -> Pat ()
forall l. l -> Pat l
PWildCard ())
                         (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (String -> Exp ()
preludecon String
"Nothing")) Maybe (Binds ())
noWhere
                       ]



{- oneof field does not have to have a default value, but for convenience
   (to make all messages an instance of Default and Mergeable), we make
   the first case as default like enum. -}

instanceDefaultOneof :: OneofInfo -> Decl ()
instanceDefaultOneof :: OneofInfo -> Decl ()
instanceDefaultOneof OneofInfo
oi
    =  ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"Default") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (OneofInfo -> ProtoName
oneofName OneofInfo
oi))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
      [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"defaultValue" [] Exp ()
firstValue ]
  where firstValue :: Exp ()
        firstValue :: Exp ()
firstValue = case Seq (ProtoName, FieldInfo) -> ViewL (ProtoName, FieldInfo)
forall a. Seq a -> ViewL a
Seq.viewl (OneofInfo -> Seq (ProtoName, FieldInfo)
oneofFields OneofInfo
oi) of
                       ViewL (ProtoName, FieldInfo)
EmptyL -> String -> Exp ()
forall a. String -> a
imp (String
"instanceDefaultOneof: empty in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ OneofInfo -> String
forall a. Show a => a -> String
show OneofInfo
oi)
                       (ProtoName
n,FieldInfo
_) :< Seq (ProtoName, FieldInfo)
_ -> case (ProtoName -> Name ()
baseIdent ProtoName
n) of
                                       Ident () String
str -> () -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
App () (String -> Exp ()
lcon String
str) (String -> Exp ()
pvar String
"defaultValue")
                                       Symbol () String
_ -> String -> Exp ()
forall a. String -> a
imp (String
"instanceDefaultOneof: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ProtoName -> String
forall a. Show a => a -> String
show ProtoName
n)

instanceMergeableOneof :: OneofInfo -> Decl ()
instanceMergeableOneof :: OneofInfo -> Decl ()
instanceMergeableOneof OneofInfo
oi
  = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"Mergeable") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (OneofInfo -> ProtoName
oneofName OneofInfo
oi))]) Maybe [InstDecl ()]
forall a. Maybe a
Nothing


--------------------------------------------
-- EnumDescriptorProto module creation
--------------------------------------------
enumModule :: EnumInfo -> Module ()
enumModule :: EnumInfo -> Module ()
enumModule EnumInfo
ei
    = let protoName :: ProtoName
protoName = EnumInfo -> ProtoName
enumName EnumInfo
ei
          exportList :: Maybe (ExportSpecList ())
exportList =
              (ExportSpecList () -> Maybe (ExportSpecList ())
forall a. a -> Maybe a
Just (() -> [ExportSpec ()] -> ExportSpecList ()
forall l. l -> [ExportSpec l] -> ExportSpecList l
ExportSpecList () [() -> EWildcard () -> QName () -> [CName ()] -> ExportSpec ()
forall l. l -> EWildcard l -> QName l -> [CName l] -> ExportSpec l
EThingWith () (() -> Int -> EWildcard ()
forall l. l -> Int -> EWildcard l
EWildcard () Int
0) (ProtoName -> QName ()
unqualName ProtoName
protoName) []]))
      in ()
-> Maybe (ModuleHead ())
-> [ModulePragma ()]
-> [ImportDecl ()]
-> [Decl ()]
-> Module ()
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
Module () (ModuleHead () -> Maybe (ModuleHead ())
forall a. a -> Maybe a
Just (()
-> ModuleName ()
-> Maybe (WarningText ())
-> Maybe (ExportSpecList ())
-> ModuleHead ()
forall l.
l
-> ModuleName l
-> Maybe (WarningText l)
-> Maybe (ExportSpecList l)
-> ModuleHead l
ModuleHead () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () (ProtoName -> String
fqMod ProtoName
protoName)) Maybe (WarningText ())
forall a. Maybe a
Nothing Maybe (ExportSpecList ())
exportList)) (Bool -> [ModulePragma ()]
modulePragmas Bool
False)
           (Bool -> Bool -> Bool -> [ImportDecl ()]
standardImports Bool
True Bool
False Bool
False) (EnumInfo -> [Decl ()]
enumDecls EnumInfo
ei)

enumDecls :: EnumInfo -> [Decl ()]
enumDecls :: EnumInfo -> [Decl ()]
enumDecls EnumInfo
ei = ((EnumInfo -> Decl ()) -> Decl ())
-> [EnumInfo -> Decl ()] -> [Decl ()]
forall a b. (a -> b) -> [a] -> [b]
map ((EnumInfo -> Decl ()) -> EnumInfo -> Decl ()
forall a b. (a -> b) -> a -> b
$ EnumInfo
ei) [ EnumInfo -> Decl ()
enumX
                           , EnumInfo -> Decl ()
instanceMergeableEnum
                           , EnumInfo -> Decl ()
instanceBounded
                           , EnumInfo -> Decl ()
instanceDefaultEnum ]
                [Decl ()] -> [Decl ()] -> [Decl ()]
forall a. [a] -> [a] -> [a]
++ EnumInfo -> [Decl ()]
declToEnum EnumInfo
ei [Decl ()] -> [Decl ()] -> [Decl ()]
forall a. [a] -> [a] -> [a]
++
                ((EnumInfo -> Decl ()) -> Decl ())
-> [EnumInfo -> Decl ()] -> [Decl ()]
forall a b. (a -> b) -> [a] -> [b]
map ((EnumInfo -> Decl ()) -> EnumInfo -> Decl ()
forall a b. (a -> b) -> a -> b
$ EnumInfo
ei) [ EnumInfo -> Decl ()
instanceEnum
                           , EnumInfo -> Decl ()
instanceWireEnum
                           , ProtoName -> Decl ()
instanceGPB (ProtoName -> Decl ())
-> (EnumInfo -> ProtoName) -> EnumInfo -> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumInfo -> ProtoName
enumName
                           , ProtoName -> Decl ()
instanceMessageAPI (ProtoName -> Decl ())
-> (EnumInfo -> ProtoName) -> EnumInfo -> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumInfo -> ProtoName
enumName
                           , EnumInfo -> Decl ()
instanceReflectEnum
                           , EnumInfo -> Decl ()
instanceTextTypeEnum
                           ] [Decl ()] -> [Decl ()] -> [Decl ()]
forall a. [a] -> [a] -> [a]
++
                (Decl () -> Bool) -> [Decl ()] -> [Decl ()]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Decl () -> Bool
forall a b. a -> b -> a
const (EnumInfo -> Bool
enumJsonInstances EnumInfo
ei))
                           [ EnumInfo -> Decl ()
instanceToJSONEnum EnumInfo
ei
                           , EnumInfo -> Decl ()
instanceFromJSONEnum EnumInfo
ei
                           ]

enumX :: EnumInfo -> Decl ()
enumX :: EnumInfo -> Decl ()
enumX EnumInfo
ei = ()
-> DataOrNew ()
-> Maybe (Context ())
-> DeclHead ()
-> [QualConDecl ()]
-> [Deriving ()]
-> Decl ()
forall l.
l
-> DataOrNew l
-> Maybe (Context l)
-> DeclHead l
-> [QualConDecl l]
-> [Deriving l]
-> Decl l
DataDecl () (() -> DataOrNew ()
forall l. l -> DataOrNew l
DataType ()) Maybe (Context ())
forall a. Maybe a
Nothing (() -> Name () -> DeclHead ()
forall l. l -> Name l -> DeclHead l
DHead () (ProtoName -> Name ()
baseIdent (EnumInfo -> ProtoName
enumName EnumInfo
ei))) (((EnumCode, String) -> QualConDecl ())
-> [(EnumCode, String)] -> [QualConDecl ()]
forall a b. (a -> b) -> [a] -> [b]
map (EnumCode, String) -> QualConDecl ()
forall a. (a, String) -> QualConDecl ()
enumValueX (EnumInfo -> [(EnumCode, String)]
enumValues EnumInfo
ei)) (Deriving () -> [Deriving ()]
forall (m :: * -> *) a. Monad m => a -> m a
return Deriving ()
derivesEnum)
  where enumValueX :: (a, String) -> QualConDecl ()
enumValueX (a
_,String
name) = ()
-> Maybe [TyVarBind ()]
-> Maybe (Context ())
-> ConDecl ()
-> QualConDecl ()
forall l.
l
-> Maybe [TyVarBind l]
-> Maybe (Context l)
-> ConDecl l
-> QualConDecl l
QualConDecl () Maybe [TyVarBind ()]
forall a. Maybe a
Nothing Maybe (Context ())
forall a. Maybe a
Nothing (() -> Name () -> [Type ()] -> ConDecl ()
forall l. l -> Name l -> [Type l] -> ConDecl l
ConDecl () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
name) [])

instanceToJSONEnum :: EnumInfo -> Decl ()
instanceToJSONEnum :: EnumInfo -> Decl ()
instanceToJSONEnum EnumInfo
ei
  = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"ToJSON") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (EnumInfo -> ProtoName
enumName EnumInfo
ei))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
      [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"toJSON" [String -> Pat ()
patvar String
"msg'"] (String -> Exp ()
pcon String
"String" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (() -> Exp () -> [Alt ()] -> Exp ()
forall l. l -> Exp l -> [Alt l] -> Exp l
Case () (String -> Exp ()
lvar String
"msg'") [Alt ()]
alts))
      ]
      where
        mkAlt :: String -> Alt ()
        mkAlt :: String -> Alt ()
mkAlt String
alt = () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (() -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () (() -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
alt)) []) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
litStr String
alt) Maybe (Binds ())
forall a. Maybe a
Nothing
        alts :: [Alt ()]
alts = ((EnumCode, String) -> Alt ()) -> [(EnumCode, String)] -> [Alt ()]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Alt ()
mkAlt (String -> Alt ())
-> ((EnumCode, String) -> String) -> (EnumCode, String) -> Alt ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumCode, String) -> String
forall a b. (a, b) -> b
snd) (EnumInfo -> [(EnumCode, String)]
enumValues EnumInfo
ei)

instanceFromJSONEnum :: EnumInfo -> Decl ()
instanceFromJSONEnum :: EnumInfo -> Decl ()
instanceFromJSONEnum EnumInfo
ei
  = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"FromJSON") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName ProtoName
name)]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
      [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"parseJSON" [] (String -> Exp ()
pvar String
"withText" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
litStr String
name' Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (() -> [Pat ()] -> Exp () -> Exp ()
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda () [String -> Pat ()
patvar String
"msg'"] Exp ()
body))
      ]
      where
        name :: ProtoName
name = EnumInfo -> ProtoName
enumName (EnumInfo -> ProtoName) -> EnumInfo -> ProtoName
forall a b. (a -> b) -> a -> b
$ EnumInfo
ei
        name' :: String
name' = [MName String] -> String
joinMod (ProtoName -> [MName String]
haskellPrefix ProtoName
name [MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++ ProtoName -> [MName String]
parentModule ProtoName
name [MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++ [ProtoName -> MName String
baseName ProtoName
name, ProtoName -> MName String
baseName ProtoName
name])
        body :: Exp ()
body = () -> Exp () -> [Alt ()] -> Exp ()
forall l. l -> Exp l -> [Alt l] -> Exp l
Case () (String -> Exp ()
lvar String
"msg'") [Alt ()]
alts
        mkAlt :: (a, String) -> Alt ()
mkAlt (a
_, String
alt) = () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (() -> Sign () -> Literal () -> Pat ()
forall l. l -> Sign l -> Literal l -> Pat l
PLit () (() -> Sign ()
forall l. l -> Sign l
Signless ()) (() -> String -> String -> Literal ()
forall l. l -> String -> String -> Literal l
String () String
alt String
alt)) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (String -> Exp ()
preludevar String
"return" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lcon String
alt)) Maybe (Binds ())
forall a. Maybe a
Nothing
        alts :: [Alt ()]
alts =
            ((EnumCode, String) -> Alt ()) -> [(EnumCode, String)] -> [Alt ()]
forall a b. (a -> b) -> [a] -> [b]
map (EnumCode, String) -> Alt ()
forall a. (a, String) -> Alt ()
mkAlt (EnumInfo -> [(EnumCode, String)]
enumValues EnumInfo
ei) [Alt ()] -> [Alt ()] -> [Alt ()]
forall a. [a] -> [a] -> [a]
++
            [ () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (() -> Pat ()
forall l. l -> Pat l
PWildCard ()) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
preludevar String
"fail" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
litStr String
"Invalid value " Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
preludevar String
"++" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
preludevar String
"show" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"msg'" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
preludevar String
"++" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
litStr (String
" for enum "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name'))) Maybe (Binds ())
forall a. Maybe a
Nothing ]

instanceTextTypeEnum :: EnumInfo -> Decl ()
instanceTextTypeEnum :: EnumInfo -> Decl ()
instanceTextTypeEnum EnumInfo
ei
  = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"TextType") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (EnumInfo -> ProtoName
enumName EnumInfo
ei))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
      [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"tellT" [] (String -> Exp ()
pvar String
"tellShow")
      , String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"getT" [] (String -> Exp ()
pvar String
"getRead")
      ]

instanceMergeableEnum :: EnumInfo -> Decl ()
instanceMergeableEnum :: EnumInfo -> Decl ()
instanceMergeableEnum EnumInfo
ei
  = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"Mergeable") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (EnumInfo -> ProtoName
enumName EnumInfo
ei))]) Maybe [InstDecl ()]
forall a. Maybe a
Nothing

instanceBounded :: EnumInfo -> Decl ()
instanceBounded :: EnumInfo -> Decl ()
instanceBounded EnumInfo
ei
    = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
prelude String
"Bounded") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (EnumInfo -> ProtoName
enumName EnumInfo
ei))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
         [String -> (EnumCode, String) -> InstDecl ()
forall a. String -> (a, String) -> InstDecl ()
set String
"minBound" ([(EnumCode, String)] -> (EnumCode, String)
forall a. [a] -> a
head [(EnumCode, String)]
values),String -> (EnumCode, String) -> InstDecl ()
forall a. String -> (a, String) -> InstDecl ()
set String
"maxBound" ([(EnumCode, String)] -> (EnumCode, String)
forall a. [a] -> a
last [(EnumCode, String)]
values)] -- values cannot be null in a well formed enum
  where values :: [(EnumCode, String)]
values = EnumInfo -> [(EnumCode, String)]
enumValues EnumInfo
ei
        set :: String -> (a, String) -> InstDecl ()
set String
f (a
_,String
n) = String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
f [] (String -> Exp ()
lcon String
n)

{- from google's descriptor.h, about line 346:

  // Get the field default value if cpp_type() == CPPTYPE_ENUM.  If no
  // explicit default was defined, the default is the first value defined
  // in the enum type (all enum types are required to have at least one value).
  // This never returns NULL.

-}
instanceDefaultEnum :: EnumInfo -> Decl ()
instanceDefaultEnum :: EnumInfo -> Decl ()
instanceDefaultEnum EnumInfo
ei
    = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"Default") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (EnumInfo -> ProtoName
enumName EnumInfo
ei))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
      [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"defaultValue" [] Exp ()
firstValue ]
  where firstValue :: Exp ()
        firstValue :: Exp ()
firstValue = case EnumInfo -> [(EnumCode, String)]
enumValues EnumInfo
ei of
                       (:) (EnumCode
_,String
n) [(EnumCode, String)]
_ -> String -> Exp ()
lcon String
n
                       [] -> String -> Exp ()
forall a. HasCallStack => String -> a
error (String -> Exp ()) -> String -> Exp ()
forall a b. (a -> b) -> a -> b
$ String
"Impossible? EnumDescriptorProto had empty sequence of EnumValueDescriptorProto.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ EnumInfo -> String
forall a. Show a => a -> String
show EnumInfo
ei

declToEnum :: EnumInfo -> [Decl ()]
declToEnum :: EnumInfo -> [Decl ()]
declToEnum EnumInfo
ei = [ () -> [Name ()] -> Type () -> Decl ()
forall l. l -> [Name l] -> Type l -> Decl l
TypeSig () [() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"toMaybe'Enum"]
                    (() -> Type () -> Type () -> Type ()
forall l. l -> Type l -> Type l -> Type l
TyFun () (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (String -> QName ()
prelude String
"Int"))
                           (String -> Type () -> Type ()
typeApp String
"Maybe" (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (EnumInfo -> ProtoName
enumName EnumInfo
ei)))))
                , () -> [Match ()] -> Decl ()
forall l. l -> [Match l] -> Decl l
FunBind () (((EnumCode, String) -> Match ())
-> [(EnumCode, String)] -> [Match ()]
forall a b. (a -> b) -> [a] -> [b]
map (EnumCode, String) -> Match ()
toEnum'one [(EnumCode, String)]
values [Match ()] -> [Match ()] -> [Match ()]
forall a. [a] -> [a] -> [a]
++ [Match ()
final]) ]
  where values :: [(EnumCode, String)]
values = EnumInfo -> [(EnumCode, String)]
enumValues EnumInfo
ei
        toEnum'one :: (EnumCode, String) -> Match ()
toEnum'one (EnumCode
v,String
n) = String -> [Pat ()] -> Exp () -> Match ()
match String
"toMaybe'Enum" [Int32 -> Pat ()
forall x. Integral x => x -> Pat ()
litIntP (EnumCode -> Int32
getEnumCode EnumCode
v)] (String -> Exp ()
preludecon String
"Just" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lcon String
n)
        final :: Match ()
final = String -> [Pat ()] -> Exp () -> Match ()
match String
"toMaybe'Enum" [() -> Pat ()
forall l. l -> Pat l
PWildCard ()] (String -> Exp ()
preludecon String
"Nothing")

instanceEnum :: EnumInfo -> Decl ()
instanceEnum :: EnumInfo -> Decl ()
instanceEnum EnumInfo
ei
    = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
prelude String
"Enum") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (EnumInfo -> ProtoName
enumName EnumInfo
ei))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
        (([Match ()] -> InstDecl ()) -> [[Match ()]] -> [InstDecl ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> Decl () -> InstDecl ()
forall l. l -> Decl l -> InstDecl l
InsDecl () (Decl () -> InstDecl ())
-> ([Match ()] -> Decl ()) -> [Match ()] -> InstDecl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> [Match ()] -> Decl ()
forall l. l -> [Match l] -> Decl l
FunBind ()) [[Match ()]
fromEnum',[Match ()]
toEnum',[Match ()]
succ',[Match ()]
pred'])
  where values :: [(EnumCode, String)]
values = EnumInfo -> [(EnumCode, String)]
enumValues EnumInfo
ei
        fromEnum' :: [Match ()]
fromEnum' = ((EnumCode, String) -> Match ())
-> [(EnumCode, String)] -> [Match ()]
forall a b. (a -> b) -> [a] -> [b]
map (EnumCode, String) -> Match ()
fromEnum'one [(EnumCode, String)]
values
        fromEnum'one :: (EnumCode, String) -> Match ()
fromEnum'one (EnumCode
v,String
n) = String -> [Pat ()] -> Exp () -> Match ()
match String
"fromEnum" [() -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () (String -> QName ()
local String
n) []] (Int32 -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (EnumCode -> Int32
getEnumCode EnumCode
v))
        toEnum' :: [Match ()]
toEnum' = [ String -> [Pat ()] -> Exp () -> Match ()
match String
"toEnum" [] (Exp () -> Exp () -> Exp ()
compose Exp ()
mayErr (String -> Exp ()
lvar String
"toMaybe'Enum")) ]
        mayErr :: Exp ()
mayErr = String -> Exp ()
pvar String
"fromMaybe" Exp () -> Exp () -> Exp ()
$$ (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
preludevar String
"error" Exp () -> Exp () -> Exp ()
$$  (String -> Exp ()
litStr (String -> Exp ()) -> String -> Exp ()
forall a b. (a -> b) -> a -> b
$
                   String
"hprotoc generated code: toEnum failure for type "String -> String -> String
forall a. [a] -> [a] -> [a]
++ ProtoName -> String
fqMod (EnumInfo -> ProtoName
enumName EnumInfo
ei))))
        succ' :: [Match ()]
succ' = ((EnumCode, String) -> (EnumCode, String) -> Match ())
-> [(EnumCode, String)] -> [(EnumCode, String)] -> [Match ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String -> (EnumCode, String) -> (EnumCode, String) -> Match ()
forall a a. String -> (a, String) -> (a, String) -> Match ()
equate String
"succ") [(EnumCode, String)]
values ([(EnumCode, String)] -> [(EnumCode, String)]
forall a. [a] -> [a]
tail [(EnumCode, String)]
values) [Match ()] -> [Match ()] -> [Match ()]
forall a. [a] -> [a] -> [a]
++
                [ String -> [Pat ()] -> Exp () -> Match ()
match String
"succ" [() -> Pat ()
forall l. l -> Pat l
PWildCard ()] (String -> Exp ()
preludevar String
"error" Exp () -> Exp () -> Exp ()
$$  (String -> Exp ()
litStr (String -> Exp ()) -> String -> Exp ()
forall a b. (a -> b) -> a -> b
$
                   String
"hprotoc generated code: succ failure for type "String -> String -> String
forall a. [a] -> [a] -> [a]
++ ProtoName -> String
fqMod (EnumInfo -> ProtoName
enumName EnumInfo
ei))) ]
        pred' :: [Match ()]
pred' = ((EnumCode, String) -> (EnumCode, String) -> Match ())
-> [(EnumCode, String)] -> [(EnumCode, String)] -> [Match ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String -> (EnumCode, String) -> (EnumCode, String) -> Match ()
forall a a. String -> (a, String) -> (a, String) -> Match ()
equate String
"pred") ([(EnumCode, String)] -> [(EnumCode, String)]
forall a. [a] -> [a]
tail [(EnumCode, String)]
values) [(EnumCode, String)]
values [Match ()] -> [Match ()] -> [Match ()]
forall a. [a] -> [a] -> [a]
++
                [ String -> [Pat ()] -> Exp () -> Match ()
match String
"pred" [() -> Pat ()
forall l. l -> Pat l
PWildCard ()] (String -> Exp ()
preludevar String
"error" Exp () -> Exp () -> Exp ()
$$  (String -> Exp ()
litStr (String -> Exp ()) -> String -> Exp ()
forall a b. (a -> b) -> a -> b
$
                   String
"hprotoc generated code: pred failure for type "String -> String -> String
forall a. [a] -> [a] -> [a]
++ ProtoName -> String
fqMod (EnumInfo -> ProtoName
enumName EnumInfo
ei))) ]
        equate :: String -> (a, String) -> (a, String) -> Match ()
equate String
f (a
_,String
n1) (a
_,String
n2) = String -> [Pat ()] -> Exp () -> Match ()
match String
f [() -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () (String -> QName ()
local String
n1) []] (String -> Exp ()
lcon String
n2)

-- fromEnum TYPE_ENUM == 14 :: Int
instanceWireEnum :: EnumInfo -> Decl ()
instanceWireEnum :: EnumInfo -> Decl ()
instanceWireEnum EnumInfo
ei
    = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"Wire") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (EnumInfo -> ProtoName
enumName EnumInfo
ei))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
        [ String -> InstDecl ()
withName String
"wireSize", String -> InstDecl ()
withName String
"wirePut", InstDecl ()
withGet, InstDecl ()
withGetErr,InstDecl ()
withGetPacked,InstDecl ()
withGetPackedErr ]
  where withName :: String -> InstDecl ()
withName String
foo = String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
foo [String -> Pat ()
patvar String
"ft'",String -> Pat ()
patvar String
"enum"] Exp ()
rhs
          where rhs :: Exp ()
rhs = String -> Exp ()
pvar String
foo Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"ft'" Exp () -> Exp () -> Exp ()
$$
                        (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
preludevar String
"fromEnum" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"enum")
        withGet :: InstDecl ()
withGet = String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"wireGet" [Int -> Pat ()
litIntP' Int
14] Exp ()
rhs
          where rhs :: Exp ()
rhs = String -> Exp ()
pvar String
"wireGetEnum" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"toMaybe'Enum"
        withGetErr :: InstDecl ()
withGetErr = String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"wireGet" [String -> Pat ()
patvar String
"ft'"] Exp ()
rhs
          where rhs :: Exp ()
rhs = String -> Exp ()
pvar String
"wireGetErr" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"ft'"
        withGetPacked :: InstDecl ()
withGetPacked = String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"wireGetPacked" [Int -> Pat ()
litIntP' Int
14] Exp ()
rhs
          where rhs :: Exp ()
rhs = String -> Exp ()
pvar String
"wireGetPackedEnum" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"toMaybe'Enum"
        withGetPackedErr :: InstDecl ()
withGetPackedErr = String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"wireGetPacked" [String -> Pat ()
patvar String
"ft'"] Exp ()
rhs
          where rhs :: Exp ()
rhs = String -> Exp ()
pvar String
"wireGetErr" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"ft'"

instanceGPB :: ProtoName -> Decl ()
instanceGPB :: ProtoName -> Decl ()
instanceGPB ProtoName
protoName
    = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"GPB") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName ProtoName
protoName)]) Maybe [InstDecl ()]
forall a. Maybe a
Nothing

instanceReflectEnum :: EnumInfo -> Decl ()
instanceReflectEnum :: EnumInfo -> Decl ()
instanceReflectEnum EnumInfo
ei
    = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"ReflectEnum") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (EnumInfo -> ProtoName
enumName EnumInfo
ei))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
        [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"reflectEnum" [] Exp ()
ascList
        , String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"reflectEnumInfo" [ () -> Pat ()
forall l. l -> Pat l
PWildCard () ] Exp ()
ei' ]
  where (ProtoName FIName Utf8
xxx [MName String]
a [MName String]
b MName String
c) = EnumInfo -> ProtoName
enumName EnumInfo
ei
        xxx'Exp :: Exp ()
xxx'Exp = () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
pvar String
"pack" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
litStr (ByteString -> String
LC.unpack (Utf8 -> ByteString
utf8 (FIName Utf8 -> Utf8
forall a. FIName a -> a
fiName FIName Utf8
xxx)))
        values :: [(EnumCode, String)]
values = EnumInfo -> [(EnumCode, String)]
enumValues EnumInfo
ei
        ascList,ei',protoNameExp :: Exp ()
        ascList :: Exp ()
ascList = () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () (((EnumCode, String) -> Exp ()) -> [(EnumCode, String)] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (EnumCode, String) -> Exp ()
one [(EnumCode, String)]
values)
          where one :: (EnumCode, String) -> Exp ()
one (EnumCode
v,String
ns) = () -> Boxed -> [Exp ()] -> Exp ()
forall l. l -> Boxed -> [Exp l] -> Exp l
Tuple () Boxed
Boxed [Int32 -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (EnumCode -> Int32
getEnumCode EnumCode
v),String -> Exp ()
litStr String
ns,String -> Exp ()
lcon String
ns]
        ei' :: Exp ()
ei' = (Exp () -> Exp () -> Exp ()) -> Exp () -> [Exp ()] -> Exp ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (() -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
App ()) (String -> Exp ()
pcon String
"EnumInfo") [Exp ()
protoNameExp
                                             ,() -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () ([Exp ()] -> Exp ()) -> [Exp ()] -> Exp ()
forall a b. (a -> b) -> a -> b
$ (String -> Exp ()) -> [String] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Exp ()
litStr (EnumInfo -> [String]
enumFilePath EnumInfo
ei)
                                             ,() -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () (((EnumCode, String) -> Exp ()) -> [(EnumCode, String)] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (EnumCode, String) -> Exp ()
two [(EnumCode, String)]
values)
                                             ,String -> Exp ()
preludecon (Bool -> String
forall a. Show a => a -> String
show (EnumInfo -> Bool
enumJsonInstances EnumInfo
ei))
                                             ]
          where two :: (EnumCode, String) -> Exp ()
two (EnumCode
v,String
ns) = () -> Boxed -> [Exp ()] -> Exp ()
forall l. l -> Boxed -> [Exp l] -> Exp l
Tuple () Boxed
Boxed [Int32 -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (EnumCode -> Int32
getEnumCode EnumCode
v),String -> Exp ()
litStr String
ns]
        protoNameExp :: Exp ()
protoNameExp = () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ (Exp () -> Exp () -> Exp ()) -> Exp () -> [Exp ()] -> Exp ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (() -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
App ()) (String -> Exp ()
pvar String
"makePNF")
                                        [ Exp ()
xxx'Exp, [MName String] -> Exp ()
mList [MName String]
a, [MName String] -> Exp ()
mList [MName String]
b, String -> Exp ()
litStr (MName String -> String
forall a. MName a -> a
mName MName String
c) ]
          where mList :: [MName String] -> Exp ()
mList = () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () ([Exp ()] -> Exp ())
-> ([MName String] -> [Exp ()]) -> [MName String] -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MName String -> Exp ()) -> [MName String] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Exp ()
litStr (String -> Exp ())
-> (MName String -> String) -> MName String -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MName String -> String
forall a. MName a -> a
mName)

hasExt :: DescriptorInfo -> Bool
hasExt :: DescriptorInfo -> Bool
hasExt DescriptorInfo
di = Bool -> Bool
not ([(FieldId, FieldId)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DescriptorInfo -> [(FieldId, FieldId)]
extRanges DescriptorInfo
di))

--------------------------------------------
-- FileDescriptorProto module creation
--------------------------------------------

protoModule :: Result -> ProtoInfo -> ByteString -> Module ()
protoModule :: Result -> ProtoInfo -> ByteString -> Module ()
protoModule Result
result ProtoInfo
pri ByteString
fdpBS
  = let protoName :: ProtoName
protoName = ProtoInfo -> ProtoName
protoMod ProtoInfo
pri
        ([ProtoName]
extendees,[FieldInfo]
myKeys) = [(ProtoName, FieldInfo)] -> ([ProtoName], [FieldInfo])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ProtoName, FieldInfo)] -> ([ProtoName], [FieldInfo]))
-> [(ProtoName, FieldInfo)] -> ([ProtoName], [FieldInfo])
forall a b. (a -> b) -> a -> b
$ Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (ProtoInfo -> Seq (ProtoName, FieldInfo)
extensionKeys ProtoInfo
pri)
        m :: ModuleName ()
m = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () (ProtoName -> String
fqMod ProtoName
protoName)
        exportKeys :: [ExportSpec ()]
exportKeys = (FieldInfo -> ExportSpec ()) -> [FieldInfo] -> [ExportSpec ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> QName () -> ExportSpec ()
forall l. l -> QName l -> ExportSpec l
EVar () (QName () -> ExportSpec ())
-> (FieldInfo -> QName ()) -> FieldInfo -> ExportSpec ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName) [FieldInfo]
myKeys
        exportNames :: [ExportSpec ()]
exportNames = (String -> ExportSpec ()) -> [String] -> [ExportSpec ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> QName () -> ExportSpec ()
forall l. l -> QName l -> ExportSpec l
EVar () (QName () -> ExportSpec ())
-> (String -> QName ()) -> String -> ExportSpec ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name () -> QName ()) -> (String -> Name ()) -> String -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> String -> Name ()
forall l. l -> String -> Name l
Ident ()) [String
"protoInfo",String
"fileDescriptorProto"]
        imports :: [ImportDecl ()]
imports = ([ImportDecl ()]
protoImports [ImportDecl ()] -> [ImportDecl ()] -> [ImportDecl ()]
forall a. [a] -> [a] -> [a]
++) ([ImportDecl ()] -> [ImportDecl ()])
-> ([ImportDecl ()] -> [ImportDecl ()])
-> [ImportDecl ()]
-> [ImportDecl ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImportDecl ()] -> [ImportDecl ()]
mergeImports ([ImportDecl ()] -> [ImportDecl ()])
-> [ImportDecl ()] -> [ImportDecl ()]
forall a b. (a -> b) -> a -> b
$
                    (ProtoName -> Maybe (ImportDecl ()))
-> [ProtoName] -> [ImportDecl ()]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Result
-> ModuleName () -> Part -> ProtoName -> Maybe (ImportDecl ())
importPN Result
result ModuleName ()
m Part
Normal) ([ProtoName] -> [ImportDecl ()]) -> [ProtoName] -> [ImportDecl ()]
forall a b. (a -> b) -> a -> b
$
                      [ProtoName]
extendees [ProtoName] -> [ProtoName] -> [ProtoName]
forall a. [a] -> [a] -> [a]
++ (FieldInfo -> Maybe ProtoName) -> [FieldInfo] -> [ProtoName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FieldInfo -> Maybe ProtoName
typeName [FieldInfo]
myKeys
    in ()
-> Maybe (ModuleHead ())
-> [ModulePragma ()]
-> [ImportDecl ()]
-> [Decl ()]
-> Module ()
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
Module () (ModuleHead () -> Maybe (ModuleHead ())
forall a. a -> Maybe a
Just (()
-> ModuleName ()
-> Maybe (WarningText ())
-> Maybe (ExportSpecList ())
-> ModuleHead ()
forall l.
l
-> ModuleName l
-> Maybe (WarningText l)
-> Maybe (ExportSpecList l)
-> ModuleHead l
ModuleHead () ModuleName ()
m Maybe (WarningText ())
forall a. Maybe a
Nothing (ExportSpecList () -> Maybe (ExportSpecList ())
forall a. a -> Maybe a
Just (() -> [ExportSpec ()] -> ExportSpecList ()
forall l. l -> [ExportSpec l] -> ExportSpecList l
ExportSpecList () ([ExportSpec ()]
exportKeys[ExportSpec ()] -> [ExportSpec ()] -> [ExportSpec ()]
forall a. [a] -> [a] -> [a]
++[ExportSpec ()]
exportNames))))) (Bool -> [ModulePragma ()]
modulePragmas Bool
False) [ImportDecl ()]
imports
         (ProtoName -> Seq (ProtoName, FieldInfo) -> [Decl ()]
keysXTypeVal ProtoName
protoName (ProtoInfo -> Seq (ProtoName, FieldInfo)
extensionKeys ProtoInfo
pri) [Decl ()] -> [Decl ()] -> [Decl ()]
forall a. [a] -> [a] -> [a]
++ ProtoInfo -> [Decl ()]
embed'ProtoInfo ProtoInfo
pri [Decl ()] -> [Decl ()] -> [Decl ()]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Decl ()]
embed'fdpBS ByteString
fdpBS)
 where protoImports :: [ImportDecl ()]
protoImports = Bool -> Bool -> Bool -> [ImportDecl ()]
standardImports Bool
False (Bool -> Bool
not (Bool -> Bool) -> (ProtoInfo -> Bool) -> ProtoInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (ProtoName, FieldInfo) -> Bool
forall a. Seq a -> Bool
Seq.null (Seq (ProtoName, FieldInfo) -> Bool)
-> (ProtoInfo -> Seq (ProtoName, FieldInfo)) -> ProtoInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoInfo -> Seq (ProtoName, FieldInfo)
extensionKeys (ProtoInfo -> Bool) -> ProtoInfo -> Bool
forall a b. (a -> b) -> a -> b
$ ProtoInfo
pri) Bool
False [ImportDecl ()] -> [ImportDecl ()] -> [ImportDecl ()]
forall a. [a] -> [a] -> [a]
++
         [ ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Text.DescriptorProtos.FileDescriptorProto") Bool
False Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing Maybe (ModuleName ())
forall a. Maybe a
Nothing
                        (ImportSpecList () -> Maybe (ImportSpecList ())
forall a. a -> Maybe a
Just (() -> Bool -> [ImportSpec ()] -> ImportSpecList ()
forall l. l -> Bool -> [ImportSpec l] -> ImportSpecList l
ImportSpecList () Bool
False [() -> Namespace () -> Name () -> ImportSpec ()
forall l. l -> Namespace l -> Name l -> ImportSpec l
IAbs () (() -> Namespace ()
forall l. l -> Namespace l
NoNamespace ()) (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"FileDescriptorProto")]))
         , ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Text.ProtocolBuffers.Reflections") Bool
False Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing Maybe (ModuleName ())
forall a. Maybe a
Nothing
                        (ImportSpecList () -> Maybe (ImportSpecList ())
forall a. a -> Maybe a
Just (() -> Bool -> [ImportSpec ()] -> ImportSpecList ()
forall l. l -> Bool -> [ImportSpec l] -> ImportSpecList l
ImportSpecList () Bool
False [() -> Namespace () -> Name () -> ImportSpec ()
forall l. l -> Namespace l -> Name l -> ImportSpec l
IAbs () (() -> Namespace ()
forall l. l -> Namespace l
NoNamespace ()) (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"ProtoInfo")]))
         , ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Text.ProtocolBuffers.WireMessage") Bool
True Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"P'"))
                        (ImportSpecList () -> Maybe (ImportSpecList ())
forall a. a -> Maybe a
Just (() -> Bool -> [ImportSpec ()] -> ImportSpecList ()
forall l. l -> Bool -> [ImportSpec l] -> ImportSpecList l
ImportSpecList () Bool
False [() -> Name () -> ImportSpec ()
forall l. l -> Name l -> ImportSpec l
IVar () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"wireGet,getFromBS")]))
         ]

embed'ProtoInfo :: ProtoInfo -> [Decl ()]
embed'ProtoInfo :: ProtoInfo -> [Decl ()]
embed'ProtoInfo ProtoInfo
pri = [ Decl ()
myType, Decl ()
myValue ]
  where myType :: Decl ()
myType = () -> [Name ()] -> Type () -> Decl ()
forall l. l -> [Name l] -> Type l -> Decl l
TypeSig () [ () -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"protoInfo" ] (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (String -> QName ()
local String
"ProtoInfo"))
        myValue :: Decl ()
myValue = () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Decl ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
PatBind () (() -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () (String -> QName ()
local String
"protoInfo") []) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$
                    String -> Exp ()
preludevar String
"read" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
litStr (ProtoInfo -> String
forall a. Show a => a -> String
show ProtoInfo
pri)) Maybe (Binds ())
noWhere

embed'fdpBS :: ByteString -> [Decl ()]
embed'fdpBS :: ByteString -> [Decl ()]
embed'fdpBS ByteString
bs = [ Decl ()
myType, Decl ()
myValue ]
  where myType :: Decl ()
myType = () -> [Name ()] -> Type () -> Decl ()
forall l. l -> [Name l] -> Type l -> Decl l
TypeSig () [ () -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"fileDescriptorProto" ] (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (String -> QName ()
local String
"FileDescriptorProto"))
        myValue :: Decl ()
myValue = () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Decl ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
PatBind () (() -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () (String -> QName ()
local String
"fileDescriptorProto") []) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$
                    String -> Exp ()
pvar String
"getFromBS" Exp () -> Exp () -> Exp ()
$$
                      () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
pvar String
"wireGet" Exp () -> Exp () -> Exp ()
$$ Int -> Exp ()
litInt' Int
11) Exp () -> Exp () -> Exp ()
$$
                      () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
pvar String
"pack" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
litStr (ByteString -> String
LC.unpack ByteString
bs))) Maybe (Binds ())
noWhere

--------------------------------------------
-- DescriptorProto module creation
--------------------------------------------
descriptorModules :: Result -> DescriptorInfo -> [(FilePath,Module ())]
descriptorModules :: Result -> DescriptorInfo -> [(String, Module ())]
descriptorModules Result
result DescriptorInfo
di
 = let mainPath :: String
mainPath = [String] -> String
joinPath (DescriptorInfo -> [String]
descFilePath DescriptorInfo
di)
       bootPath :: String
bootPath = [String] -> String
joinPath (DescriptorInfo -> [String]
descFilePath DescriptorInfo
di) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-boot"
       keyfilePath :: String
keyfilePath = Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
mainPath Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) String
mainPath String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'Key.hs"
   in (String
mainPath,Result -> DescriptorInfo -> Module ()
descriptorNormalModule Result
result DescriptorInfo
di) (String, Module ())
-> [(String, Module ())] -> [(String, Module ())]
forall a. a -> [a] -> [a]
:
      case Result -> MKey -> VertexKind
getKind Result
result (ProtoName -> MKey
pKey (DescriptorInfo -> ProtoName
descName DescriptorInfo
di)) of
        VertexKind
TopProtoInfo -> String -> [(String, Module ())]
forall a. String -> a
imp (String -> [(String, Module ())])
-> String -> [(String, Module ())]
forall a b. (a -> b) -> a -> b
$ String
"descriptorModules was given a TopProtoInfo kinded DescriptorInfo!"
        VertexKind
Simple -> []
        VertexKind
TypeBoot -> [(String
bootPath,DescriptorInfo -> Module ()
descriptorBootModule DescriptorInfo
di)]
        VertexKind
KeyTypeBoot -> [(String
bootPath,Result -> DescriptorInfo -> Module ()
descriptorKeyBootModule Result
result DescriptorInfo
di)]
        VertexKind
SplitKeyTypeBoot -> [(String
bootPath,DescriptorInfo -> Module ()
descriptorBootModule DescriptorInfo
di)
                           ,(String
keyfilePath,Result -> DescriptorInfo -> Module ()
descriptorKeyfileModule Result
result DescriptorInfo
di)]

-- This build a hs-boot that declares the type of the data type only
descriptorBootModule :: DescriptorInfo -> Module ()
descriptorBootModule :: DescriptorInfo -> Module ()
descriptorBootModule DescriptorInfo
di
  = let protoName :: ProtoName
protoName = DescriptorInfo -> ProtoName
descName DescriptorInfo
di
        un :: QName ()
un = ProtoName -> QName ()
unqualName ProtoName
protoName
        classes :: [QName ()]
classes = [String -> QName ()
prelude String
"Show",String -> QName ()
prelude String
"Eq",String -> QName ()
prelude String
"Ord",String -> QName ()
prelude String
"Data", String -> QName ()
prelude String
"Generic"
                  ,String -> QName ()
private String
"Mergeable",String -> QName ()
private String
"Default"
                  ,String -> QName ()
private String
"Wire",String -> QName ()
private String
"GPB",String -> QName ()
private String
"ReflectDescriptor"
                  ,String -> QName ()
private String
"TextType", String -> QName ()
private String
"TextMsg"
                  ]
                  [QName ()] -> [QName ()] -> [QName ()]
forall a. [a] -> [a] -> [a]
++ (if DescriptorInfo -> Bool
hasExt DescriptorInfo
di then [String -> QName ()
private String
"ExtendMessage"] else [])
                  [QName ()] -> [QName ()] -> [QName ()]
forall a. [a] -> [a] -> [a]
++ (if DescriptorInfo -> Bool
storeUnknown DescriptorInfo
di then [String -> QName ()
private String
"UnknownMessage"] else [])
                  [QName ()] -> [QName ()] -> [QName ()]
forall a. [a] -> [a] -> [a]
++ (if DescriptorInfo -> Bool
jsonInstances DescriptorInfo
di then [String -> QName ()
private String
"FromJSON", String -> QName ()
private String
"ToJSON"] else [])
        instMesAPI :: Decl ()
instMesAPI = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"MessageAPI")
                       [() -> Name () -> Type ()
forall l. l -> Name l -> Type l
TyVar () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"msg'"), () -> Type () -> Type ()
forall l. l -> Type l -> Type l
TyParen () (() -> Type () -> Type () -> Type ()
forall l. l -> Type l -> Type l -> Type l
TyFun () (() -> Name () -> Type ()
forall l. l -> Name l -> Type l
TyVar () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"msg'")) (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () QName ()
un)), (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () QName ()
un)]) Maybe [InstDecl ()]
forall a. Maybe a
Nothing
        dataDecl :: Decl ()
dataDecl = ()
-> DataOrNew ()
-> Maybe (Context ())
-> DeclHead ()
-> [QualConDecl ()]
-> [Deriving ()]
-> Decl ()
forall l.
l
-> DataOrNew l
-> Maybe (Context l)
-> DeclHead l
-> [QualConDecl l]
-> [Deriving l]
-> Decl l
DataDecl () (() -> DataOrNew ()
forall l. l -> DataOrNew l
DataType ()) Maybe (Context ())
forall a. Maybe a
Nothing (() -> Name () -> DeclHead ()
forall l. l -> Name l -> DeclHead l
DHead () (ProtoName -> Name ()
baseIdent ProtoName
protoName)) [] ([Deriving ()] -> Decl ()) -> [Deriving ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
            Deriving () -> [Deriving ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Deriving ()
derivesTypeable
        mkInst :: QName () -> Decl ()
mkInst QName ()
s = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule QName ()
s [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () QName ()
un]) Maybe [InstDecl ()]
forall a. Maybe a
Nothing
        eabs :: ExportSpec ()
eabs = () -> Namespace () -> QName () -> ExportSpec ()
forall l. l -> Namespace l -> QName l -> ExportSpec l
EAbs () (() -> Namespace ()
forall l. l -> Namespace l
NoNamespace ()) QName ()
un
    in ()
-> Maybe (ModuleHead ())
-> [ModulePragma ()]
-> [ImportDecl ()]
-> [Decl ()]
-> Module ()
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
Module () (ModuleHead () -> Maybe (ModuleHead ())
forall a. a -> Maybe a
Just (()
-> ModuleName ()
-> Maybe (WarningText ())
-> Maybe (ExportSpecList ())
-> ModuleHead ()
forall l.
l
-> ModuleName l
-> Maybe (WarningText l)
-> Maybe (ExportSpecList l)
-> ModuleHead l
ModuleHead () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () (ProtoName -> String
fqMod ProtoName
protoName)) Maybe (WarningText ())
forall a. Maybe a
Nothing (ExportSpecList () -> Maybe (ExportSpecList ())
forall a. a -> Maybe a
Just (() -> [ExportSpec ()] -> ExportSpecList ()
forall l. l -> [ExportSpec l] -> ExportSpecList l
ExportSpecList () [ExportSpec ()
eabs])))) (Bool -> [ModulePragma ()]
modulePragmas (Bool -> [ModulePragma ()]) -> Bool -> [ModulePragma ()]
forall a b. (a -> b) -> a -> b
$ DescriptorInfo -> Bool
makeLenses DescriptorInfo
di) [ImportDecl ()]
minimalImports
         (Decl ()
dataDecl Decl () -> [Decl ()] -> [Decl ()]
forall a. a -> [a] -> [a]
: Decl ()
instMesAPI Decl () -> [Decl ()] -> [Decl ()]
forall a. a -> [a] -> [a]
: (QName () -> Decl ()) -> [QName ()] -> [Decl ()]
forall a b. (a -> b) -> [a] -> [b]
map QName () -> Decl ()
mkInst [QName ()]
classes)

-- This builds on the output of descriptorBootModule and declares a hs-boot that
-- declares the data type and the keys
descriptorKeyBootModule :: Result -> DescriptorInfo -> Module ()
descriptorKeyBootModule :: Result -> DescriptorInfo -> Module ()
descriptorKeyBootModule Result
result DescriptorInfo
di
  = let Module () (Just (ModuleHead () ModuleName ()
m Maybe (WarningText ())
_ (Just (ExportSpecList () [ExportSpec ()]
exports)))) [ModulePragma ()]
pragmas [ImportDecl ()]
imports [Decl ()]
decls = DescriptorInfo -> Module ()
descriptorBootModule DescriptorInfo
di
        ([ProtoName]
extendees,[FieldInfo]
myKeys) = [(ProtoName, FieldInfo)] -> ([ProtoName], [FieldInfo])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ProtoName, FieldInfo)] -> ([ProtoName], [FieldInfo]))
-> [(ProtoName, FieldInfo)] -> ([ProtoName], [FieldInfo])
forall a b. (a -> b) -> a -> b
$ Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq (ProtoName, FieldInfo)
keys DescriptorInfo
di)
        exportKeys :: [ExportSpec ()]
exportKeys = (FieldInfo -> ExportSpec ()) -> [FieldInfo] -> [ExportSpec ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> QName () -> ExportSpec ()
forall l. l -> QName l -> ExportSpec l
EVar () (QName () -> ExportSpec ())
-> (FieldInfo -> QName ()) -> FieldInfo -> ExportSpec ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName) [FieldInfo]
myKeys
        importTypes :: [ImportDecl ()]
importTypes = [ImportDecl ()] -> [ImportDecl ()]
mergeImports ([ImportDecl ()] -> [ImportDecl ()])
-> ([ProtoName] -> [ImportDecl ()])
-> [ProtoName]
-> [ImportDecl ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtoName -> Maybe (ImportDecl ()))
-> [ProtoName] -> [ImportDecl ()]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Result
-> ModuleName () -> Part -> ProtoName -> Maybe (ImportDecl ())
importPN Result
result ModuleName ()
m Part
Source) ([ProtoName] -> [ImportDecl ()])
-> ([ProtoName] -> [ProtoName]) -> [ProtoName] -> [ImportDecl ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ProtoName] -> [ProtoName]
forall a. Ord a => [a] -> [a]
nubSort ([ProtoName] -> [ImportDecl ()]) -> [ProtoName] -> [ImportDecl ()]
forall a b. (a -> b) -> a -> b
$
                        [ProtoName]
extendees [ProtoName] -> [ProtoName] -> [ProtoName]
forall a. [a] -> [a] -> [a]
++ (FieldInfo -> Maybe ProtoName) -> [FieldInfo] -> [ProtoName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FieldInfo -> Maybe ProtoName
typeName [FieldInfo]
myKeys
        declKeys :: [Decl ()]
declKeys = ProtoName -> Seq (ProtoName, FieldInfo) -> [Decl ()]
keysXType (DescriptorInfo -> ProtoName
descName DescriptorInfo
di) (DescriptorInfo -> Seq (ProtoName, FieldInfo)
keys DescriptorInfo
di)
    in ()
-> Maybe (ModuleHead ())
-> [ModulePragma ()]
-> [ImportDecl ()]
-> [Decl ()]
-> Module ()
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
Module () (ModuleHead () -> Maybe (ModuleHead ())
forall a. a -> Maybe a
Just (()
-> ModuleName ()
-> Maybe (WarningText ())
-> Maybe (ExportSpecList ())
-> ModuleHead ()
forall l.
l
-> ModuleName l
-> Maybe (WarningText l)
-> Maybe (ExportSpecList l)
-> ModuleHead l
ModuleHead () ModuleName ()
m Maybe (WarningText ())
forall a. Maybe a
Nothing (ExportSpecList () -> Maybe (ExportSpecList ())
forall a. a -> Maybe a
Just (() -> [ExportSpec ()] -> ExportSpecList ()
forall l. l -> [ExportSpec l] -> ExportSpecList l
ExportSpecList () ([ExportSpec ()]
exports[ExportSpec ()] -> [ExportSpec ()] -> [ExportSpec ()]
forall a. [a] -> [a] -> [a]
++[ExportSpec ()]
exportKeys))))) [ModulePragma ()]
pragmas ([ImportDecl ()]
imports[ImportDecl ()] -> [ImportDecl ()] -> [ImportDecl ()]
forall a. [a] -> [a] -> [a]
++[ImportDecl ()]
importTypes) ([Decl ()]
decls[Decl ()] -> [Decl ()] -> [Decl ()]
forall a. [a] -> [a] -> [a]
++[Decl ()]
declKeys)

-- This build the 'Key module that defines the keys only
descriptorKeyfileModule :: Result -> DescriptorInfo -> Module ()
descriptorKeyfileModule :: Result -> DescriptorInfo -> Module ()
descriptorKeyfileModule Result
result DescriptorInfo
di
  = let protoName'Key :: ProtoName
protoName'Key = (DescriptorInfo -> ProtoName
descName DescriptorInfo
di) { baseName :: MName String
baseName = String -> MName String
forall a. a -> MName a
MName (String -> MName String)
-> (MName String -> String) -> MName String -> MName String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'Key") (String -> String)
-> (MName String -> String) -> MName String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MName String -> String
forall a. MName a -> a
mName (MName String -> MName String) -> MName String -> MName String
forall a b. (a -> b) -> a -> b
$ (ProtoName -> MName String
baseName (DescriptorInfo -> ProtoName
descName DescriptorInfo
di)) }
        ([ProtoName]
extendees,[FieldInfo]
myKeys) = [(ProtoName, FieldInfo)] -> ([ProtoName], [FieldInfo])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ProtoName, FieldInfo)] -> ([ProtoName], [FieldInfo]))
-> [(ProtoName, FieldInfo)] -> ([ProtoName], [FieldInfo])
forall a b. (a -> b) -> a -> b
$ Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq (ProtoName, FieldInfo)
keys DescriptorInfo
di)
        mBase :: ModuleName ()
mBase = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () (ProtoName -> String
fqMod (DescriptorInfo -> ProtoName
descName DescriptorInfo
di))
        m :: ModuleName ()
m = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () (ProtoName -> String
fqMod ProtoName
protoName'Key)
        exportKeys :: [ExportSpec ()]
exportKeys = (FieldInfo -> ExportSpec ()) -> [FieldInfo] -> [ExportSpec ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> QName () -> ExportSpec ()
forall l. l -> QName l -> ExportSpec l
EVar () (QName () -> ExportSpec ())
-> (FieldInfo -> QName ()) -> FieldInfo -> ExportSpec ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName) [FieldInfo]
myKeys
        importTypes :: [ImportDecl ()]
importTypes = [ImportDecl ()] -> [ImportDecl ()]
mergeImports ([ImportDecl ()] -> [ImportDecl ()])
-> ([ProtoName] -> [ImportDecl ()])
-> [ProtoName]
-> [ImportDecl ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtoName -> Maybe (ImportDecl ()))
-> [ProtoName] -> [ImportDecl ()]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Result
-> ModuleName () -> Part -> ProtoName -> Maybe (ImportDecl ())
importPN Result
result ModuleName ()
mBase Part
KeyFile) ([ProtoName] -> [ImportDecl ()])
-> ([ProtoName] -> [ProtoName]) -> [ProtoName] -> [ImportDecl ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ProtoName] -> [ProtoName]
forall a. Ord a => [a] -> [a]
nubSort ([ProtoName] -> [ImportDecl ()]) -> [ProtoName] -> [ImportDecl ()]
forall a b. (a -> b) -> a -> b
$
                        [ProtoName]
extendees [ProtoName] -> [ProtoName] -> [ProtoName]
forall a. [a] -> [a] -> [a]
++ (FieldInfo -> Maybe ProtoName) -> [FieldInfo] -> [ProtoName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FieldInfo -> Maybe ProtoName
typeName [FieldInfo]
myKeys
        declKeys :: [Decl ()]
declKeys = ProtoName -> Seq (ProtoName, FieldInfo) -> [Decl ()]
keysXTypeVal ProtoName
protoName'Key (DescriptorInfo -> Seq (ProtoName, FieldInfo)
keys DescriptorInfo
di)
    in ()
-> Maybe (ModuleHead ())
-> [ModulePragma ()]
-> [ImportDecl ()]
-> [Decl ()]
-> Module ()
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
Module () (ModuleHead () -> Maybe (ModuleHead ())
forall a. a -> Maybe a
Just (()
-> ModuleName ()
-> Maybe (WarningText ())
-> Maybe (ExportSpecList ())
-> ModuleHead ()
forall l.
l
-> ModuleName l
-> Maybe (WarningText l)
-> Maybe (ExportSpecList l)
-> ModuleHead l
ModuleHead () ModuleName ()
m Maybe (WarningText ())
forall a. Maybe a
Nothing (ExportSpecList () -> Maybe (ExportSpecList ())
forall a. a -> Maybe a
Just (() -> [ExportSpec ()] -> ExportSpecList ()
forall l. l -> [ExportSpec l] -> ExportSpecList l
ExportSpecList () [ExportSpec ()]
exportKeys)) )) (Bool -> [ModulePragma ()]
modulePragmas (Bool -> [ModulePragma ()]) -> Bool -> [ModulePragma ()]
forall a b. (a -> b) -> a -> b
$ DescriptorInfo -> Bool
makeLenses DescriptorInfo
di) ([ImportDecl ()]
minimalImports[ImportDecl ()] -> [ImportDecl ()] -> [ImportDecl ()]
forall a. [a] -> [a] -> [a]
++[ImportDecl ()]
importTypes) [Decl ()]
declKeys

-- This builds the normal module
descriptorNormalModule :: Result -> DescriptorInfo -> Module ()
descriptorNormalModule :: Result -> DescriptorInfo -> Module ()
descriptorNormalModule Result
result DescriptorInfo
di
  = let protoName :: ProtoName
protoName = DescriptorInfo -> ProtoName
descName DescriptorInfo
di
        un :: QName ()
un = ProtoName -> QName ()
unqualName ProtoName
protoName
        myKind :: VertexKind
myKind = Result -> MKey -> VertexKind
getKind Result
result (ProtoName -> MKey
pKey ProtoName
protoName)
        sepKey :: Bool
sepKey = VertexKind
myKind VertexKind -> VertexKind -> Bool
forall a. Eq a => a -> a -> Bool
== VertexKind
SplitKeyTypeBoot
        ([ProtoName]
extendees,[FieldInfo]
myKeys) = [(ProtoName, FieldInfo)] -> ([ProtoName], [FieldInfo])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ProtoName, FieldInfo)] -> ([ProtoName], [FieldInfo]))
-> [(ProtoName, FieldInfo)] -> ([ProtoName], [FieldInfo])
forall a b. (a -> b) -> a -> b
$ Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq (ProtoName, FieldInfo)
keys DescriptorInfo
di)
        extendees' :: [ProtoName]
extendees' = if Bool
sepKey then [] else [ProtoName]
extendees
        myKeys' :: [FieldInfo]
myKeys' = if Bool
sepKey then [] else [FieldInfo]
myKeys
        m :: ModuleName ()
m = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () (ProtoName -> String
fqMod ProtoName
protoName)
        exportKeys :: [ExportSpec ()]
        exportKeys :: [ExportSpec ()]
exportKeys = (FieldInfo -> ExportSpec ()) -> [FieldInfo] -> [ExportSpec ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> QName () -> ExportSpec ()
forall l. l -> QName l -> ExportSpec l
EVar () (QName () -> ExportSpec ())
-> (FieldInfo -> QName ()) -> FieldInfo -> ExportSpec ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName) [FieldInfo]
myKeys
        imports :: [ImportDecl ()]
imports = (Bool -> Bool -> Bool -> [ImportDecl ()]
standardImports Bool
False (DescriptorInfo -> Bool
hasExt DescriptorInfo
di) (DescriptorInfo -> Bool
makeLenses DescriptorInfo
di) [ImportDecl ()] -> [ImportDecl ()] -> [ImportDecl ()]
forall a. [a] -> [a] -> [a]
++) ([ImportDecl ()] -> [ImportDecl ()])
-> ([[ImportDecl ()]] -> [ImportDecl ()])
-> [[ImportDecl ()]]
-> [ImportDecl ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImportDecl ()] -> [ImportDecl ()]
mergeImports ([ImportDecl ()] -> [ImportDecl ()])
-> ([[ImportDecl ()]] -> [ImportDecl ()])
-> [[ImportDecl ()]]
-> [ImportDecl ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ImportDecl ()]] -> [ImportDecl ()]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ImportDecl ()]] -> [ImportDecl ()])
-> [[ImportDecl ()]] -> [ImportDecl ()]
forall a b. (a -> b) -> a -> b
$
                    [ (ProtoName -> Maybe (ImportDecl ()))
-> [ProtoName] -> [ImportDecl ()]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Result
-> ModuleName () -> Part -> ProtoName -> Maybe (ImportDecl ())
importPN Result
result ModuleName ()
m Part
Normal) ([ProtoName] -> [ImportDecl ()]) -> [ProtoName] -> [ImportDecl ()]
forall a b. (a -> b) -> a -> b
$
                        [ProtoName]
extendees' [ProtoName] -> [ProtoName] -> [ProtoName]
forall a. [a] -> [a] -> [a]
++ (FieldInfo -> Maybe ProtoName) -> [FieldInfo] -> [ProtoName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FieldInfo -> Maybe ProtoName
typeName ([FieldInfo]
myKeys' [FieldInfo] -> [FieldInfo] -> [FieldInfo]
forall a. [a] -> [a] -> [a]
++ (Seq FieldInfo -> [FieldInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq FieldInfo
fields DescriptorInfo
di)))
                    , [[ImportDecl ()]] -> [ImportDecl ()]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ImportDecl ()]] -> [ImportDecl ()])
-> ([OneofInfo] -> [[ImportDecl ()]])
-> [OneofInfo]
-> [ImportDecl ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OneofInfo -> Maybe [ImportDecl ()])
-> [OneofInfo] -> [[ImportDecl ()]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Result
-> ModuleName () -> Part -> OneofInfo -> Maybe [ImportDecl ()]
importO Result
result ModuleName ()
m Part
Normal) ([OneofInfo] -> [ImportDecl ()]) -> [OneofInfo] -> [ImportDecl ()]
forall a b. (a -> b) -> a -> b
$ Seq OneofInfo -> [OneofInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq OneofInfo
descOneofs DescriptorInfo
di)
                    , (ProtoFName -> Maybe (ImportDecl ()))
-> [ProtoFName] -> [ImportDecl ()]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Result -> ModuleName () -> ProtoFName -> Maybe (ImportDecl ())
importPFN Result
result ModuleName ()
m) ((FieldInfo -> ProtoFName) -> [FieldInfo] -> [ProtoFName]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo -> ProtoFName
fieldName ([FieldInfo]
myKeys [FieldInfo] -> [FieldInfo] -> [FieldInfo]
forall a. [a] -> [a] -> [a]
++ Seq FieldInfo -> [FieldInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq FieldInfo
knownKeys DescriptorInfo
di))) ]
        lenses :: [Decl ()]
lenses | DescriptorInfo -> Bool
makeLenses DescriptorInfo
di = [() -> Exp () -> Decl ()
forall l. l -> Exp l -> Decl l
SpliceDecl () (Exp ()
mkLenses Exp () -> Exp () -> Exp ()
$$ () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
TypQuote () (ProtoName -> QName ()
unqualName ProtoName
protoName))]
               | Bool
otherwise = []
        declKeys :: [Decl ()]
declKeys | Bool
sepKey = []
                 | Bool
otherwise = ProtoName -> Seq (ProtoName, FieldInfo) -> [Decl ()]
keysXTypeVal (DescriptorInfo -> ProtoName
descName DescriptorInfo
di) (DescriptorInfo -> Seq (ProtoName, FieldInfo)
keys DescriptorInfo
di)
    in ()
-> Maybe (ModuleHead ())
-> [ModulePragma ()]
-> [ImportDecl ()]
-> [Decl ()]
-> Module ()
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
Module ()
              (ModuleHead () -> Maybe (ModuleHead ())
forall a. a -> Maybe a
Just (()
-> ModuleName ()
-> Maybe (WarningText ())
-> Maybe (ExportSpecList ())
-> ModuleHead ()
forall l.
l
-> ModuleName l
-> Maybe (WarningText l)
-> Maybe (ExportSpecList l)
-> ModuleHead l
ModuleHead () ModuleName ()
m Maybe (WarningText ())
forall a. Maybe a
Nothing (ExportSpecList () -> Maybe (ExportSpecList ())
forall a. a -> Maybe a
Just (() -> [ExportSpec ()] -> ExportSpecList ()
forall l. l -> [ExportSpec l] -> ExportSpecList l
ExportSpecList () ((() -> EWildcard () -> QName () -> [CName ()] -> ExportSpec ()
forall l. l -> EWildcard l -> QName l -> [CName l] -> ExportSpec l
EThingWith () (() -> Int -> EWildcard ()
forall l. l -> Int -> EWildcard l
EWildcard () Int
0) QName ()
un [] ExportSpec () -> [ExportSpec ()] -> [ExportSpec ()]
forall a. a -> [a] -> [a]
: DescriptorInfo -> [ExportSpec ()]
exportLenses DescriptorInfo
di [ExportSpec ()] -> [ExportSpec ()] -> [ExportSpec ()]
forall a. [a] -> [a] -> [a]
++ [ExportSpec ()]
exportKeys))))))
              (Bool -> [ModulePragma ()]
modulePragmas (Bool -> [ModulePragma ()]) -> Bool -> [ModulePragma ()]
forall a b. (a -> b) -> a -> b
$ DescriptorInfo -> Bool
makeLenses DescriptorInfo
di)
              [ImportDecl ()]
imports
              (DescriptorInfo -> Decl ()
descriptorX DescriptorInfo
di Decl () -> [Decl ()] -> [Decl ()]
forall a. a -> [a] -> [a]
: [Decl ()]
lenses [Decl ()] -> [Decl ()] -> [Decl ()]
forall a. [a] -> [a] -> [a]
++ [Decl ()]
declKeys [Decl ()] -> [Decl ()] -> [Decl ()]
forall a. [a] -> [a] -> [a]
++ DescriptorInfo -> [Decl ()]
instancesDescriptor DescriptorInfo
di)

mkLenses :: Exp ()
mkLenses :: Exp ()
mkLenses = () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (() -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Control.Lens.TH") (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"makeLenses"))

exportLenses :: DescriptorInfo -> [ExportSpec ()]
exportLenses :: DescriptorInfo -> [ExportSpec ()]
exportLenses DescriptorInfo
di =
  if DescriptorInfo -> Bool
makeLenses DescriptorInfo
di
    then (ProtoFName -> ExportSpec ()) -> [ProtoFName] -> [ExportSpec ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> QName () -> ExportSpec ()
forall l. l -> QName l -> ExportSpec l
EVar () (QName () -> ExportSpec ())
-> (ProtoFName -> QName ()) -> ProtoFName -> ExportSpec ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (ProtoFName -> ProtoFName) -> ProtoFName -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoFName -> ProtoFName
stripPrefix) [ProtoFName]
lensFieldNames
    else []
  where stripPrefix :: ProtoFName -> ProtoFName
stripPrefix ProtoFName
pfn = ProtoFName
pfn { baseNamePrefix' :: String
baseNamePrefix' = String
"" }
        lensFieldNames :: [ProtoFName]
lensFieldNames = (FieldInfo -> ProtoFName) -> [FieldInfo] -> [ProtoFName]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo -> ProtoFName
fieldName (Seq FieldInfo -> [FieldInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq FieldInfo
fields DescriptorInfo
di))
                         [ProtoFName] -> [ProtoFName] -> [ProtoFName]
forall a. [a] -> [a] -> [a]
++ (OneofInfo -> ProtoFName) -> [OneofInfo] -> [ProtoFName]
forall a b. (a -> b) -> [a] -> [b]
map OneofInfo -> ProtoFName
oneofFName (Seq OneofInfo -> [OneofInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq OneofInfo
descOneofs DescriptorInfo
di))

minimalImports :: [ImportDecl ()]
minimalImports :: [ImportDecl ()]
minimalImports =
  [ ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude") Bool
True Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude'")) Maybe (ImportSpecList ())
forall a. Maybe a
Nothing
  , ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Data.Typeable") Bool
True Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude'")) Maybe (ImportSpecList ())
forall a. Maybe a
Nothing
  , ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Data.Data") Bool
True Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude'")) Maybe (ImportSpecList ())
forall a. Maybe a
Nothing
  , ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"GHC.Generics") Bool
True Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude'")) Maybe (ImportSpecList ())
forall a. Maybe a
Nothing
  , ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Text.ProtocolBuffers.Header") Bool
True Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"P'")) Maybe (ImportSpecList ())
forall a. Maybe a
Nothing ]

standardImports :: Bool -> Bool -> Bool -> [ImportDecl ()]
standardImports :: Bool -> Bool -> Bool -> [ImportDecl ()]
standardImports Bool
isEnumMod Bool
ext Bool
lenses =
  [ ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude") Bool
False Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing Maybe (ModuleName ())
forall a. Maybe a
Nothing (ImportSpecList () -> Maybe (ImportSpecList ())
forall a. a -> Maybe a
Just (() -> Bool -> [ImportSpec ()] -> ImportSpecList ()
forall l. l -> Bool -> [ImportSpec l] -> ImportSpecList l
ImportSpecList () Bool
False [ImportSpec ()]
ops))
  , ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude") Bool
True Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude'")) Maybe (ImportSpecList ())
forall a. Maybe a
Nothing
  , ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Data.Typeable") Bool
True Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude'")) Maybe (ImportSpecList ())
forall a. Maybe a
Nothing
  , ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"GHC.Generics") Bool
True Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude'")) Maybe (ImportSpecList ())
forall a. Maybe a
Nothing
  , ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Data.Data") Bool
True Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude'")) Maybe (ImportSpecList ())
forall a. Maybe a
Nothing
  , ()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Text.ProtocolBuffers.Header") Bool
True Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing (ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"P'")) Maybe (ImportSpecList ())
forall a. Maybe a
Nothing ] [ImportDecl ()] -> [ImportDecl ()] -> [ImportDecl ()]
forall a. [a] -> [a] -> [a]
++ [ImportDecl ()]
lensTH
 where
       ops :: [ImportSpec ()]
ops | Bool
ext = (String -> ImportSpec ()) -> [String] -> [ImportSpec ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> Name () -> ImportSpec ()
forall l. l -> Name l -> ImportSpec l
IVar () (Name () -> ImportSpec ())
-> (String -> Name ()) -> String -> ImportSpec ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> String -> Name ()
forall l. l -> String -> Name l
Symbol ()) ([String] -> [ImportSpec ()]) -> [String] -> [ImportSpec ()]
forall a b. (a -> b) -> a -> b
$ [String]
base [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"==",String
"<=",String
"&&"]
           | Bool
otherwise = (String -> ImportSpec ()) -> [String] -> [ImportSpec ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> Name () -> ImportSpec ()
forall l. l -> Name l -> ImportSpec l
IVar () (Name () -> ImportSpec ())
-> (String -> Name ()) -> String -> ImportSpec ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> String -> Name ()
forall l. l -> String -> Name l
Symbol ()) [String]
base
       base :: [String]
base | Bool
isEnumMod = [String
"+",String
"/",String
"."]
            | Bool
otherwise = [String
"+",String
"/",String
"++",String
"."]
       lensTH :: [ImportDecl ()]
lensTH | Bool
lenses = [()
-> ModuleName ()
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList ())
-> ImportDecl ()
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Control.Lens.TH") Bool
True Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing Maybe (ModuleName ())
forall a. Maybe a
Nothing Maybe (ImportSpecList ())
forall a. Maybe a
Nothing]
              | Bool
otherwise = []

keysXType :: ProtoName -> Seq KeyInfo -> [Decl ()]
keysXType :: ProtoName -> Seq (ProtoName, FieldInfo) -> [Decl ()]
keysXType ProtoName
self Seq (ProtoName, FieldInfo)
ks = ((ProtoName, FieldInfo) -> Decl ())
-> [(ProtoName, FieldInfo)] -> [Decl ()]
forall a b. (a -> b) -> [a] -> [b]
map (ProtoName -> (ProtoName, FieldInfo) -> Decl ()
makeKeyType ProtoName
self) ([(ProtoName, FieldInfo)] -> [Decl ()])
-> (Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)])
-> Seq (ProtoName, FieldInfo)
-> [Decl ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (ProtoName, FieldInfo) -> [Decl ()])
-> Seq (ProtoName, FieldInfo) -> [Decl ()]
forall a b. (a -> b) -> a -> b
$ Seq (ProtoName, FieldInfo)
ks

keysXTypeVal :: ProtoName -> Seq KeyInfo -> [Decl ()]
keysXTypeVal :: ProtoName -> Seq (ProtoName, FieldInfo) -> [Decl ()]
keysXTypeVal ProtoName
self Seq (ProtoName, FieldInfo)
ks = ((ProtoName, FieldInfo) -> [Decl ()])
-> [(ProtoName, FieldInfo)] -> [Decl ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ (ProtoName, FieldInfo)
ki -> [ProtoName -> (ProtoName, FieldInfo) -> Decl ()
makeKeyType ProtoName
self (ProtoName, FieldInfo)
ki,ProtoName -> (ProtoName, FieldInfo) -> Decl ()
makeKeyVal ProtoName
self (ProtoName, FieldInfo)
ki]) ([(ProtoName, FieldInfo)] -> [Decl ()])
-> (Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)])
-> Seq (ProtoName, FieldInfo)
-> [Decl ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (ProtoName, FieldInfo) -> [Decl ()])
-> Seq (ProtoName, FieldInfo) -> [Decl ()]
forall a b. (a -> b) -> a -> b
$ Seq (ProtoName, FieldInfo)
ks

makeKeyType :: ProtoName -> KeyInfo -> Decl ()
makeKeyType :: ProtoName -> (ProtoName, FieldInfo) -> Decl ()
makeKeyType ProtoName
self (ProtoName
extendee,FieldInfo
f) = Decl ()
keyType
  where keyType :: Decl ()
keyType = () -> [Name ()] -> Type () -> Decl ()
forall l. l -> [Name l] -> Type l -> Decl l
TypeSig () [ ProtoFName -> Name ()
baseIdent' (ProtoFName -> Name ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName (FieldInfo -> Name ()) -> FieldInfo -> Name ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
f ] ((Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (() -> Type () -> Type () -> Type ()
forall l. l -> Type l -> Type l -> Type l
TyApp ()) ([Type ()] -> Type ())
-> ([QName ()] -> [Type ()]) -> [QName ()] -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName () -> Type ()) -> [QName ()] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon ()) ([QName ()] -> Type ()) -> [QName ()] -> Type ()
forall a b. (a -> b) -> a -> b
$
                    [ String -> QName ()
private String
"Key", String -> QName ()
private String
labeled
                    , if ProtoName
extendee ProtoName -> ProtoName -> Bool
forall a. Eq a => a -> a -> Bool
/= ProtoName
self then ProtoName -> QName ()
qualName ProtoName
extendee else ProtoName -> QName ()
unqualName ProtoName
extendee
                    , QName ()
typeQName ])
        labeled :: String
labeled | FieldInfo -> Bool
isPacked FieldInfo
f = String
"PackedSeq"
                | FieldInfo -> Bool
canRepeat FieldInfo
f = String
"Seq"
                | Bool
otherwise = String
"Maybe"
        typeNumber :: Int
typeNumber = FieldType -> Int
getFieldType (FieldType -> Int) -> (FieldInfo -> FieldType) -> FieldInfo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> FieldType
typeCode (FieldInfo -> Int) -> FieldInfo -> Int
forall a b. (a -> b) -> a -> b
$ FieldInfo
f
        typeQName :: QName ()
        typeQName :: QName ()
typeQName = case Int -> Maybe String
useType Int
typeNumber of
                      Just String
s -> String -> QName ()
private String
s
                      Maybe String
Nothing -> case FieldInfo -> Maybe ProtoName
typeName FieldInfo
f of
                                   Just ProtoName
s | ProtoName
self ProtoName -> ProtoName -> Bool
forall a. Eq a => a -> a -> Bool
/= ProtoName
s -> ProtoName -> QName ()
qualName ProtoName
s
                                          | Bool
otherwise -> ProtoName -> QName ()
unqualName ProtoName
s
                                   Maybe ProtoName
Nothing -> String -> QName ()
forall a. HasCallStack => String -> a
error (String -> QName ()) -> String -> QName ()
forall a b. (a -> b) -> a -> b
$  String
"No Name for Field!\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FieldInfo -> String
forall a. Show a => a -> String
show FieldInfo
f

makeKeyVal :: ProtoName -> KeyInfo -> Decl ()
makeKeyVal :: ProtoName -> (ProtoName, FieldInfo) -> Decl ()
makeKeyVal ProtoName
_self (ProtoName
_extendee,FieldInfo
f) = Decl ()
keyVal
  where typeNumber :: Int
typeNumber = FieldType -> Int
getFieldType (FieldType -> Int) -> (FieldInfo -> FieldType) -> FieldInfo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> FieldType
typeCode (FieldInfo -> Int) -> FieldInfo -> Int
forall a b. (a -> b) -> a -> b
$ FieldInfo
f
        keyVal :: Decl ()
keyVal = () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Decl ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
PatBind () (() -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () (ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName (FieldInfo -> QName ()) -> FieldInfo -> QName ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
f) []) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs ()
                   (String -> Exp ()
pcon String
"Key" Exp () -> Exp () -> Exp ()
$$ Int32 -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (FieldId -> Int32
getFieldId (FieldInfo -> FieldId
fieldNumber FieldInfo
f))
                               Exp () -> Exp () -> Exp ()
$$ Int -> Exp ()
forall x. Integral x => x -> Exp ()
litInt Int
typeNumber
                               Exp () -> Exp () -> Exp ()
$$ Exp () -> (HsDefault -> Exp ()) -> Maybe HsDefault -> Exp ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Exp ()
preludecon String
"Nothing")
                                        (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> (HsDefault -> Exp ()) -> HsDefault -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Exp ()
preludecon String
"Just" Exp () -> Exp () -> Exp ()
$$) (Exp () -> Exp ()) -> (HsDefault -> Exp ()) -> HsDefault -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldType -> HsDefault -> Exp ()
defToSyntax (FieldInfo -> FieldType
typeCode FieldInfo
f)))
                                        (FieldInfo -> Maybe HsDefault
hsDefault FieldInfo
f)
                   )) Maybe (Binds ())
noWhere

defToSyntax :: FieldType -> HsDefault -> Exp ()
defToSyntax :: FieldType -> HsDefault -> Exp ()
defToSyntax FieldType
tc HsDefault
x =
  case HsDefault
x of
    HsDef'Bool Bool
b -> String -> Exp ()
preludecon (Bool -> String
forall a. Show a => a -> String
show Bool
b)
    HsDef'ByteString ByteString
bs -> (if FieldType
tc FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType
9 then (\ Exp ()
xx -> () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
pcon String
"Utf8" Exp () -> Exp () -> Exp ()
$$ Exp ()
xx)) else Exp () -> Exp ()
forall a. a -> a
id) (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$
                           (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
pvar String
"pack" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
litStr (ByteString -> String
LC.unpack ByteString
bs))
    HsDef'RealFloat (SRF'Rational Rational
r) | Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 -> () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ () -> Literal () -> Exp ()
forall l. l -> Literal l -> Exp l
Lit () (() -> Rational -> String -> Literal ()
forall l. l -> Rational -> String -> Literal l
Frac () Rational
r (Rational -> String
forall a. Show a => a -> String
show Rational
r))
                                     | Bool
otherwise -> () -> Literal () -> Exp ()
forall l. l -> Literal l -> Exp l
Lit () (() -> Rational -> String -> Literal ()
forall l. l -> Rational -> String -> Literal l
Frac () Rational
r (Rational -> String
forall a. Show a => a -> String
show Rational
r))
    HsDef'RealFloat SomeRealFloat
SRF'nan  -> Int -> Exp ()
litInt'   Int
0  Exp () -> Exp () -> Exp ()
/! Int -> Exp ()
litInt' Int
0
    HsDef'RealFloat SomeRealFloat
SRF'ninf -> Int -> Exp ()
litInt'   Int
1  Exp () -> Exp () -> Exp ()
/! Int -> Exp ()
litInt' Int
0
    HsDef'RealFloat SomeRealFloat
SRF'inf  -> Int -> Exp ()
litInt' (-Int
1) Exp () -> Exp () -> Exp ()
/! Int -> Exp ()
litInt' Int
0
    HsDef'Integer Integer
i -> Integer -> Exp ()
forall x. Integral x => x -> Exp ()
litInt Integer
i
    HsDef'Enum String
s -> () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
preludevar String
"read" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
litStr String
s
 where /! :: Exp () -> Exp () -> Exp ()
(/!) Exp ()
a Exp ()
b = () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp () -> Exp () -> Exp ()
mkOp String
"/" Exp ()
a Exp ()
b)

descriptorX :: DescriptorInfo -> Decl ()
descriptorX :: DescriptorInfo -> Decl ()
descriptorX DescriptorInfo
di = ()
-> DataOrNew ()
-> Maybe (Context ())
-> DeclHead ()
-> [QualConDecl ()]
-> [Deriving ()]
-> Decl ()
forall l.
l
-> DataOrNew l
-> Maybe (Context l)
-> DeclHead l
-> [QualConDecl l]
-> [Deriving l]
-> Decl l
DataDecl () (() -> DataOrNew ()
forall l. l -> DataOrNew l
DataType ()) Maybe (Context ())
forall a. Maybe a
Nothing (() -> Name () -> DeclHead ()
forall l. l -> Name l -> DeclHead l
DHead () Name ()
name) [()
-> Maybe [TyVarBind ()]
-> Maybe (Context ())
-> ConDecl ()
-> QualConDecl ()
forall l.
l
-> Maybe [TyVarBind l]
-> Maybe (Context l)
-> ConDecl l
-> QualConDecl l
QualConDecl () Maybe [TyVarBind ()]
forall a. Maybe a
Nothing Maybe (Context ())
forall a. Maybe a
Nothing ConDecl ()
con] (Deriving () -> [Deriving ()]
forall (m :: * -> *) a. Monad m => a -> m a
return Deriving ()
derives)
  where self :: ProtoName
self = DescriptorInfo -> ProtoName
descName DescriptorInfo
di
        name :: Name ()
name = ProtoName -> Name ()
baseIdent ProtoName
self
        con :: ConDecl ()
con = () -> Name () -> [FieldDecl ()] -> ConDecl ()
forall l. l -> Name l -> [FieldDecl l] -> ConDecl l
RecDecl () Name ()
name [FieldDecl ()]
eFields
                where eFields :: [FieldDecl ()]
eFields = (([Name ()], Type ()) -> FieldDecl ())
-> [([Name ()], Type ())] -> [FieldDecl ()]
forall a b. (a -> b) -> [a] -> [b]
map (\([Name ()]
ns, Type ()
t) -> () -> [Name ()] -> Type () -> FieldDecl ()
forall l. l -> [Name l] -> Type l -> FieldDecl l
FieldDecl () [Name ()]
ns Type ()
t) ([([Name ()], Type ())] -> [FieldDecl ()])
-> [([Name ()], Type ())] -> [FieldDecl ()]
forall a b. (a -> b) -> a -> b
$ (FieldInfo -> [([Name ()], Type ())] -> [([Name ()], Type ())])
-> [([Name ()], Type ())]
-> Seq FieldInfo
-> [([Name ()], Type ())]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr ((:) (([Name ()], Type ())
 -> [([Name ()], Type ())] -> [([Name ()], Type ())])
-> (FieldInfo -> ([Name ()], Type ()))
-> FieldInfo
-> [([Name ()], Type ())]
-> [([Name ()], Type ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ([Name ()], Type ())
fieldX) [([Name ()], Type ())]
end (DescriptorInfo -> Seq FieldInfo
fields DescriptorInfo
di)
                      end :: [([Name ()], Type ())]
end = (if DescriptorInfo -> Bool
hasExt DescriptorInfo
di then ([Name ()], Type ()) -> [([Name ()], Type ())]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Name ()], Type ())
extfield else [([Name ()], Type ())]
forall a. Monoid a => a
mempty) [([Name ()], Type ())]
-> [([Name ()], Type ())] -> [([Name ()], Type ())]
forall a. Semigroup a => a -> a -> a
<>
                            [([Name ()], Type ())]
eOneof [([Name ()], Type ())]
-> [([Name ()], Type ())] -> [([Name ()], Type ())]
forall a. Semigroup a => a -> a -> a
<>
                            (if DescriptorInfo -> Bool
storeUnknown DescriptorInfo
di then ([Name ()], Type ()) -> [([Name ()], Type ())]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Name ()], Type ())
unknownField else [([Name ()], Type ())]
forall a. Monoid a => a
mempty)
                      eOneof :: [([Name ()], Type ())]
eOneof = (OneofInfo -> [([Name ()], Type ())] -> [([Name ()], Type ())])
-> [([Name ()], Type ())]
-> Seq OneofInfo
-> [([Name ()], Type ())]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr ((:) (([Name ()], Type ())
 -> [([Name ()], Type ())] -> [([Name ()], Type ())])
-> (OneofInfo -> ([Name ()], Type ()))
-> OneofInfo
-> [([Name ()], Type ())]
-> [([Name ()], Type ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofInfo -> ([Name ()], Type ())
fieldOneofX) [] (DescriptorInfo -> Seq OneofInfo
descOneofs DescriptorInfo
di)

        bangType :: Type () -> Type ()
bangType = if DescriptorInfo -> Bool
lazyFields DescriptorInfo
di then () -> Type () -> Type ()
forall l. l -> Type l -> Type l
TyParen () {- UnBangedTy -} else () -> BangType () -> Unpackedness () -> Type () -> Type ()
forall l. l -> BangType l -> Unpackedness l -> Type l -> Type l
TyBang () (() -> BangType ()
forall l. l -> BangType l
BangedTy ()) (() -> Unpackedness ()
forall l. l -> Unpackedness l
NoUnpackPragma ()) (Type () -> Type ()) -> (Type () -> Type ()) -> Type () -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Type () -> Type ()
forall l. l -> Type l -> Type l
TyParen ()
        -- extfield :: ([Name],BangType)
        extfield :: ([Name ()], Type ())
extfield = ([DescriptorInfo -> String -> Name ()
fieldIdent DescriptorInfo
di String
"ext'field"], Type () -> Type ()
bangType (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (String -> QName ()
private String
"ExtField")))
        -- unknownField :: ([Name],BangType)
        unknownField :: ([Name ()], Type ())
unknownField = ([DescriptorInfo -> String -> Name ()
fieldIdent DescriptorInfo
di String
"unknown'field"], Type () -> Type ()
bangType (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (String -> QName ()
private  String
"UnknownField")))
        -- fieldX :: FieldInfo -> ([Name],BangType)
        fieldX :: FieldInfo -> ([Name ()], Type ())
fieldX FieldInfo
fi = ([ProtoFName -> Name ()
baseIdent' (ProtoFName -> Name ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName (FieldInfo -> Name ()) -> FieldInfo -> Name ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
fi], Type () -> Type ()
bangType (Type () -> Type ()
labeled (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () QName ()
typed)))
          where labeled :: Type () -> Type ()
labeled | FieldInfo -> Bool
canRepeat FieldInfo
fi = String -> Type () -> Type ()
typeApp String
"Seq"
                        | FieldInfo -> Bool
isRequired FieldInfo
fi = Type () -> Type ()
forall a. a -> a
id
                        | Bool
otherwise = String -> Type () -> Type ()
typeApp String
"Maybe"
                typed :: QName ()
                typed :: QName ()
typed = case Int -> Maybe String
useType (FieldType -> Int
getFieldType (FieldInfo -> FieldType
typeCode FieldInfo
fi)) of
                          Just String
s -> String -> QName ()
private String
s
                          Maybe String
Nothing -> case FieldInfo -> Maybe ProtoName
typeName FieldInfo
fi of
                                       Just ProtoName
s | ProtoName
self ProtoName -> ProtoName -> Bool
forall a. Eq a => a -> a -> Bool
/= ProtoName
s -> ProtoName -> QName ()
qualName ProtoName
s
                                              | Bool
otherwise -> ProtoName -> QName ()
unqualName ProtoName
s
                                       Maybe ProtoName
Nothing -> String -> QName ()
forall a. HasCallStack => String -> a
error (String -> QName ()) -> String -> QName ()
forall a b. (a -> b) -> a -> b
$  String
"No Name for Field!\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FieldInfo -> String
forall a. Show a => a -> String
show FieldInfo
fi
        fieldOneofX :: OneofInfo -> ([Name ()],Type ())
        fieldOneofX :: OneofInfo -> ([Name ()], Type ())
fieldOneofX OneofInfo
oi = ([ProtoFName -> Name ()
baseIdent' (ProtoFName -> Name ())
-> (OneofInfo -> ProtoFName) -> OneofInfo -> Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofInfo -> ProtoFName
oneofFName (OneofInfo -> Name ()) -> OneofInfo -> Name ()
forall a b. (a -> b) -> a -> b
$ OneofInfo
oi], String -> Type () -> Type ()
typeApp String
"Maybe" (() -> Type () -> Type ()
forall l. l -> Type l -> Type l
TyParen () (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () QName ()
typed)))
          where typed :: QName ()
typed = ProtoName -> QName ()
qualName (OneofInfo -> ProtoName
oneofName OneofInfo
oi)

instancesDescriptor :: DescriptorInfo -> [Decl ()]
instancesDescriptor :: DescriptorInfo -> [Decl ()]
instancesDescriptor DescriptorInfo
di = ((DescriptorInfo -> Decl ()) -> Decl ())
-> [DescriptorInfo -> Decl ()] -> [Decl ()]
forall a b. (a -> b) -> [a] -> [b]
map ((DescriptorInfo -> Decl ()) -> DescriptorInfo -> Decl ()
forall a b. (a -> b) -> a -> b
$ DescriptorInfo
di) ([DescriptorInfo -> Decl ()] -> [Decl ()])
-> [DescriptorInfo -> Decl ()] -> [Decl ()]
forall a b. (a -> b) -> a -> b
$
   (if DescriptorInfo -> Bool
hasExt DescriptorInfo
di then (DescriptorInfo -> Decl ()
instanceExtendMessage(DescriptorInfo -> Decl ())
-> [DescriptorInfo -> Decl ()] -> [DescriptorInfo -> Decl ()]
forall a. a -> [a] -> [a]
:) else [DescriptorInfo -> Decl ()] -> [DescriptorInfo -> Decl ()]
forall a. a -> a
id) ([DescriptorInfo -> Decl ()] -> [DescriptorInfo -> Decl ()])
-> [DescriptorInfo -> Decl ()] -> [DescriptorInfo -> Decl ()]
forall a b. (a -> b) -> a -> b
$
   (if DescriptorInfo -> Bool
storeUnknown DescriptorInfo
di then (DescriptorInfo -> Decl ()
instanceUnknownMessage(DescriptorInfo -> Decl ())
-> [DescriptorInfo -> Decl ()] -> [DescriptorInfo -> Decl ()]
forall a. a -> [a] -> [a]
:) else [DescriptorInfo -> Decl ()] -> [DescriptorInfo -> Decl ()]
forall a. a -> a
id) ([DescriptorInfo -> Decl ()] -> [DescriptorInfo -> Decl ()])
-> [DescriptorInfo -> Decl ()] -> [DescriptorInfo -> Decl ()]
forall a b. (a -> b) -> a -> b
$
   (if DescriptorInfo -> Bool
jsonInstances DescriptorInfo
di then ([DescriptorInfo -> Decl ()
instanceToJSON,DescriptorInfo -> Decl ()
instanceFromJSON][DescriptorInfo -> Decl ()]
-> [DescriptorInfo -> Decl ()] -> [DescriptorInfo -> Decl ()]
forall a. [a] -> [a] -> [a]
++) else [DescriptorInfo -> Decl ()] -> [DescriptorInfo -> Decl ()]
forall a. a -> a
id) ([DescriptorInfo -> Decl ()] -> [DescriptorInfo -> Decl ()])
-> [DescriptorInfo -> Decl ()] -> [DescriptorInfo -> Decl ()]
forall a b. (a -> b) -> a -> b
$
   [ DescriptorInfo -> Decl ()
instanceMergeable
   , DescriptorInfo -> Decl ()
instanceDefault
   , DescriptorInfo -> Decl ()
instanceWireDescriptor
   , ProtoName -> Decl ()
instanceMessageAPI (ProtoName -> Decl ())
-> (DescriptorInfo -> ProtoName) -> DescriptorInfo -> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DescriptorInfo -> ProtoName
descName
   , ProtoName -> Decl ()
instanceGPB (ProtoName -> Decl ())
-> (DescriptorInfo -> ProtoName) -> DescriptorInfo -> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DescriptorInfo -> ProtoName
descName
   , DescriptorInfo -> Decl ()
instanceReflectDescriptor
   , DescriptorInfo -> Decl ()
instanceTextType
   , DescriptorInfo -> Decl ()
instanceTextMsg
   ]

instanceExtendMessage :: DescriptorInfo -> Decl ()
instanceExtendMessage :: DescriptorInfo -> Decl ()
instanceExtendMessage DescriptorInfo
di
    = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"ExtendMessage") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (DescriptorInfo -> ProtoName
descName DescriptorInfo
di))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
        [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"getExtField" [] (() -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (DescriptorInfo -> String -> QName ()
localField DescriptorInfo
di String
"ext'field"))
        , String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"putExtField" [String -> Pat ()
patvar String
"e'f", String -> Pat ()
patvar String
"msg"] Exp ()
putextfield
        , String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"validExtRanges" [String -> Pat ()
patvar String
"msg"] (String -> Exp ()
pvar String
"extRanges" Exp () -> Exp () -> Exp ()
$$ (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
pvar String
"reflectDescriptorInfo" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"msg"))
        ]
  where putextfield :: Exp ()
putextfield = () -> Exp () -> [FieldUpdate ()] -> Exp ()
forall l. l -> Exp l -> [FieldUpdate l] -> Exp l
RecUpdate () (String -> Exp ()
lvar String
"msg") [ () -> QName () -> Exp () -> FieldUpdate ()
forall l. l -> QName l -> Exp l -> FieldUpdate l
FieldUpdate () (DescriptorInfo -> String -> QName ()
localField DescriptorInfo
di String
"ext'field") (String -> Exp ()
lvar String
"e'f") ]

instanceUnknownMessage :: DescriptorInfo -> Decl ()
instanceUnknownMessage :: DescriptorInfo -> Decl ()
instanceUnknownMessage DescriptorInfo
di
    = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"UnknownMessage") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (DescriptorInfo -> ProtoName
descName DescriptorInfo
di))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
        [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"getUnknownField" [] (() -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (DescriptorInfo -> String -> QName ()
localField DescriptorInfo
di String
"unknown'field"))
        , String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"putUnknownField" [String -> Pat ()
patvar String
"u'f",String -> Pat ()
patvar String
"msg"] Exp ()
putunknownfield
        ]
  where putunknownfield :: Exp ()
putunknownfield = () -> Exp () -> [FieldUpdate ()] -> Exp ()
forall l. l -> Exp l -> [FieldUpdate l] -> Exp l
RecUpdate () (String -> Exp ()
lvar String
"msg") [ () -> QName () -> Exp () -> FieldUpdate ()
forall l. l -> QName l -> Exp l -> FieldUpdate l
FieldUpdate () (DescriptorInfo -> String -> QName ()
localField DescriptorInfo
di String
"unknown'field") (String -> Exp ()
lvar String
"u'f") ]

instanceToJSON :: DescriptorInfo -> Decl ()
instanceToJSON :: DescriptorInfo -> Decl ()
instanceToJSON DescriptorInfo
di
  = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"ToJSON") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (DescriptorInfo -> ProtoName
descName DescriptorInfo
di))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
      [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"toJSON" [String -> Pat ()
patvar String
msgVar] Exp ()
serializeFun
      ]
  where
        flds :: [FieldInfo]
flds = Seq FieldInfo -> [FieldInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq FieldInfo
fields DescriptorInfo
di)
        os :: [OneofInfo]
os = Seq OneofInfo -> [OneofInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq OneofInfo
descOneofs DescriptorInfo
di)
        msgVar :: String
msgVar = String -> String
distinctVar String
"msg"
        reservedVars :: [String]
reservedVars = (FieldInfo -> String) -> [FieldInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo -> String
toPrintName [FieldInfo]
flds
        distinctVar :: String -> String
distinctVar String
var = if String
var String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reservedVars then String -> String
distinctVar (String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") else String
var
        getFname :: FieldInfo -> String
getFname FieldInfo
fld = FName String -> String
forall a. FName a -> a
fName (FName String -> String) -> FName String -> String
forall a b. (a -> b) -> a -> b
$ ProtoFName -> FName String
baseName' (ProtoFName -> FName String) -> ProtoFName -> FName String
forall a b. (a -> b) -> a -> b
$ FieldInfo -> ProtoFName
fieldName FieldInfo
fld
        toJSONFun :: FieldInfo -> Exp ()
toJSONFun FieldInfo
fld = case Int -> Type
forall a. Enum a => Int -> a
toEnum (FieldType -> Int
getFieldType (FieldInfo -> FieldType
typeCode FieldInfo
fld)) of
            Type
TYPE_INT64 -> String -> Exp ()
pvar String
"toJSONShowWithPayload"
            Type
TYPE_UINT64 -> String -> Exp ()
pvar String
"toJSONShowWithPayload"
            Type
TYPE_BYTES -> String -> Exp ()
pvar String
"toJSONByteString"
            Type
_ -> String -> Exp ()
pvar String
"toJSON"
        makeOneOfPair :: OneofInfo -> Exp ()
makeOneOfPair OneofInfo
oi =
            let Ident () String
funcname = ProtoFName -> Name ()
baseIdent' (OneofInfo -> ProtoFName
oneofFName OneofInfo
oi)
                oneOfFlds :: [(ProtoName, FieldInfo)]
oneOfFlds = Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (OneofInfo -> Seq (ProtoName, FieldInfo)
oneofFields OneofInfo
oi)
                caseAlt :: (ProtoName,FieldInfo) -> Alt ()
                caseAlt :: (ProtoName, FieldInfo) -> Alt ()
caseAlt (ProtoName, FieldInfo)
f = () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () Pat ()
patt (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () Exp ()
rhs) Maybe (Binds ())
noWhere
                  where patt :: Pat ()
patt = () -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () (String -> QName ()
prelude String
"Just") [(Pat (), Pat ()) -> Pat ()
forall a b. (a, b) -> a
fst ((ProtoName, FieldInfo) -> (Pat (), Pat ())
oneofPat (ProtoName, FieldInfo)
f)]
                        (Exp ()
rstr,Exp ()
rvar) = (ProtoName, FieldInfo) -> (Exp (), Exp ())
oneofRec (ProtoName, FieldInfo)
f
                        rhs :: Exp ()
rhs = () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () [() -> Boxed -> [Exp ()] -> Exp ()
forall l. l -> Boxed -> [Exp l] -> Exp l
Tuple () Boxed
Boxed [ Exp ()
rstr, FieldInfo -> Exp ()
toJSONFun ((ProtoName, FieldInfo) -> FieldInfo
forall a b. (a, b) -> b
snd (ProtoName, FieldInfo)
f) Exp () -> Exp () -> Exp ()
$$ Exp ()
rvar ] ]
                caseAltNothing :: Alt ()
                caseAltNothing :: Alt ()
caseAltNothing = () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (() -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () (String -> QName ()
prelude String
"Nothing") []) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () Exp ()
rhs) Maybe (Binds ())
noWhere
                  where rhs :: Exp ()
rhs = () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () []
            in () -> Exp () -> [Alt ()] -> Exp ()
forall l. l -> Exp l -> [Alt l] -> Exp l
Case () (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
lvar String
funcname Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
msgVar)) (((ProtoName, FieldInfo) -> Alt ())
-> [(ProtoName, FieldInfo)] -> [Alt ()]
forall a b. (a -> b) -> [a] -> [b]
map (ProtoName, FieldInfo) -> Alt ()
caseAlt [(ProtoName, FieldInfo)]
oneOfFlds [Alt ()] -> [Alt ()] -> [Alt ()]
forall a. [a] -> [a] -> [a]
++ [Alt ()
caseAltNothing])
        makePair :: FieldInfo -> Exp ()
makePair FieldInfo
fld =
            let fldName :: String
fldName = FieldInfo -> String
getFname FieldInfo
fld
                fldName' :: String
fldName' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'') String
fldName
                arg :: Exp ()
arg = () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
lvar String
fldName Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
msgVar)
                toJSONCall :: Exp ()
toJSONCall = case (FieldInfo -> Bool
isRequired FieldInfo
fld, FieldInfo -> Bool
canRepeat FieldInfo
fld) of
                    (Bool
True, Bool
False) -> FieldInfo -> Exp ()
toJSONFun FieldInfo
fld Exp () -> Exp () -> Exp ()
$$ Exp ()
arg
                    (Bool
_, Bool
_) -> String -> Exp ()
pvar String
"toJSON" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
preludevar String
"fmap" Exp () -> Exp () -> Exp ()
$$ FieldInfo -> Exp ()
toJSONFun FieldInfo
fld Exp () -> Exp () -> Exp ()
$$ Exp ()
arg)
            in () -> Boxed -> [Exp ()] -> Exp ()
forall l. l -> Boxed -> [Exp l] -> Exp l
Tuple () Boxed
Boxed
                  [ () -> Literal () -> Exp ()
forall l. l -> Literal l -> Exp l
Lit () (() -> String -> String -> Literal ()
forall l. l -> String -> String -> Literal l
String () String
fldName' (String -> String
forall a. Show a => a -> String
show String
fldName'))
                  , Exp ()
toJSONCall
                  ]
        serializeFun :: Exp ()
serializeFun =
            String -> Exp ()
pvar String
"objectNoEmpty" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp () -> Exp () -> Exp ()
mkOp String
"++" (() -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () ((FieldInfo -> Exp ()) -> [FieldInfo] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo -> Exp ()
makePair [FieldInfo]
flds)) (String -> Exp ()
preludevar String
"concat" Exp () -> Exp () -> Exp ()
$$ () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () ((OneofInfo -> Exp ()) -> [OneofInfo] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map OneofInfo -> Exp ()
makeOneOfPair [OneofInfo]
os)))

instanceFromJSON :: DescriptorInfo -> Decl ()
instanceFromJSON :: DescriptorInfo -> Decl ()
instanceFromJSON DescriptorInfo
di
  = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"FromJSON") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (DescriptorInfo -> ProtoName
descName DescriptorInfo
di))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
      [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"parseJSON" [] (String -> Exp ()
pvar String
"withObject" Exp () -> Exp () -> Exp ()
$$ () -> Literal () -> Exp ()
forall l. l -> Literal l -> Exp l
Lit () (() -> String -> String -> Literal ()
forall l. l -> String -> String -> Literal l
String () String
name (String -> String
forall a. Show a => a -> String
show String
name)) Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () Exp ()
parseFun)
      ]
  where
        name :: String
name = MName String -> String
forall a. MName a -> a
mName (MName String -> String) -> MName String -> String
forall a b. (a -> b) -> a -> b
$ ProtoName -> MName String
baseName (ProtoName -> MName String) -> ProtoName -> MName String
forall a b. (a -> b) -> a -> b
$ DescriptorInfo -> ProtoName
descName DescriptorInfo
di
        flds :: [FieldInfo]
flds = Seq FieldInfo -> [FieldInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq FieldInfo
fields DescriptorInfo
di)
        os :: [OneofInfo]
os = Seq OneofInfo -> [OneofInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq OneofInfo
descOneofs DescriptorInfo
di)
        reservedVars :: [String]
reservedVars = (FieldInfo -> String) -> [FieldInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo -> String
toPrintName [FieldInfo]
flds
        distinctVar :: String -> String
distinctVar String
var = if String
var String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reservedVars then String -> String
distinctVar (String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") else String
var
        objVar :: String
objVar = String -> String
distinctVar String
"o"
        getFname :: FieldInfo -> String
getFname FieldInfo
fld = FName String -> String
forall a. FName a -> a
fName (FName String -> String) -> FName String -> String
forall a b. (a -> b) -> a -> b
$ ProtoFName -> FName String
baseName' (ProtoFName -> FName String) -> ProtoFName -> FName String
forall a b. (a -> b) -> a -> b
$ FieldInfo -> ProtoFName
fieldName FieldInfo
fld
        getOneofFname :: OneofInfo -> String
getOneofFname OneofInfo
oi = FName String -> String
forall a. FName a -> a
fName (FName String -> String) -> FName String -> String
forall a b. (a -> b) -> a -> b
$ ProtoFName -> FName String
baseName' (ProtoFName -> FName String) -> ProtoFName -> FName String
forall a b. (a -> b) -> a -> b
$ OneofInfo -> ProtoFName
oneofFName OneofInfo
oi
        parseJSONFun :: FieldInfo -> Exp ()
parseJSONFun FieldInfo
fld = case Int -> Type
forall a. Enum a => Int -> a
toEnum (FieldType -> Int
getFieldType (FieldInfo -> FieldType
typeCode FieldInfo
fld)) of
            Type
TYPE_INT64 -> String -> Exp ()
pvar String
"parseJSONReadWithPayload" Exp () -> Exp () -> Exp ()
$$ () -> Literal () -> Exp ()
forall l. l -> Literal l -> Exp l
Lit () (() -> String -> String -> Literal ()
forall l. l -> String -> String -> Literal l
String () String
"int64" (String -> String
forall a. Show a => a -> String
show String
"int64"))
            Type
TYPE_UINT64 -> String -> Exp ()
pvar String
"parseJSONReadWithPayload" Exp () -> Exp () -> Exp ()
$$ () -> Literal () -> Exp ()
forall l. l -> Literal l -> Exp l
Lit () (() -> String -> String -> Literal ()
forall l. l -> String -> String -> Literal l
String () String
"uint64" (String -> String
forall a. Show a => a -> String
show String
"uint64"))
            Type
TYPE_BOOL -> String -> Exp ()
pvar String
"parseJSONBool"
            Type
TYPE_BYTES -> String -> Exp ()
pvar String
"parseJSONByteString"
            Type
_ -> String -> Exp ()
pvar String
"parseJSON"
        getOption :: (ProtoName, FieldInfo) -> Exp ()
getOption r :: (ProtoName, FieldInfo)
r@(ProtoName
_, FieldInfo
fi) =
            let fldName :: String
fldName = FieldInfo -> String
getFname FieldInfo
fi
            in String -> Exp ()
preludevar String
"fmap" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
preludevar String
"fmap" Exp () -> Exp () -> Exp ()
$$ (ProtoName, FieldInfo) -> Exp ()
oneofCon (ProtoName, FieldInfo)
r) Exp () -> Exp () -> Exp ()
$$
                  () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
pvar String
"explicitParseFieldMaybe" Exp () -> Exp () -> Exp ()
$$ FieldInfo -> Exp ()
parseJSONFun FieldInfo
fi Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
objVar Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
litStr String
fldName)
        getOneofValue :: OneofInfo -> Stmt ()
getOneofValue OneofInfo
oi =
            let fldName :: String
fldName = OneofInfo -> String
getOneofFname OneofInfo
oi
            in () -> Pat () -> Exp () -> Stmt ()
forall l. l -> Pat l -> Exp l -> Stmt l
Generator () (String -> Pat ()
patvar String
fldName) (String -> Exp ()
preludevar String
"fmap" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
pvar String
"msum" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
preludevar String
"sequence" Exp () -> Exp () -> Exp ()
$$ () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () ((((ProtoName, FieldInfo) -> Exp ())
-> [(ProtoName, FieldInfo)] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (ProtoName, FieldInfo) -> Exp ()
getOption (Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (OneofInfo -> Seq (ProtoName, FieldInfo)
oneofFields OneofInfo
oi)) [Exp ()] -> [Exp ()] -> [Exp ()]
forall a. [a] -> [a] -> [a]
++ [String -> Exp ()
preludevar String
"return" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
preludecon String
"Nothing"]))))
        getFieldValue :: FieldInfo -> Stmt ()
getFieldValue FieldInfo
fld =
            let fldName :: String
fldName = FieldInfo -> String
getFname FieldInfo
fld
                fldName' :: String
fldName' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'') String
fldName
                parseFieldFun :: Exp ()
parseFieldFun = case (FieldInfo -> Maybe HsDefault
hsDefault FieldInfo
fld, FieldInfo -> Bool
isRequired FieldInfo
fld) of
                  (Maybe HsDefault
Nothing, Bool
True) -> String -> Exp ()
pvar String
"explicitParseField"
                  (Maybe HsDefault, Bool)
_ -> String -> Exp ()
pvar String
"explicitParseFieldMaybe"
                parseJSONFun' :: Exp ()
parseJSONFun' = case FieldInfo -> Bool
canRepeat FieldInfo
fld of
                  Bool
False -> FieldInfo -> Exp ()
parseJSONFun FieldInfo
fld
                  Bool
True -> () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
preludevar String
"mapM" Exp () -> Exp () -> Exp ()
$$ FieldInfo -> Exp ()
parseJSONFun FieldInfo
fld Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
pvar String
"<=<" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
pvar String
"parseJSON")
                parseFieldCall :: Exp ()
parseFieldCall = Exp ()
parseFieldFun Exp () -> Exp () -> Exp ()
$$ Exp ()
parseJSONFun' Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
objVar Exp () -> Exp () -> Exp ()
$$ () -> Literal () -> Exp ()
forall l. l -> Literal l -> Exp l
Lit () (() -> String -> String -> Literal ()
forall l. l -> String -> String -> Literal l
String () String
fldName' (String -> String
forall a. Show a => a -> String
show String
fldName'))
                parseFieldCall' :: Exp ()
parseFieldCall' = case FieldInfo -> Bool
canRepeat FieldInfo
fld of
                  Bool
False -> Exp ()
parseFieldCall
                  Bool
True -> String -> Exp ()
preludevar String
"fmap" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
preludevar String
"maybe" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
preludevar String
"mempty" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
preludevar String
"id") Exp () -> Exp () -> Exp ()
$$ Exp ()
parseFieldCall
                parseFieldCall'' :: Exp ()
parseFieldCall'' = case (FieldInfo -> Maybe HsDefault
hsDefault FieldInfo
fld, FieldInfo -> Bool
canRepeat FieldInfo
fld) of
                  (Maybe HsDefault
_ , Bool
True)  -> Exp ()
parseFieldCall'
                  (Maybe HsDefault
Nothing, Bool
False)  -> Exp ()
parseFieldCall'
                  (Just HsDefault
d, Bool
False) ->
                    let defLit :: Exp ()
defLit = FieldType -> HsDefault -> Exp ()
defToSyntax (FieldInfo -> FieldType
typeCode FieldInfo
fld) HsDefault
d
                        defParse :: Exp ()
defParse = case FieldInfo -> Bool
isRequired FieldInfo
fld of
                          Bool
True -> () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () Exp ()
defLit
                          Bool
False -> () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
preludecon String
"Just" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () Exp ()
defLit)
                        tmpVar :: String
tmpVar = String -> String
distinctVar String
"tmp"
                        modfun :: Exp ()
modfun = if FieldInfo -> Bool
isRequired FieldInfo
fld then String -> Exp ()
preludevar String
"id" else String -> Exp ()
preludecon String
"Just"
                    in () -> [Stmt ()] -> Exp ()
forall l. l -> [Stmt l] -> Exp l
Do ()
                       [ () -> Pat () -> Exp () -> Stmt ()
forall l. l -> Pat l -> Exp l -> Stmt l
Generator () (String -> Pat ()
patvar String
tmpVar) Exp ()
parseFieldCall'
                       , () -> Exp () -> Stmt ()
forall l. l -> Exp l -> Stmt l
Qualifier () (Exp () -> Stmt ()) -> Exp () -> Stmt ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
preludevar String
"return" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
preludevar String
"maybe" Exp () -> Exp () -> Exp ()
$$ Exp ()
defParse Exp () -> Exp () -> Exp ()
$$ Exp ()
modfun Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
tmpVar)
                       ]
            in () -> Pat () -> Exp () -> Stmt ()
forall l. l -> Pat l -> Exp l -> Stmt l
Generator () (String -> Pat ()
patvar String
fldName) Exp ()
parseFieldCall''
        updates :: [FieldUpdate ()]
updates =
                ((FieldInfo -> FieldUpdate ()) -> [FieldInfo] -> [FieldUpdate ()]
forall a b. (a -> b) -> [a] -> [b]
map (\FieldInfo
fld -> () -> QName () -> Exp () -> FieldUpdate ()
forall l. l -> QName l -> Exp l -> FieldUpdate l
FieldUpdate () (String -> QName ()
local (FieldInfo -> String
getFname FieldInfo
fld)) (String -> Exp ()
lvar (FieldInfo -> String
getFname FieldInfo
fld))) [FieldInfo]
flds) [FieldUpdate ()] -> [FieldUpdate ()] -> [FieldUpdate ()]
forall a. [a] -> [a] -> [a]
++
                ((OneofInfo -> FieldUpdate ()) -> [OneofInfo] -> [FieldUpdate ()]
forall a b. (a -> b) -> [a] -> [b]
map (\OneofInfo
oi -> () -> QName () -> Exp () -> FieldUpdate ()
forall l. l -> QName l -> Exp l -> FieldUpdate l
FieldUpdate () (String -> QName ()
local (OneofInfo -> String
getOneofFname OneofInfo
oi)) (String -> Exp ()
lvar (OneofInfo -> String
getOneofFname OneofInfo
oi))) [OneofInfo]
os)
        retVal :: Exp ()
retVal =
            case [FieldUpdate ()]
updates of
              [] -> String -> Exp ()
pvar String
"defaultValue"
              (FieldUpdate ()
_:[FieldUpdate ()]
_) -> () -> Exp () -> [FieldUpdate ()] -> Exp ()
forall l. l -> Exp l -> [FieldUpdate l] -> Exp l
RecUpdate () (String -> Exp ()
pvar String
"defaultValue") [FieldUpdate ()]
updates
        parseFun :: Exp ()
parseFun = () -> [Pat ()] -> Exp () -> Exp ()
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda () [String -> Pat ()
patvar String
objVar] (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ () -> [Stmt ()] -> Exp ()
forall l. l -> [Stmt l] -> Exp l
Do () ([Stmt ()] -> Exp ()) -> [Stmt ()] -> Exp ()
forall a b. (a -> b) -> a -> b
$
            (FieldInfo -> Stmt ()) -> [FieldInfo] -> [Stmt ()]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo -> Stmt ()
getFieldValue [FieldInfo]
flds [Stmt ()] -> [Stmt ()] -> [Stmt ()]
forall a. [a] -> [a] -> [a]
++
            (OneofInfo -> Stmt ()) -> [OneofInfo] -> [Stmt ()]
forall a b. (a -> b) -> [a] -> [b]
map OneofInfo -> Stmt ()
getOneofValue [OneofInfo]
os [Stmt ()] -> [Stmt ()] -> [Stmt ()]
forall a. [a] -> [a] -> [a]
++
            [ () -> Exp () -> Stmt ()
forall l. l -> Exp l -> Stmt l
Qualifier () (Exp () -> Stmt ()) -> Exp () -> Stmt ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
preludevar String
"return" Exp () -> Exp () -> Exp ()
$$ Exp ()
retVal ]

instanceTextType :: DescriptorInfo -> Decl ()
instanceTextType :: DescriptorInfo -> Decl ()
instanceTextType DescriptorInfo
di
  = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"TextType") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (DescriptorInfo -> ProtoName
descName DescriptorInfo
di))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
      [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"tellT" [] (String -> Exp ()
pvar String
"tellSubMessage")
      , String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"getT" [] (String -> Exp ()
pvar String
"getSubMessage")
      ]


instanceTextMsg :: DescriptorInfo -> Decl ()
instanceTextMsg :: DescriptorInfo -> Decl ()
instanceTextMsg DescriptorInfo
di
  = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"TextMsg") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (DescriptorInfo -> ProtoName
descName DescriptorInfo
di))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
      [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"textPut" [String -> Pat ()
patvar String
msgVar] Exp ()
genPrint
      , () -> Decl () -> InstDecl ()
forall l. l -> Decl l -> InstDecl l
InsDecl () (Decl () -> InstDecl ()) -> Decl () -> InstDecl ()
forall a b. (a -> b) -> a -> b
$ () -> [Match ()] -> Decl ()
forall l. l -> [Match l] -> Decl l
FunBind () [() -> Name () -> [Pat ()] -> Rhs () -> Maybe (Binds ()) -> Match ()
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"textGet") [] (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () Exp ()
parser) Maybe (Binds ())
bdecls]
      ]
  where
        bdecls :: Maybe (Binds ())
bdecls = Binds () -> Maybe (Binds ())
forall a. a -> Maybe a
Just (() -> [Decl ()] -> Binds ()
forall l. l -> [Decl l] -> Binds l
BDecls () ([Decl ()]
subparsers [Decl ()] -> [Decl ()] -> [Decl ()]
forall a. [a] -> [a] -> [a]
++ [Decl ()]
subparsersO))
        flds :: [FieldInfo]
flds = Seq FieldInfo -> [FieldInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq FieldInfo
fields DescriptorInfo
di)
        os :: [OneofInfo]
os = Seq OneofInfo -> [OneofInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq OneofInfo
descOneofs DescriptorInfo
di)
        msgVar :: String
msgVar = String -> String
distinctVar String
"msg"
        distinctVar :: String -> String
distinctVar String
var = if String
var String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reservedVars then String -> String
distinctVar (String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") else String
var
        reservedVars :: [String]
reservedVars = (FieldInfo -> String) -> [FieldInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo -> String
toPrintName [FieldInfo]
flds
        genPrintFields :: [Stmt ()]
genPrintFields = (FieldInfo -> Stmt ()) -> [FieldInfo] -> [Stmt ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> Exp () -> Stmt ()
forall l. l -> Exp l -> Stmt l
Qualifier () (Exp () -> Stmt ())
-> (FieldInfo -> Exp ()) -> FieldInfo -> Stmt ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FieldInfo -> Exp ()
printField String
msgVar) [FieldInfo]
flds
        genPrintOneofs :: [Stmt ()]
genPrintOneofs = (OneofInfo -> Stmt ()) -> [OneofInfo] -> [Stmt ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> Exp () -> Stmt ()
forall l. l -> Exp l -> Stmt l
Qualifier () (Exp () -> Stmt ())
-> (OneofInfo -> Exp ()) -> OneofInfo -> Stmt ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OneofInfo -> Exp ()
printOneof String
msgVar) [OneofInfo]
os
        genPrint :: Exp ()
genPrint = if [FieldInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldInfo]
flds Bool -> Bool -> Bool
&& [OneofInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OneofInfo]
os
                   then String -> Exp ()
preludevar String
"return" Exp () -> Exp () -> Exp ()
$$ () -> Boxed -> [Exp ()] -> Exp ()
forall l. l -> Boxed -> [Exp l] -> Exp l
Hse.Tuple () Boxed
Boxed []
                   else () -> [Stmt ()] -> Exp ()
forall l. l -> [Stmt l] -> Exp l
Do () ([Stmt ()] -> Exp ()) -> [Stmt ()] -> Exp ()
forall a b. (a -> b) -> a -> b
$ [Stmt ()]
genPrintFields [Stmt ()] -> [Stmt ()] -> [Stmt ()]
forall a. [a] -> [a] -> [a]
++ [Stmt ()]
genPrintOneofs

        parser :: Exp ()
parser
            | [FieldInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldInfo]
flds Bool -> Bool -> Bool
&& [OneofInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OneofInfo]
os = String -> Exp ()
preludevar String
"return" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
pvar String
"defaultValue"
            | Bool
otherwise = () -> [Stmt ()] -> Exp ()
forall l. l -> [Stmt l] -> Exp l
Do () [
                () -> Pat () -> Exp () -> Stmt ()
forall l. l -> Pat l -> Exp l -> Stmt l
Generator () (String -> Pat ()
patvar String
"mods")
                    (Exp () -> Stmt ()) -> Exp () -> Stmt ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
pvar String
"sepEndBy"
                        Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
pvar String
"choice" Exp () -> Exp () -> Exp ()
$$ () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () ((FieldInfo -> Exp ()) -> [FieldInfo] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Exp ()
lvar (String -> Exp ()) -> (FieldInfo -> String) -> FieldInfo -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> String
parserName) [FieldInfo]
flds [Exp ()] -> [Exp ()] -> [Exp ()]
forall a. [a] -> [a] -> [a]
++ (OneofInfo -> Exp ()) -> [OneofInfo] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Exp ()
lvar (String -> Exp ()) -> (OneofInfo -> String) -> OneofInfo -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofInfo -> String
parserNameO) [OneofInfo]
os))
                        Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
pvar String
"spaces",
                () -> Exp () -> Stmt ()
forall l. l -> Exp l -> Stmt l
Qualifier () (Exp () -> Stmt ()) -> Exp () -> Stmt ()
forall a b. (a -> b) -> a -> b
$ (String -> Exp ()
preludevar String
"return")
                    Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
preludevar String
"foldl"
                        Exp () -> Exp () -> Exp ()
$$ () -> [Pat ()] -> Exp () -> Exp ()
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda () [String -> Pat ()
patvar String
"v", String -> Pat ()
patvar String
"f"] (String -> Exp ()
lvar String
"f" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"v")
                        Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
pvar String
"defaultValue"
                        Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"mods")
             ]
        parserName :: FieldInfo -> String
parserName FieldInfo
f = let Ident () String
fname = ProtoFName -> Name ()
baseIdent' (FieldInfo -> ProtoFName
fieldName FieldInfo
f) in String
"parse'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fname
        parserNameO :: OneofInfo -> String
parserNameO OneofInfo
o = let Ident () String
oname = ProtoFName -> Name ()
baseIdent' (OneofInfo -> ProtoFName
oneofFName OneofInfo
o) in String
"parse'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
oname
        subparsers :: [Decl ()]
subparsers = (FieldInfo -> Decl ()) -> [FieldInfo] -> [Decl ()]
forall a b. (a -> b) -> [a] -> [b]
map (\FieldInfo
f -> String -> [Pat ()] -> Exp () -> Decl ()
defun (FieldInfo -> String
parserName FieldInfo
f) [] (FieldInfo -> Exp ()
getField FieldInfo
f)) [FieldInfo]
flds
        getField :: FieldInfo -> Exp ()
getField FieldInfo
fi = let printname :: String
printname = FieldInfo -> String
toPrintName FieldInfo
fi
                          Ident () String
funcname = ProtoFName -> Name ()
baseIdent' (FieldInfo -> ProtoFName
fieldName FieldInfo
fi)
                          update :: Exp ()
update = if FieldInfo -> Bool
canRepeat FieldInfo
fi then String -> Exp ()
pvar String
"append" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
lvar String
funcname Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"o") Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"v" else String -> Exp ()
lvar String
"v"
            in String -> Exp ()
pvar String
"try" Exp () -> Exp () -> Exp ()
$$ () -> [Stmt ()] -> Exp ()
forall l. l -> [Stmt l] -> Exp l
Do () [
                () -> Pat () -> Exp () -> Stmt ()
forall l. l -> Pat l -> Exp l -> Stmt l
Generator () (String -> Pat ()
patvar String
"v") (Exp () -> Stmt ()) -> Exp () -> Stmt ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
pvar String
"getT" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
litStr String
printname,
                () -> Exp () -> Stmt ()
forall l. l -> Exp l -> Stmt l
Qualifier () (Exp () -> Stmt ()) -> Exp () -> Stmt ()
forall a b. (a -> b) -> a -> b
$ (String -> Exp ()
preludevar String
"return")
                    Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (() -> [Pat ()] -> Exp () -> Exp ()
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda () [String -> Pat ()
patvar String
"o"]
                        (() -> Exp () -> [FieldUpdate ()] -> Exp ()
forall l. l -> Exp l -> [FieldUpdate l] -> Exp l
RecUpdate () (String -> Exp ()
lvar String
"o") [ () -> QName () -> Exp () -> FieldUpdate ()
forall l. l -> QName l -> Exp l -> FieldUpdate l
FieldUpdate () (String -> QName ()
local String
funcname) Exp ()
update]))
            ]

        subparsersO :: [Decl ()]
subparsersO = (OneofInfo -> Decl ()) -> [OneofInfo] -> [Decl ()]
forall a b. (a -> b) -> [a] -> [b]
map OneofInfo -> Decl ()
funbind [OneofInfo]
os
        funbind :: OneofInfo -> Decl ()
funbind OneofInfo
o = () -> [Match ()] -> Decl ()
forall l. l -> [Match l] -> Decl l
FunBind () [() -> Name () -> [Pat ()] -> Rhs () -> Maybe (Binds ()) -> Match ()
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () (OneofInfo -> String
parserNameO OneofInfo
o)) [] (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp ()
getOneof)) Maybe (Binds ())
whereParse]
          where getOneof :: Exp ()
getOneof = String -> Exp ()
pvar String
"try" Exp () -> Exp () -> Exp ()
$$
                             (String -> Exp ()
pvar String
"choice" Exp () -> Exp () -> Exp ()
$$ () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () ((String -> Exp ()) -> [String] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (QName () -> Exp ()) -> (String -> QName ()) -> String -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name () -> QName ()) -> (String -> Name ()) -> String -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> String -> Name ()
forall l. l -> String -> Name l
Ident ()) [String]
parsefs))
                oflds :: [(ProtoName, FieldInfo)]
oflds = Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (OneofInfo -> Seq (ProtoName, FieldInfo)
oneofFields OneofInfo
o)
                flds :: [FieldInfo]
flds = ((ProtoName, FieldInfo) -> FieldInfo)
-> [(ProtoName, FieldInfo)] -> [FieldInfo]
forall a b. (a -> b) -> [a] -> [b]
map (ProtoName, FieldInfo) -> FieldInfo
forall a b. (a, b) -> b
snd [(ProtoName, FieldInfo)]
oflds
                parsefs :: [String]
parsefs = (FieldInfo -> String) -> [FieldInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo -> String
parserName [FieldInfo]
flds
                whereParse :: Maybe (Binds ())
whereParse = Binds () -> Maybe (Binds ())
whereBinds (Binds () -> Maybe (Binds ())) -> Binds () -> Maybe (Binds ())
forall a b. (a -> b) -> a -> b
$ () -> [Decl ()] -> Binds ()
forall l. l -> [Decl l] -> Binds l
BDecls () (((ProtoName, FieldInfo) -> Decl ())
-> [(ProtoName, FieldInfo)] -> [Decl ()]
forall a b. (a -> b) -> [a] -> [b]
map (ProtoName, FieldInfo) -> Decl ()
decl [(ProtoName, FieldInfo)]
oflds)
                  where decl :: (ProtoName, FieldInfo) -> Decl ()
decl (ProtoName
n,FieldInfo
f) = String -> [Pat ()] -> Exp () -> Decl ()
defun (FieldInfo -> String
parserName FieldInfo
f) [] ((ProtoName, FieldInfo) -> Exp ()
getOneofField (ProtoName
n,FieldInfo
f))
                        getOneofField :: (ProtoName, FieldInfo) -> Exp ()
getOneofField p :: (ProtoName, FieldInfo)
p@(ProtoName
n,FieldInfo
f) =
                          let Ident () String
oname = ProtoFName -> Name ()
baseIdent' (OneofInfo -> ProtoFName
oneofFName OneofInfo
o)
                              printname :: String
printname = FieldInfo -> String
toPrintName FieldInfo
f
                              update :: Exp ()
update = String -> Exp ()
preludecon String
"Just" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () ((ProtoName, FieldInfo) -> Exp ()
oneofCon (ProtoName, FieldInfo)
p Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"v")
                          in String -> Exp ()
pvar String
"try" Exp () -> Exp () -> Exp ()
$$ () -> [Stmt ()] -> Exp ()
forall l. l -> [Stmt l] -> Exp l
Do () [
                               () -> Pat () -> Exp () -> Stmt ()
forall l. l -> Pat l -> Exp l -> Stmt l
Generator () (String -> Pat ()
patvar String
"v") (Exp () -> Stmt ()) -> Exp () -> Stmt ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
pvar String
"getT" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
litStr String
printname,
                               () -> Exp () -> Stmt ()
forall l. l -> Exp l -> Stmt l
Qualifier () (Exp () -> Stmt ()) -> Exp () -> Stmt ()
forall a b. (a -> b) -> a -> b
$ (String -> Exp ()
preludevar String
"return")
                               Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (() -> [Pat ()] -> Exp () -> Exp ()
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda () [String -> Pat ()
patvar String
"s"]
                                (() -> Exp () -> [FieldUpdate ()] -> Exp ()
forall l. l -> Exp l -> [FieldUpdate l] -> Exp l
RecUpdate () (String -> Exp ()
lvar String
"s") [ () -> QName () -> Exp () -> FieldUpdate ()
forall l. l -> QName l -> Exp l -> FieldUpdate l
FieldUpdate () (String -> QName ()
local String
oname) Exp ()
update]))
                               ]


printField :: String -> FieldInfo -> Exp ()
printField :: String -> FieldInfo -> Exp ()
printField String
msgVar FieldInfo
fi
  = let Ident () String
funcname = ProtoFName -> Name ()
baseIdent' (FieldInfo -> ProtoFName
fieldName FieldInfo
fi)
        printname :: String
printname = FieldInfo -> String
toPrintName FieldInfo
fi
    in String -> Exp ()
pvar String
"tellT" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
litStr String
printname Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
lvar String
funcname Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
msgVar)

toPrintName :: FieldInfo -> String
toPrintName :: FieldInfo -> String
toPrintName FieldInfo
fi = let IName Utf8
uname = [IName Utf8] -> IName Utf8
forall a. [a] -> a
last ([IName Utf8] -> IName Utf8) -> [IName Utf8] -> IName Utf8
forall a b. (a -> b) -> a -> b
$ FIName Utf8 -> [IName Utf8]
forall a. Dotted a => FIName a -> [IName a]
splitFI (FIName Utf8 -> [IName Utf8]) -> FIName Utf8 -> [IName Utf8]
forall a b. (a -> b) -> a -> b
$ ProtoFName -> FIName Utf8
protobufName' (FieldInfo -> ProtoFName
fieldName FieldInfo
fi) in Utf8 -> String
uToString Utf8
uname

printOneof :: String -> OneofInfo -> Exp ()
printOneof :: String -> OneofInfo -> Exp ()
printOneof String
msgVar OneofInfo
oi
    = () -> Exp () -> [Alt ()] -> Exp ()
forall l. l -> Exp l -> [Alt l] -> Exp l
Case () (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
lvar String
funcname Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
msgVar)) (((ProtoName, FieldInfo) -> Alt ())
-> [(ProtoName, FieldInfo)] -> [Alt ()]
forall a b. (a -> b) -> [a] -> [b]
map (ProtoName, FieldInfo) -> Alt ()
caseAlt [(ProtoName, FieldInfo)]
flds [Alt ()] -> [Alt ()] -> [Alt ()]
forall a. [a] -> [a] -> [a]
++ [Alt ()
caseAltNothing])
  where Ident () String
funcname = ProtoFName -> Name ()
baseIdent' (OneofInfo -> ProtoFName
oneofFName OneofInfo
oi)
        flds :: [(ProtoName, FieldInfo)]
flds = Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (OneofInfo -> Seq (ProtoName, FieldInfo)
oneofFields OneofInfo
oi)
        caseAlt :: (ProtoName,FieldInfo) -> Alt ()
        caseAlt :: (ProtoName, FieldInfo) -> Alt ()
caseAlt (ProtoName, FieldInfo)
f = () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () Pat ()
patt  (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () Exp ()
rhs) Maybe (Binds ())
noWhere
          where patt :: Pat ()
patt = () -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () (String -> QName ()
prelude String
"Just") [(Pat (), Pat ()) -> Pat ()
forall a b. (a, b) -> a
fst ((ProtoName, FieldInfo) -> (Pat (), Pat ())
oneofPat (ProtoName, FieldInfo)
f)]
                (Exp ()
rstr,Exp ()
rvar) = (ProtoName, FieldInfo) -> (Exp (), Exp ())
oneofRec (ProtoName, FieldInfo)
f
                rhs :: Exp ()
rhs = String -> Exp ()
pvar String
"tellT" Exp () -> Exp () -> Exp ()
$$ Exp ()
rstr Exp () -> Exp () -> Exp ()
$$ Exp ()
rvar -- litStr fname $$ (lvar fname)
        caseAltNothing :: Alt ()
        caseAltNothing :: Alt ()
caseAltNothing = () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (() -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () (String -> QName ()
prelude String
"Nothing") []) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () Exp ()
rhs) Maybe (Binds ())
noWhere
          where rhs :: Exp ()
rhs = String -> Exp ()
preludevar String
"return" Exp () -> Exp () -> Exp ()
$$ () -> Exp ()
forall l. l -> Exp l
unit_con ()

instanceMergeable :: DescriptorInfo -> Decl ()
instanceMergeable :: DescriptorInfo -> Decl ()
instanceMergeable DescriptorInfo
di
    = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"Mergeable") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () QName ()
un]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
        [ -- inst "mergeEmpty" [] (foldl' App (Con un) (replicate len (pvar "mergeEmpty"))),
          String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"mergeAppend" [() -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () QName ()
un [Pat ()]
patternVars1, () -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () QName ()
un [Pat ()]
patternVars2]
                             ((Exp () -> Exp () -> Exp ()) -> Exp () -> [Exp ()] -> Exp ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (() -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
App ()) (() -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Con () QName ()
un) ((Exp () -> Exp () -> Exp ()) -> [Exp ()] -> [Exp ()] -> [Exp ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Exp () -> Exp () -> Exp ()
append [Exp ()]
vars1 [Exp ()]
vars2))
        ]
  where un :: QName ()
un = ProtoName -> QName ()
unqualName (DescriptorInfo -> ProtoName
descName DescriptorInfo
di)
        len :: Int
len = (if DescriptorInfo -> Bool
hasExt DescriptorInfo
di then Int -> Int
forall a. Enum a => a -> a
succ else Int -> Int
forall a. a -> a
id)
            (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (if DescriptorInfo -> Bool
storeUnknown DescriptorInfo
di then Int -> Int
forall a. Enum a => a -> a
succ else Int -> Int
forall a. a -> a
id)
            (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Seq FieldInfo -> Int
forall a. Seq a -> Int
Seq.length (DescriptorInfo -> Seq FieldInfo
fields DescriptorInfo
di) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq OneofInfo -> Int
forall a. Seq a -> Int
Seq.length (DescriptorInfo -> Seq OneofInfo
descOneofs DescriptorInfo
di)
        patternVars1,patternVars2 :: [Pat ()]
        patternVars1 :: [Pat ()]
patternVars1 = Int -> [Pat ()] -> [Pat ()]
forall a. Int -> [a] -> [a]
take Int
len [Pat ()]
inf
            where inf :: [Pat ()]
inf = (Int -> Pat ()) -> [Int] -> [Pat ()]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
n -> String -> Pat ()
patvar (String
"x'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)) [(Int
1::Int)..]
        patternVars2 :: [Pat ()]
patternVars2 = Int -> [Pat ()] -> [Pat ()]
forall a. Int -> [a] -> [a]
take Int
len [Pat ()]
inf
            where inf :: [Pat ()]
inf = (Int -> Pat ()) -> [Int] -> [Pat ()]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
n -> String -> Pat ()
patvar (String
"y'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)) [(Int
1::Int)..]
        vars1,vars2 :: [Exp ()]
        vars1 :: [Exp ()]
vars1 = Int -> [Exp ()] -> [Exp ()]
forall a. Int -> [a] -> [a]
take Int
len [Exp ()]
inf
            where inf :: [Exp ()]
inf = (Int -> Exp ()) -> [Int] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
n -> String -> Exp ()
lvar (String
"x'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)) [(Int
1::Int)..]
        vars2 :: [Exp ()]
vars2 = Int -> [Exp ()] -> [Exp ()]
forall a. Int -> [a] -> [a]
take Int
len [Exp ()]
inf
            where inf :: [Exp ()]
inf = (Int -> Exp ()) -> [Int] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
n -> String -> Exp ()
lvar (String
"y'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)) [(Int
1::Int)..]
        append :: Exp () -> Exp () -> Exp ()
append Exp ()
x Exp ()
y = () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
pvar String
"mergeAppend" Exp () -> Exp () -> Exp ()
$$ Exp ()
x Exp () -> Exp () -> Exp ()
$$ Exp ()
y

instanceDefault :: DescriptorInfo -> Decl ()
instanceDefault :: DescriptorInfo -> Decl ()
instanceDefault DescriptorInfo
di
    = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"Default") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () QName ()
un]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
        [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"defaultValue" [] ((Exp () -> Exp () -> Exp ()) -> Exp () -> [Exp ()] -> Exp ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (() -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
App ()) (() -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Con () QName ()
un) [Exp ()]
deflistExt) ]
  where un :: QName ()
un = ProtoName -> QName ()
unqualName (DescriptorInfo -> ProtoName
descName DescriptorInfo
di)
        deflistExt :: [Exp ()]
deflistExt = (FieldInfo -> [Exp ()] -> [Exp ()])
-> [Exp ()] -> Seq FieldInfo -> [Exp ()]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr ((:) (Exp () -> [Exp ()] -> [Exp ()])
-> (FieldInfo -> Exp ()) -> FieldInfo -> [Exp ()] -> [Exp ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> Exp ()
defX) [Exp ()]
end (DescriptorInfo -> Seq FieldInfo
fields DescriptorInfo
di)
        end :: [Exp ()]
end = (if DescriptorInfo -> Bool
hasExt DescriptorInfo
di then (String -> Exp ()
pvar String
"defaultValue"Exp () -> [Exp ()] -> [Exp ()]
forall a. a -> [a] -> [a]
:) else [Exp ()] -> [Exp ()]
forall a. a -> a
id)
            ([Exp ()] -> [Exp ()])
-> ([Exp ()] -> [Exp ()]) -> [Exp ()] -> [Exp ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if DescriptorInfo -> Bool
storeUnknown DescriptorInfo
di then (String -> Exp ()
pvar String
"defaultValue"Exp () -> [Exp ()] -> [Exp ()]
forall a. a -> [a] -> [a]
:) else [Exp ()] -> [Exp ()]
forall a. a -> a
id)
            ([Exp ()] -> [Exp ()]) -> [Exp ()] -> [Exp ()]
forall a b. (a -> b) -> a -> b
$ (OneofInfo -> [Exp ()] -> [Exp ()])
-> [Exp ()] -> Seq OneofInfo -> [Exp ()]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr ((:) (Exp () -> [Exp ()] -> [Exp ()])
-> (OneofInfo -> Exp ()) -> OneofInfo -> [Exp ()] -> [Exp ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofInfo -> Exp ()
defOneof) [] (DescriptorInfo -> Seq OneofInfo
descOneofs DescriptorInfo
di)

        defX :: FieldInfo -> Exp ()
        defX :: FieldInfo -> Exp ()
defX FieldInfo
fi | FieldInfo -> Bool
isRequired FieldInfo
fi = Exp ()
dv1
                | Bool
otherwise = Exp ()
dv2
          where dv1 :: Exp ()
dv1 = case FieldInfo -> Maybe HsDefault
hsDefault FieldInfo
fi of
                        Maybe HsDefault
Nothing -> String -> Exp ()
pvar String
"defaultValue"
                        Just HsDefault
hsdef -> FieldType -> HsDefault -> Exp ()
defToSyntax (FieldInfo -> FieldType
typeCode FieldInfo
fi) HsDefault
hsdef
                dv2 :: Exp ()
dv2 = case FieldInfo -> Maybe HsDefault
hsDefault FieldInfo
fi of
                        Maybe HsDefault
Nothing -> String -> Exp ()
pvar String
"defaultValue"
                        Just HsDefault
hsdef -> () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
preludecon String
"Just" Exp () -> Exp () -> Exp ()
$$ FieldType -> HsDefault -> Exp ()
defToSyntax (FieldInfo -> FieldType
typeCode FieldInfo
fi) HsDefault
hsdef
        defOneof :: OneofInfo -> Exp ()
        defOneof :: OneofInfo -> Exp ()
defOneof OneofInfo
oi= String -> Exp ()
pvar String
"defaultValue"


instanceMessageAPI :: ProtoName -> Decl ()
instanceMessageAPI :: ProtoName -> Decl ()
instanceMessageAPI ProtoName
protoName
    = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"MessageAPI")
        [() -> Name () -> Type ()
forall l. l -> Name l -> Type l
TyVar () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"msg'"), () -> Type () -> Type ()
forall l. l -> Type l -> Type l
TyParen () (() -> Type () -> Type () -> Type ()
forall l. l -> Type l -> Type l -> Type l
TyFun () (() -> Name () -> Type ()
forall l. l -> Name l -> Type l
TyVar () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"msg'")) (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () QName ()
un)), (() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () QName ()
un)]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
        [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"getVal" [String -> Pat ()
patvar String
"m'",String -> Pat ()
patvar String
"f'"] (() -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
App () (String -> Exp ()
lvar String
"f'" ) (String -> Exp ()
lvar String
"m'")) ]
  where un :: QName ()
un = ProtoName -> QName ()
unqualName ProtoName
protoName

instanceWireDescriptor :: DescriptorInfo -> Decl ()
instanceWireDescriptor :: DescriptorInfo -> Decl ()
instanceWireDescriptor di :: DescriptorInfo
di@(DescriptorInfo { descName :: DescriptorInfo -> ProtoName
descName = ProtoName
protoName
                                          , fields :: DescriptorInfo -> Seq FieldInfo
fields = Seq FieldInfo
fieldInfos
                                          , descOneofs :: DescriptorInfo -> Seq OneofInfo
descOneofs = Seq OneofInfo
oneofInfos
                                          , extRanges :: DescriptorInfo -> [(FieldId, FieldId)]
extRanges = [(FieldId, FieldId)]
allowedExts
                                          , knownKeys :: DescriptorInfo -> Seq FieldInfo
knownKeys = Seq FieldInfo
fieldExts })
  = let me :: QName ()
me = ProtoName -> QName ()
unqualName ProtoName
protoName
        extensible :: Bool
extensible = Bool -> Bool
not ([(FieldId, FieldId)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldId, FieldId)]
allowedExts)
        len :: Int
len = (if Bool
extensible then Int -> Int
forall a. Enum a => a -> a
succ else Int -> Int
forall a. a -> a
id)
            (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (if DescriptorInfo -> Bool
storeUnknown DescriptorInfo
di then Int -> Int
forall a. Enum a => a -> a
succ else Int -> Int
forall a. a -> a
id)
            (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Seq FieldInfo -> Int
forall a. Seq a -> Int
Seq.length Seq FieldInfo
fieldInfos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq OneofInfo -> Int
forall a. Seq a -> Int
Seq.length Seq OneofInfo
oneofInfos
        mine :: Pat ()
mine = () -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
PApp () QName ()
me ([Pat ()] -> Pat ()) -> ([Int] -> [Pat ()]) -> [Int] -> Pat ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Pat ()] -> [Pat ()]
forall a. Int -> [a] -> [a]
take Int
len ([Pat ()] -> [Pat ()]) -> ([Int] -> [Pat ()]) -> [Int] -> [Pat ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Pat ()) -> [Int] -> [Pat ()]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
n -> String -> Pat ()
patvar (String
"x'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)) ([Int] -> Pat ()) -> [Int] -> Pat ()
forall a b. (a -> b) -> a -> b
$ [(Int
1::Int)..]
        vars :: [Exp ()]
vars = Int -> [Exp ()] -> [Exp ()]
forall a. Int -> [a] -> [a]
take Int
len ([Exp ()] -> [Exp ()]) -> ([Int] -> [Exp ()]) -> [Int] -> [Exp ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Exp ()) -> [Int] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
n -> String -> Exp ()
lvar (String
"x'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)) ([Int] -> [Exp ()]) -> [Int] -> [Exp ()]
forall a b. (a -> b) -> a -> b
$ [(Int
1::Int)..]
        mExt :: Maybe (Exp ())
mExt | Bool
extensible = Exp () -> Maybe (Exp ())
forall a. a -> Maybe a
Just ([Exp ()]
vars [Exp ()] -> Int -> Exp ()
forall a. [a] -> Int -> a
!! Seq FieldInfo -> Int
forall a. Seq a -> Int
Seq.length Seq FieldInfo
fieldInfos)
             | Bool
otherwise = Maybe (Exp ())
forall a. Maybe a
Nothing
        mUnknown :: Maybe (Exp ())
mUnknown | DescriptorInfo -> Bool
storeUnknown DescriptorInfo
di = Exp () -> Maybe (Exp ())
forall a. a -> Maybe a
Just ([Exp ()] -> Exp ()
forall a. [a] -> a
last [Exp ()]
vars)
                 | Bool
otherwise = Maybe (Exp ())
forall a. Maybe a
Nothing

-- reusable 'cases' generator
        -- first case is for Group behavior, second case is for Message behavior, last is error handler
        cases :: Exp () -> Exp () -> Exp () -> Exp ()
cases Exp ()
g Exp ()
m Exp ()
e = () -> Exp () -> [Alt ()] -> Exp ()
forall l. l -> Exp l -> [Alt l] -> Exp l
Case () (String -> Exp ()
lvar String
"ft'") [ () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (Int -> Pat ()
litIntP' Int
10) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () Exp ()
g) Maybe (Binds ())
noWhere
                                        , () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (Int -> Pat ()
litIntP' Int
11) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () Exp ()
m) Maybe (Binds ())
noWhere
                                        , () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (() -> Pat ()
forall l. l -> Pat l
PWildCard ())     (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () Exp ()
e) Maybe (Binds ())
noWhere
                                        ]

-- wireSize generation
        sizeCases :: Rhs ()
sizeCases = () -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$ Exp () -> Exp () -> Exp () -> Exp ()
cases (String -> Exp ()
lvar String
"calc'Size")
                                         (String -> Exp ()
pvar String
"prependMessageSize" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"calc'Size")
                                         (String -> Exp ()
pvar String
"wireSizeErr" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"ft'" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"self'")
        whereCalcSize :: Maybe (Binds ())
whereCalcSize = Binds () -> Maybe (Binds ())
forall a. a -> Maybe a
Just (() -> [Decl ()] -> Binds ()
forall l. l -> [Decl l] -> Binds l
BDecls () [String -> [Pat ()] -> Exp () -> Decl ()
defun String
"calc'Size" [] Exp ()
sizes])
        sizes :: Exp ()
sizes | [Exp ()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Exp ()]
sizesList = () -> Literal () -> Exp ()
forall l. l -> Literal l -> Exp l
Lit () (() -> Integer -> String -> Literal ()
forall l. l -> Integer -> String -> Literal l
Hse.Int () Integer
0 String
"0")
              | Bool
otherwise = () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () ((Exp () -> Exp () -> Exp ()) -> [Exp ()] -> Exp ()
forall a. (a -> a -> a) -> [a] -> a
foldl1' Exp () -> Exp () -> Exp ()
(+!) [Exp ()]
sizesList)
          where +! :: Exp () -> Exp () -> Exp ()
(+!) = String -> Exp () -> Exp () -> Exp ()
mkOp String
"+"
                sizesList :: [Exp ()]
sizesList | Just Exp ()
v <- Maybe (Exp ())
mUnknown = [Exp ()]
sizesListExt [Exp ()] -> [Exp ()] -> [Exp ()]
forall a. [a] -> [a] -> [a]
++ [ String -> Exp ()
pvar String
"wireSizeUnknownField" Exp () -> Exp () -> Exp ()
$$ Exp ()
v ]
                          | Bool
otherwise = [Exp ()]
sizesListExt
                sizesListExt :: [Exp ()]
sizesListExt | Just Exp ()
v <- Maybe (Exp ())
mExt = [Exp ()]
sizesListFields [Exp ()] -> [Exp ()] -> [Exp ()]
forall a. [a] -> [a] -> [a]
++ [ String -> Exp ()
pvar String
"wireSizeExtField" Exp () -> Exp () -> Exp ()
$$ Exp ()
v ]
                             | Bool
otherwise = [Exp ()]
sizesListFields
                sizesListFields :: [Exp ()]
sizesListFields =  [[Exp ()]] -> [Exp ()]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Exp ()]] -> [Exp ()])
-> (Seq (Either FieldInfo OneofInfo) -> [[Exp ()]])
-> Seq (Either FieldInfo OneofInfo)
-> [Exp ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp () -> Either FieldInfo OneofInfo -> [Exp ()])
-> [Exp ()] -> [Either FieldInfo OneofInfo] -> [[Exp ()]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Exp () -> Either FieldInfo OneofInfo -> [Exp ()]
toSize [Exp ()]
vars ([Either FieldInfo OneofInfo] -> [[Exp ()]])
-> (Seq (Either FieldInfo OneofInfo)
    -> [Either FieldInfo OneofInfo])
-> Seq (Either FieldInfo OneofInfo)
-> [[Exp ()]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Either FieldInfo OneofInfo) -> [Either FieldInfo OneofInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (Either FieldInfo OneofInfo) -> [Exp ()])
-> Seq (Either FieldInfo OneofInfo) -> [Exp ()]
forall a b. (a -> b) -> a -> b
$
                                     (FieldInfo -> Either FieldInfo OneofInfo)
-> Seq FieldInfo -> Seq (Either FieldInfo OneofInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldInfo -> Either FieldInfo OneofInfo
forall a b. a -> Either a b
Left Seq FieldInfo
fieldInfos Seq (Either FieldInfo OneofInfo)
-> Seq (Either FieldInfo OneofInfo)
-> Seq (Either FieldInfo OneofInfo)
forall a. Seq a -> Seq a -> Seq a
>< (OneofInfo -> Either FieldInfo OneofInfo)
-> Seq OneofInfo -> Seq (Either FieldInfo OneofInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OneofInfo -> Either FieldInfo OneofInfo
forall a b. b -> Either a b
Right Seq OneofInfo
oneofInfos
        toSize :: Exp () -> Either FieldInfo OneofInfo -> [Exp ()]
toSize Exp ()
var (Left FieldInfo
fi)
          = let f :: String
f = if FieldInfo -> Bool
isPacked FieldInfo
fi then String
"wireSizePacked"
                    else if FieldInfo -> Bool
isRequired FieldInfo
fi then String
"wireSizeReq"
                         else if FieldInfo -> Bool
canRepeat FieldInfo
fi then String
"wireSizeRep"
                              else String
"wireSizeOpt"
            in [(Exp () -> Exp () -> Exp ()) -> Exp () -> [Exp ()] -> Exp ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (() -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
App ()) (String -> Exp ()
pvar String
f) [ WireSize -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (FieldInfo -> WireSize
wireTagLength FieldInfo
fi)
                                    , Int -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (FieldType -> Int
getFieldType (FieldInfo -> FieldType
typeCode FieldInfo
fi))
                                    , Exp ()
var]]
        toSize Exp ()
var (Right OneofInfo
oi) = ((ProtoName, FieldInfo) -> Exp ())
-> [(ProtoName, FieldInfo)] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (Exp () -> (ProtoName, FieldInfo) -> Exp ()
toSize' Exp ()
var) ([(ProtoName, FieldInfo)] -> [Exp ()])
-> (OneofInfo -> [(ProtoName, FieldInfo)]) -> OneofInfo -> [Exp ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)])
-> (OneofInfo -> Seq (ProtoName, FieldInfo))
-> OneofInfo
-> [(ProtoName, FieldInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofInfo -> Seq (ProtoName, FieldInfo)
oneofFields (OneofInfo -> [Exp ()]) -> OneofInfo -> [Exp ()]
forall a b. (a -> b) -> a -> b
$ OneofInfo
oi
          where toSize' :: Exp () -> (ProtoName, FieldInfo) -> Exp ()
toSize' Exp ()
var r :: (ProtoName, FieldInfo)
r@(ProtoName
n,FieldInfo
fi)
                  = let f :: String
f = String
"wireSizeOpt"
                        var' :: Exp ()
var' = String -> Exp () -> Exp () -> Exp ()
mkOp String
"Prelude'.=<<" (() -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (ProtoName -> QName ()
qualName ((String, ProtoName) -> ProtoName
forall a b. (a, b) -> b
snd ((ProtoName, FieldInfo) -> (String, ProtoName)
oneofGet (ProtoName, FieldInfo)
r)))) Exp ()
var
                    in (Exp () -> Exp () -> Exp ()) -> Exp () -> [Exp ()] -> Exp ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (() -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
App ()) (String -> Exp ()
pvar String
f) [ WireSize -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (FieldInfo -> WireSize
wireTagLength FieldInfo
fi)
                                           , Int -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (FieldType -> Int
getFieldType (FieldInfo -> FieldType
typeCode FieldInfo
fi))
                                           , Exp ()
var']


-- wirePut generation
        putCases :: Rhs ()
putCases = () -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$ Exp () -> Exp () -> Exp () -> Exp ()
cases
          (String -> Exp ()
lvar String
"put'Fields")
          (String -> Exp ()
lvar String
"put'FieldsSized")
          (String -> Exp ()
pvar String
"wirePutErr" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"ft'" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"self'")
        wherePutFields :: Maybe (Binds ())
wherePutFields = Binds () -> Maybe (Binds ())
forall a. a -> Maybe a
Just (() -> [Decl ()] -> Binds ()
forall l. l -> [Decl l] -> Binds l
BDecls ()
            [ String -> [Pat ()] -> Exp () -> Decl ()
defun String
"put'Fields" [] (String -> Exp ()
pvar String
"sequencePutWithSize" Exp () -> Exp () -> Exp ()
$$ () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () [Exp ()]
putStmts)
            , String -> [Pat ()] -> Exp () -> Decl ()
defun String
"put'FieldsSized" [] (Exp () -> Decl ()) -> Exp () -> Decl ()
forall a b. (a -> b) -> a -> b
$
              () -> Binds () -> Exp () -> Exp ()
forall l. l -> Binds l -> Exp l -> Exp l
Let () (() -> [Decl ()] -> Binds ()
forall l. l -> [Decl l] -> Binds l
BDecls ()
                      [ String -> [Pat ()] -> Exp () -> Decl ()
defun String
"size'" [] (String -> Exp ()
preludevar String
"fst" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
pvar String
"runPutM" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"put'Fields"))
                      , String -> [Pat ()] -> Exp () -> Decl ()
defun String
"put'Size" []
                         (() -> [Stmt ()] -> Exp ()
forall l. l -> [Stmt l] -> Exp l
Do () [ () -> Exp () -> Stmt ()
forall l. l -> Exp l -> Stmt l
Qualifier () (Exp () -> Stmt ()) -> Exp () -> Stmt ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
pvar String
"putSize" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"size'"
                                , () -> Exp () -> Stmt ()
forall l. l -> Exp l -> Stmt l
Qualifier () (Exp () -> Stmt ()) -> Exp () -> Stmt ()
forall a b. (a -> b) -> a -> b
$ String -> Exp ()
preludevar String
"return" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
pvar String
"size'WireSize" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"size'")
                                ])
                      ])
              (String -> Exp ()
pvar String
"sequencePutWithSize" Exp () -> Exp () -> Exp ()
$$ () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () [String -> Exp ()
lvar String
"put'Size", String -> Exp ()
lvar String
"put'Fields"])
            ])
        putStmts :: [Exp ()]
putStmts = [Exp ()]
putStmtsAll
          where putStmtsAll :: [Exp ()]
putStmtsAll | Just Exp ()
v <- Maybe (Exp ())
mUnknown = [Exp ()]
putStmtsListExt [Exp ()] -> [Exp ()] -> [Exp ()]
forall a. [a] -> [a] -> [a]
++ [ String -> Exp ()
pvar String
"wirePutUnknownFieldWithSize" Exp () -> Exp () -> Exp ()
$$ Exp ()
v ]
                            | Bool
otherwise = [Exp ()]
putStmtsListExt
                putStmtsListExt :: [Exp ()]
putStmtsListExt | Just Exp ()
v <- Maybe (Exp ())
mExt = [Exp ()]
sortedPutStmtsList [Exp ()] -> [Exp ()] -> [Exp ()]
forall a. [a] -> [a] -> [a]
++ [ String -> Exp ()
pvar String
"wirePutExtFieldWithSize" Exp () -> Exp () -> Exp ()
$$ Exp ()
v ]
                                | Bool
otherwise = [Exp ()]
sortedPutStmtsList
                sortedPutStmtsList :: [Exp ()]
sortedPutStmtsList = ((FieldId, Exp ()) -> Exp ()) -> [(FieldId, Exp ())] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (FieldId, Exp ()) -> Exp ()
forall a b. (a, b) -> b
snd                                          -- remove number
                                     ([(FieldId, Exp ())] -> [Exp ()])
-> ([(FieldId, Exp ())] -> [(FieldId, Exp ())])
-> [(FieldId, Exp ())]
-> [Exp ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FieldId, Exp ()) -> (FieldId, Exp ()) -> Ordering)
-> [(FieldId, Exp ())] -> [(FieldId, Exp ())]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (FieldId -> FieldId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (FieldId -> FieldId -> Ordering)
-> ((FieldId, Exp ()) -> FieldId)
-> (FieldId, Exp ())
-> (FieldId, Exp ())
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (FieldId, Exp ()) -> FieldId
forall a b. (a, b) -> a
fst)                      -- sort by number
                                     ([(FieldId, Exp ())] -> [Exp ()])
-> [(FieldId, Exp ())] -> [Exp ()]
forall a b. (a -> b) -> a -> b
$ [(FieldId, Exp ())]
putStmtsList
                putStmtsList :: [(FieldId, Exp ())]
putStmtsList = [[(FieldId, Exp ())]] -> [(FieldId, Exp ())]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(FieldId, Exp ())]] -> [(FieldId, Exp ())])
-> (Seq (Either FieldInfo OneofInfo) -> [[(FieldId, Exp ())]])
-> Seq (Either FieldInfo OneofInfo)
-> [(FieldId, Exp ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp () -> Either FieldInfo OneofInfo -> [(FieldId, Exp ())])
-> [Exp ()]
-> [Either FieldInfo OneofInfo]
-> [[(FieldId, Exp ())]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Exp () -> Either FieldInfo OneofInfo -> [(FieldId, Exp ())]
toPut [Exp ()]
vars ([Either FieldInfo OneofInfo] -> [[(FieldId, Exp ())]])
-> (Seq (Either FieldInfo OneofInfo)
    -> [Either FieldInfo OneofInfo])
-> Seq (Either FieldInfo OneofInfo)
-> [[(FieldId, Exp ())]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Either FieldInfo OneofInfo) -> [Either FieldInfo OneofInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (Either FieldInfo OneofInfo) -> [(FieldId, Exp ())])
-> Seq (Either FieldInfo OneofInfo) -> [(FieldId, Exp ())]
forall a b. (a -> b) -> a -> b
$
                                 (FieldInfo -> Either FieldInfo OneofInfo)
-> Seq FieldInfo -> Seq (Either FieldInfo OneofInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldInfo -> Either FieldInfo OneofInfo
forall a b. a -> Either a b
Left Seq FieldInfo
fieldInfos Seq (Either FieldInfo OneofInfo)
-> Seq (Either FieldInfo OneofInfo)
-> Seq (Either FieldInfo OneofInfo)
forall a. Seq a -> Seq a -> Seq a
>< (OneofInfo -> Either FieldInfo OneofInfo)
-> Seq OneofInfo -> Seq (Either FieldInfo OneofInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OneofInfo -> Either FieldInfo OneofInfo
forall a b. b -> Either a b
Right Seq OneofInfo
oneofInfos
        toPut :: Exp () -> Either FieldInfo OneofInfo -> [(FieldId, Exp ())]
toPut Exp ()
var (Left FieldInfo
fi)
          = let f :: String
f = if FieldInfo -> Bool
isPacked FieldInfo
fi then String
"wirePutPackedWithSize"
                    else if FieldInfo -> Bool
isRequired FieldInfo
fi then String
"wirePutReqWithSize"
                         else if FieldInfo -> Bool
canRepeat FieldInfo
fi then String
"wirePutRepWithSize"
                              else String
"wirePutOptWithSize"
            in [(FieldInfo -> FieldId
fieldNumber FieldInfo
fi,
                   (Exp () -> Exp () -> Exp ()) -> Exp () -> [Exp ()] -> Exp ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (() -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
App ()) (String -> Exp ()
pvar String
f) [ Word32 -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (WireTag -> Word32
getWireTag (FieldInfo -> WireTag
wireTag FieldInfo
fi))
                                       , Int -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (FieldType -> Int
getFieldType (FieldInfo -> FieldType
typeCode FieldInfo
fi))
                                       , Exp ()
var]
                 )]
        toPut Exp ()
var (Right OneofInfo
oi) = ((ProtoName, FieldInfo) -> (FieldId, Exp ()))
-> [(ProtoName, FieldInfo)] -> [(FieldId, Exp ())]
forall a b. (a -> b) -> [a] -> [b]
map (ProtoName, FieldInfo) -> (FieldId, Exp ())
toPut' ([(ProtoName, FieldInfo)] -> [(FieldId, Exp ())])
-> (OneofInfo -> [(ProtoName, FieldInfo)])
-> OneofInfo
-> [(FieldId, Exp ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)])
-> (OneofInfo -> Seq (ProtoName, FieldInfo))
-> OneofInfo
-> [(ProtoName, FieldInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofInfo -> Seq (ProtoName, FieldInfo)
oneofFields (OneofInfo -> [(FieldId, Exp ())])
-> OneofInfo -> [(FieldId, Exp ())]
forall a b. (a -> b) -> a -> b
$ OneofInfo
oi
          where toPut' :: (ProtoName, FieldInfo) -> (FieldId, Exp ())
toPut' r :: (ProtoName, FieldInfo)
r@(ProtoName
_n,FieldInfo
fi)
                  = let f :: String
f = String
"wirePutOptWithSize"
                        var' :: Exp ()
var' = String -> Exp () -> Exp () -> Exp ()
mkOp String
"Prelude'.=<<" (() -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (ProtoName -> QName ()
qualName ((String, ProtoName) -> ProtoName
forall a b. (a, b) -> b
snd ((ProtoName, FieldInfo) -> (String, ProtoName)
oneofGet (ProtoName, FieldInfo)
r)))) Exp ()
var
                    in (FieldInfo -> FieldId
fieldNumber FieldInfo
fi
                       , (Exp () -> Exp () -> Exp ()) -> Exp () -> [Exp ()] -> Exp ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (() -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
App ()) (String -> Exp ()
pvar String
f) [ Word32 -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (WireTag -> Word32
getWireTag (FieldInfo -> WireTag
wireTag FieldInfo
fi))
                                              , Int -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (FieldType -> Int
getFieldType (FieldInfo -> FieldType
typeCode FieldInfo
fi))
                                              , Exp ()
var']
                       )

-- wireGet generation
-- new for 1.5.7, rewriting this a great deal!
        getCases :: Rhs ()
getCases = let handleUnknown :: Exp ()
handleUnknown = if DescriptorInfo -> Bool
storeUnknown DescriptorInfo
di
                                         then String -> Exp ()
pvar String
"loadUnknown"
                                         else String -> Exp ()
pvar String
"discardUnknown"
                       param :: Exp ()
param = () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
pvar String
"catch'Unknown'" Exp () -> Exp () -> Exp ()
$$ Exp ()
handleUnknown Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"update'Self")
                   in () -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$ Exp () -> Exp () -> Exp () -> Exp ()
cases (String -> Exp ()
pvar String
"getBareMessageWith" Exp () -> Exp () -> Exp ()
$$ Exp ()
param)
                                           (String -> Exp ()
pvar String
"getMessageWith" Exp () -> Exp () -> Exp ()
$$ Exp ()
param)
                                           (String -> Exp ()
pvar String
"wireGetErr" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"ft'")
        whereDecls :: Maybe (Binds ())
whereDecls = Binds () -> Maybe (Binds ())
forall a. a -> Maybe a
Just (() -> [Decl ()] -> Binds ()
forall l. l -> [Decl l] -> Binds l
BDecls () [Decl ()
whereUpdateSelf])
        whereUpdateSelf :: Decl ()
whereUpdateSelf = String -> [Pat ()] -> Exp () -> Decl ()
defun String
"update'Self" [String -> Pat ()
patvar String
"wire'Tag", String -> Pat ()
patvar String
"old'Self"]
                                (() -> Exp () -> [Alt ()] -> Exp ()
forall l. l -> Exp l -> [Alt l] -> Exp l
Case () (String -> Exp ()
lvar String
"wire'Tag") [Alt ()]
updateAlts)
        -- update cases are all normal fields then all known extensions then wildcard
        updateAlts :: [Alt ()]
updateAlts = (FieldInfo -> [Alt ()]) -> [FieldInfo] -> [Alt ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FieldInfo -> [Alt ()]
toUpdate (Seq FieldInfo -> [FieldInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq FieldInfo
fieldInfos)
                     [Alt ()] -> [Alt ()] -> [Alt ()]
forall a. [a] -> [a] -> [a]
++ (do -- in list monad
                          OneofInfo
o <- Seq OneofInfo -> [OneofInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq OneofInfo
oneofInfos
                          (ProtoName, FieldInfo)
f <- Seq (ProtoName, FieldInfo) -> [(ProtoName, FieldInfo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (OneofInfo -> Seq (ProtoName, FieldInfo)
oneofFields OneofInfo
o)
                          OneofInfo -> (ProtoName, FieldInfo) -> [Alt ()]
toUpdateO OneofInfo
o (ProtoName, FieldInfo)
f)
                     [Alt ()] -> [Alt ()] -> [Alt ()]
forall a. [a] -> [a] -> [a]
++ (if Bool
extensible then (FieldInfo -> [Alt ()]) -> [FieldInfo] -> [Alt ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FieldInfo -> [Alt ()]
toUpdateExt (Seq FieldInfo -> [FieldInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq FieldInfo
fieldExts) else [])
                     [Alt ()] -> [Alt ()] -> [Alt ()]
forall a. [a] -> [a] -> [a]
++ [() -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (() -> Pat ()
forall l. l -> Pat l
PWildCard ()) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () Exp ()
wildcardAlt) Maybe (Binds ())
noWhere]
        -- the wildcard alternative handles new extensions and
        wildcardAlt :: Exp ()
wildcardAlt = Exp () -> Exp ()
letPair Exp ()
extBranch
          where letPair :: Exp () -> Exp ()
letPair = () -> Binds () -> Exp () -> Exp ()
forall l. l -> Binds l -> Exp l -> Exp l
Let () (() -> [Decl ()] -> Binds ()
forall l. l -> [Decl l] -> Binds l
BDecls () [() -> Pat () -> Rhs () -> Maybe (Binds ()) -> Decl ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
PatBind () (() -> Boxed -> [Pat ()] -> Pat ()
forall l. l -> Boxed -> [Pat l] -> Pat l
PTuple () Boxed
Boxed [String -> Pat ()
patvar String
"field'Number",String -> Pat ()
patvar String
"wire'Type"])
                                         (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (String -> Exp ()
pvar String
"splitWireTag" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"wire'Tag")) Maybe (Binds ())
forall a. Maybe a
bdecls])
                extBranch :: Exp ()
extBranch | Bool
extensible = () -> Exp () -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l -> Exp l
If () (Exp () -> Exp ()
isAllowedExt (String -> Exp ()
lvar String
"field'Number"))
                                            (Exp () -> Exp ()
argPair (String -> Exp ()
pvar String
"loadExtension"))
                                            Exp ()
unknownBranch
                          | Bool
otherwise = Exp ()
unknownBranch
                unknownBranch :: Exp ()
unknownBranch = Exp () -> Exp ()
argPair (String -> Exp ()
pvar String
"unknown")
                argPair :: Exp () -> Exp ()
argPair Exp ()
x = Exp ()
x Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"field'Number" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"wire'Type" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"old'Self"
        bdecls :: Maybe a
bdecls = Maybe a
forall a. Maybe a
Nothing
        isAllowedExt :: Exp () -> Exp ()
isAllowedExt Exp ()
x = String -> Exp ()
preludevar String
"or" Exp () -> Exp () -> Exp ()
$$ () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () [Exp ()]
ranges where
          <=! :: Exp () -> Exp () -> Exp ()
(<=!) = String -> Exp () -> Exp () -> Exp ()
mkOp String
"<="; &&! :: Exp () -> Exp () -> Exp ()
(&&!) = String -> Exp () -> Exp () -> Exp ()
mkOp String
"&&"; ==! :: Exp () -> Exp () -> Exp ()
(==!) = String -> Exp () -> Exp () -> Exp ()
mkOp String
"=="; (FieldId Int32
maxHi) = FieldId
forall a. Bounded a => a
maxBound
          ranges :: [Exp ()]
ranges = ((FieldId, FieldId) -> Exp ()) -> [(FieldId, FieldId)] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map (\ (FieldId Int32
lo,FieldId Int32
hi) ->
                            if Int32
hi Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
maxHi
                              then if Int32
lo Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
hi
                                     then (Exp ()
x Exp () -> Exp () -> Exp ()
==! Int32 -> Exp ()
forall x. Integral x => x -> Exp ()
litInt Int32
lo)
                                     else (Int32 -> Exp ()
forall x. Integral x => x -> Exp ()
litInt Int32
lo Exp () -> Exp () -> Exp ()
<=! Exp ()
x) Exp () -> Exp () -> Exp ()
&&! (Exp ()
x Exp () -> Exp () -> Exp ()
<=! Int32 -> Exp ()
forall x. Integral x => x -> Exp ()
litInt Int32
hi)
                              else Int32 -> Exp ()
forall x. Integral x => x -> Exp ()
litInt Int32
lo Exp () -> Exp () -> Exp ()
<=! Exp ()
x )
                       [(FieldId, FieldId)]
allowedExts

-- wireGetErr for known extensions
-- need to check isPacked and call appropriate wireGetKey[Un]Packed substitute function
        toUpdateExt :: FieldInfo -> [Alt ()]
toUpdateExt FieldInfo
fi | Just (WireTag
wt1,WireTag
wt2) <- FieldInfo -> Maybe (WireTag, WireTag)
packedTag FieldInfo
fi = [WireTag -> Alt ()
toUpdateExtUnpacked WireTag
wt1, WireTag -> Alt ()
toUpdateExtPacked WireTag
wt2]
                       | Bool
otherwise = [WireTag -> Alt ()
toUpdateExtUnpacked (FieldInfo -> WireTag
wireTag FieldInfo
fi)]
          where (Exp ()
getUnP,Exp ()
getP) | FieldInfo -> Bool
isPacked FieldInfo
fi = (String -> Exp ()
pvar String
"wireGetKeyToPacked",String -> Exp ()
pvar String
"wireGetKey")
                              | Bool
otherwise = (String -> Exp ()
pvar String
"wireGetKey",String -> Exp ()
pvar String
"wireGetKeyToUnPacked")
                toUpdateExtUnpacked :: WireTag -> Alt ()
toUpdateExtUnpacked WireTag
wt1 =
                  () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (Word32 -> Pat ()
forall x. Integral x => x -> Pat ()
litIntP (Word32 -> Pat ()) -> (WireTag -> Word32) -> WireTag -> Pat ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WireTag -> Word32
getWireTag (WireTag -> Pat ()) -> WireTag -> Pat ()
forall a b. (a -> b) -> a -> b
$ WireTag
wt1)
                      (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$ Exp ()
getUnP Exp () -> Exp () -> Exp ()
$$ () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (ProtoName -> ProtoFName -> QName ()
mayQualName ProtoName
protoName (FieldInfo -> ProtoFName
fieldName FieldInfo
fi)) Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"old'Self")
                      Maybe (Binds ())
noWhere
                toUpdateExtPacked :: WireTag -> Alt ()
toUpdateExtPacked WireTag
wt2 =
                  () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (Word32 -> Pat ()
forall x. Integral x => x -> Pat ()
litIntP (Word32 -> Pat ()) -> (WireTag -> Word32) -> WireTag -> Pat ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WireTag -> Word32
getWireTag (WireTag -> Pat ()) -> WireTag -> Pat ()
forall a b. (a -> b) -> a -> b
$ WireTag
wt2)
                      (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$ Exp ()
getP Exp () -> Exp () -> Exp ()
$$ () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (ProtoName -> ProtoFName -> QName ()
mayQualName ProtoName
protoName (FieldInfo -> ProtoFName
fieldName FieldInfo
fi)) Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"old'Self")
                      Maybe (Binds ())
noWhere

-- wireGet without extensions
        toUpdate :: FieldInfo -> [Alt ()]
toUpdate FieldInfo
fi | Just (WireTag
wt1,WireTag
wt2) <- FieldInfo -> Maybe (WireTag, WireTag)
packedTag FieldInfo
fi = [WireTag -> FieldInfo -> Alt ()
toUpdateUnpacked WireTag
wt1 FieldInfo
fi, WireTag -> FieldInfo -> Alt ()
toUpdatePacked WireTag
wt2 FieldInfo
fi]
                    | Bool
otherwise                      = [WireTag -> FieldInfo -> Alt ()
toUpdateUnpacked (FieldInfo -> WireTag
wireTag FieldInfo
fi) FieldInfo
fi]



        toUpdateUnpacked :: WireTag -> FieldInfo -> Alt ()
toUpdateUnpacked WireTag
wt1 FieldInfo
fi =
          () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (Word32 -> Pat ()
forall x. Integral x => x -> Pat ()
litIntP (Word32 -> Pat ()) -> (WireTag -> Word32) -> WireTag -> Pat ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WireTag -> Word32
getWireTag (WireTag -> Pat ()) -> WireTag -> Pat ()
forall a b. (a -> b) -> a -> b
$ WireTag
wt1) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$
            String -> Exp ()
preludevar String
"fmap" Exp () -> Exp () -> Exp ()
$$ (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ () -> [Pat ()] -> Exp () -> Exp ()
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda () [() -> Pat () -> Pat ()
forall l. l -> Pat l -> Pat l
PBangPat () (String -> Pat ()
patvar String
"new'Field")] (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$
                              () -> Exp () -> [FieldUpdate ()] -> Exp ()
forall l. l -> Exp l -> [FieldUpdate l] -> Exp l
RecUpdate () (String -> Exp ()
lvar String
"old'Self")
                                        [() -> QName () -> Exp () -> FieldUpdate ()
forall l. l -> QName l -> Exp l -> FieldUpdate l
FieldUpdate () (ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName (FieldInfo -> QName ()) -> FieldInfo -> QName ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
fi)
                                                     (FieldInfo -> Exp ()
labelUpdateUnpacked FieldInfo
fi)])
                        Exp () -> Exp () -> Exp ()
$$ (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
pvar String
"wireGet" Exp () -> Exp () -> Exp ()
$$ (Int -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (Int -> Exp ()) -> (FieldInfo -> Int) -> FieldInfo -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType -> Int
getFieldType (FieldType -> Int) -> (FieldInfo -> FieldType) -> FieldInfo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> FieldType
typeCode (FieldInfo -> Exp ()) -> FieldInfo -> Exp ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
fi)))) Maybe (Binds ())
noWhere
        labelUpdateUnpacked :: FieldInfo -> Exp ()
labelUpdateUnpacked FieldInfo
fi | FieldInfo -> Bool
canRepeat FieldInfo
fi = String -> Exp ()
pvar String
"append" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () ((() -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (QName () -> Exp ())
-> (FieldInfo -> QName ()) -> FieldInfo -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName (FieldInfo -> Exp ()) -> FieldInfo -> Exp ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
fi)
                                                                             Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"old'Self")
                                                              Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"new'Field"
                               | FieldInfo -> Bool
isRequired FieldInfo
fi = Exp () -> Exp ()
qMerge (String -> Exp ()
lvar String
"new'Field")
                               | Bool
otherwise = Exp () -> Exp ()
qMerge (String -> Exp ()
preludecon String
"Just" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"new'Field")
            where qMerge :: Exp () -> Exp ()
qMerge Exp ()
x | Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FieldType -> Int
getFieldType (FieldInfo -> FieldType
typeCode FieldInfo
fi)) Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
10,(Int
11::Int)] =
                               String -> Exp ()
pvar String
"mergeAppend" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () ( (() -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (QName () -> Exp ())
-> (FieldInfo -> QName ()) -> FieldInfo -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName (FieldInfo -> Exp ()) -> FieldInfo -> Exp ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
fi)
                                                               Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"old'Self" )
                                                  Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () Exp ()
x
                           | Bool
otherwise = Exp ()
x
        toUpdatePacked :: WireTag -> FieldInfo -> Alt ()
toUpdatePacked WireTag
wt2 FieldInfo
fi =
          () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (Word32 -> Pat ()
forall x. Integral x => x -> Pat ()
litIntP (Word32 -> Pat ()) -> (WireTag -> Word32) -> WireTag -> Pat ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WireTag -> Word32
getWireTag (WireTag -> Pat ()) -> WireTag -> Pat ()
forall a b. (a -> b) -> a -> b
$ WireTag
wt2) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$
            String -> Exp ()
preludevar String
"fmap" Exp () -> Exp () -> Exp ()
$$ (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ () -> [Pat ()] -> Exp () -> Exp ()
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda () [() -> Pat () -> Pat ()
forall l. l -> Pat l -> Pat l
PBangPat () (String -> Pat ()
patvar String
"new'Field")] (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$
                              () -> Exp () -> [FieldUpdate ()] -> Exp ()
forall l. l -> Exp l -> [FieldUpdate l] -> Exp l
RecUpdate () (String -> Exp ()
lvar String
"old'Self")
                                        [() -> QName () -> Exp () -> FieldUpdate ()
forall l. l -> QName l -> Exp l -> FieldUpdate l
FieldUpdate () (ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName (FieldInfo -> QName ()) -> FieldInfo -> QName ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
fi)
                                                     (FieldInfo -> Exp ()
labelUpdatePacked FieldInfo
fi)])
                        Exp () -> Exp () -> Exp ()
$$ (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
pvar String
"wireGetPacked" Exp () -> Exp () -> Exp ()
$$ (Int -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (Int -> Exp ()) -> (FieldInfo -> Int) -> FieldInfo -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType -> Int
getFieldType (FieldType -> Int) -> (FieldInfo -> FieldType) -> FieldInfo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> FieldType
typeCode (FieldInfo -> Exp ()) -> FieldInfo -> Exp ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
fi)))) Maybe (Binds ())
noWhere
        labelUpdatePacked :: FieldInfo -> Exp ()
labelUpdatePacked FieldInfo
fi = String -> Exp ()
pvar String
"mergeAppend" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () ((() -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (QName () -> Exp ())
-> (FieldInfo -> QName ()) -> FieldInfo -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (FieldInfo -> ProtoFName) -> FieldInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> ProtoFName
fieldName (FieldInfo -> Exp ()) -> FieldInfo -> Exp ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
fi)
                                                                 Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"old'Self")
                                                  Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"new'Field"

        -- in the above, the [10,11] check optimizes using the
        -- knowledge that only TYPE_MESSAGE and TYPE_GROUP have merges
        -- that are not right-biased replacements.  The "mergeAppend" uses
        -- knowledge of how all repeated fields get merged.


        -- for fields in OneofInfo
        toUpdateO :: OneofInfo -> (ProtoName, FieldInfo) -> [Alt ()]
toUpdateO OneofInfo
oi f :: (ProtoName, FieldInfo)
f@(ProtoName
_n,FieldInfo
fi)
          | Just (WireTag
wt1,WireTag
wt2) <- FieldInfo -> Maybe (WireTag, WireTag)
packedTag FieldInfo
fi = [OneofInfo -> WireTag -> (ProtoName, FieldInfo) -> Alt ()
toUpdateUnpackedO OneofInfo
oi WireTag
wt1 (ProtoName, FieldInfo)
f, OneofInfo -> WireTag -> (ProtoName, FieldInfo) -> Alt ()
toUpdatePackedO OneofInfo
oi WireTag
wt2 (ProtoName, FieldInfo)
f]
          | Bool
otherwise                      = [OneofInfo -> WireTag -> (ProtoName, FieldInfo) -> Alt ()
toUpdateUnpackedO OneofInfo
oi (FieldInfo -> WireTag
wireTag FieldInfo
fi) (ProtoName, FieldInfo)
f]

        toUpdateUnpackedO :: OneofInfo -> WireTag -> (ProtoName, FieldInfo) -> Alt ()
toUpdateUnpackedO OneofInfo
oi WireTag
wt1 f :: (ProtoName, FieldInfo)
f@(ProtoName
_,FieldInfo
fi) =
          () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (Word32 -> Pat ()
forall x. Integral x => x -> Pat ()
litIntP (Word32 -> Pat ()) -> (WireTag -> Word32) -> WireTag -> Pat ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WireTag -> Word32
getWireTag (WireTag -> Pat ()) -> WireTag -> Pat ()
forall a b. (a -> b) -> a -> b
$ WireTag
wt1) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$
            String -> Exp ()
preludevar String
"fmap" Exp () -> Exp () -> Exp ()
$$ (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ () -> [Pat ()] -> Exp () -> Exp ()
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda () [() -> Pat () -> Pat ()
forall l. l -> Pat l -> Pat l
PBangPat () (String -> Pat ()
patvar String
"new'Field")] (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$
                              () -> Exp () -> [FieldUpdate ()] -> Exp ()
forall l. l -> Exp l -> [FieldUpdate l] -> Exp l
RecUpdate () (String -> Exp ()
lvar String
"old'Self")
                                        [() -> QName () -> Exp () -> FieldUpdate ()
forall l. l -> QName l -> Exp l -> FieldUpdate l
FieldUpdate () (ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (OneofInfo -> ProtoFName) -> OneofInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofInfo -> ProtoFName
oneofFName (OneofInfo -> QName ()) -> OneofInfo -> QName ()
forall a b. (a -> b) -> a -> b
$ OneofInfo
oi)
                                                     (OneofInfo -> (ProtoName, FieldInfo) -> Exp ()
labelUpdateUnpackedO OneofInfo
oi (ProtoName, FieldInfo)
f)])
                        Exp () -> Exp () -> Exp ()
$$ (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
pvar String
"wireGet" Exp () -> Exp () -> Exp ()
$$ (Int -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (Int -> Exp ()) -> (FieldInfo -> Int) -> FieldInfo -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType -> Int
getFieldType (FieldType -> Int) -> (FieldInfo -> FieldType) -> FieldInfo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> FieldType
typeCode (FieldInfo -> Exp ()) -> FieldInfo -> Exp ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
fi)))) Maybe (Binds ())
noWhere
        labelUpdateUnpackedO :: OneofInfo -> (ProtoName, FieldInfo) -> Exp ()
labelUpdateUnpackedO OneofInfo
oi f :: (ProtoName, FieldInfo)
f@(ProtoName
_,FieldInfo
fi) = Exp () -> Exp ()
qMerge (String -> Exp ()
preludecon String
"Just" Exp () -> Exp () -> Exp ()
$$
                                               ((ProtoName, FieldInfo) -> Exp ()
oneofCon (ProtoName, FieldInfo)
f Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"new'Field")
                                            )
            where qMerge :: Exp () -> Exp ()
qMerge Exp ()
x | Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FieldType -> Int
getFieldType (FieldInfo -> FieldType
typeCode FieldInfo
fi)) Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
10,(Int
11::Int)] =
                               String -> Exp ()
pvar String
"mergeAppend" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () ( (() -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (QName () -> Exp ())
-> (OneofInfo -> QName ()) -> OneofInfo -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (OneofInfo -> ProtoFName) -> OneofInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofInfo -> ProtoFName
oneofFName (OneofInfo -> Exp ()) -> OneofInfo -> Exp ()
forall a b. (a -> b) -> a -> b
$ OneofInfo
oi)
                                                               Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"old'Self" )
                                                  Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () Exp ()
x
                           | Bool
otherwise = Exp ()
x
        toUpdatePackedO :: OneofInfo -> WireTag -> (ProtoName, FieldInfo) -> Alt ()
toUpdatePackedO OneofInfo
oi WireTag
wt2 f :: (ProtoName, FieldInfo)
f@(ProtoName
_,FieldInfo
fi) =
          () -> Pat () -> Rhs () -> Maybe (Binds ()) -> Alt ()
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt () (Word32 -> Pat ()
forall x. Integral x => x -> Pat ()
litIntP (Word32 -> Pat ()) -> (WireTag -> Word32) -> WireTag -> Pat ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WireTag -> Word32
getWireTag (WireTag -> Pat ()) -> WireTag -> Pat ()
forall a b. (a -> b) -> a -> b
$ WireTag
wt2) (() -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
UnGuardedRhs () (Exp () -> Rhs ()) -> Exp () -> Rhs ()
forall a b. (a -> b) -> a -> b
$
            String -> Exp ()
preludevar String
"fmap" Exp () -> Exp () -> Exp ()
$$ (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ () -> [Pat ()] -> Exp () -> Exp ()
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda () [() -> Pat () -> Pat ()
forall l. l -> Pat l -> Pat l
PBangPat () (String -> Pat ()
patvar String
"new'Field")] (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$
                              () -> Exp () -> [FieldUpdate ()] -> Exp ()
forall l. l -> Exp l -> [FieldUpdate l] -> Exp l
RecUpdate () (String -> Exp ()
lvar String
"old'Self")
                                        [() -> QName () -> Exp () -> FieldUpdate ()
forall l. l -> QName l -> Exp l -> FieldUpdate l
FieldUpdate () (ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (OneofInfo -> ProtoFName) -> OneofInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofInfo -> ProtoFName
oneofFName (OneofInfo -> QName ()) -> OneofInfo -> QName ()
forall a b. (a -> b) -> a -> b
$ OneofInfo
oi)
                                                     (OneofInfo -> (ProtoName, FieldInfo) -> Exp ()
labelUpdatePackedO OneofInfo
oi (ProtoName, FieldInfo)
f)])
                        Exp () -> Exp () -> Exp ()
$$ (() -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
pvar String
"wireGetPacked" Exp () -> Exp () -> Exp ()
$$ (Int -> Exp ()
forall x. Integral x => x -> Exp ()
litInt (Int -> Exp ()) -> (FieldInfo -> Int) -> FieldInfo -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType -> Int
getFieldType (FieldType -> Int) -> (FieldInfo -> FieldType) -> FieldInfo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo -> FieldType
typeCode (FieldInfo -> Exp ()) -> FieldInfo -> Exp ()
forall a b. (a -> b) -> a -> b
$ FieldInfo
fi)))) Maybe (Binds ())
noWhere
        labelUpdatePackedO :: OneofInfo -> (ProtoName, FieldInfo) -> Exp ()
labelUpdatePackedO OneofInfo
oi f :: (ProtoName, FieldInfo)
f@(ProtoName
_,FieldInfo
fi) = String -> Exp ()
pvar String
"mergeAppend" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () ((() -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
Var () (QName () -> Exp ())
-> (OneofInfo -> QName ()) -> OneofInfo -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoFName -> QName ()
unqualFName (ProtoFName -> QName ())
-> (OneofInfo -> ProtoFName) -> OneofInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofInfo -> ProtoFName
oneofFName (OneofInfo -> Exp ()) -> OneofInfo -> Exp ()
forall a b. (a -> b) -> a -> b
$ OneofInfo
oi)
                                                                 Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"old'Self")
                                                  Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () (String -> Exp ()
preludecon String
"Just" Exp () -> Exp () -> Exp ()
$$
                                                              ((ProtoName, FieldInfo) -> Exp ()
oneofCon (ProtoName, FieldInfo)
f Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
lvar String
"new'Field"))

    in ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"Wire") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () QName ()
me]) (Maybe [InstDecl ()] -> Decl ())
-> ([Decl ()] -> Maybe [InstDecl ()]) -> [Decl ()] -> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Maybe [InstDecl ()])
-> ([Decl ()] -> [InstDecl ()]) -> [Decl ()] -> Maybe [InstDecl ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl () -> InstDecl ()) -> [Decl ()] -> [InstDecl ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> Decl () -> InstDecl ()
forall l. l -> Decl l -> InstDecl l
InsDecl ()) ([Decl ()] -> Decl ()) -> [Decl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
        [ () -> [Match ()] -> Decl ()
forall l. l -> [Match l] -> Decl l
FunBind () [() -> Name () -> [Pat ()] -> Rhs () -> Maybe (Binds ()) -> Match ()
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"wireSize") [String -> Pat ()
patvar String
"ft'",() -> Name () -> Pat () -> Pat ()
forall l. l -> Name l -> Pat l -> Pat l
PAsPat () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"self'") (() -> Pat () -> Pat ()
forall l. l -> Pat l -> Pat l
PParen () Pat ()
mine)] Rhs ()
sizeCases Maybe (Binds ())
whereCalcSize]
        , () -> [Match ()] -> Decl ()
forall l. l -> [Match l] -> Decl l
FunBind () [() -> Name () -> [Pat ()] -> Rhs () -> Maybe (Binds ()) -> Match ()
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"wirePutWithSize")  [String -> Pat ()
patvar String
"ft'",() -> Name () -> Pat () -> Pat ()
forall l. l -> Name l -> Pat l -> Pat l
PAsPat () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"self'") (() -> Pat () -> Pat ()
forall l. l -> Pat l -> Pat l
PParen () Pat ()
mine)] Rhs ()
putCases Maybe (Binds ())
wherePutFields]
        , () -> [Match ()] -> Decl ()
forall l. l -> [Match l] -> Decl l
FunBind () [() -> Name () -> [Pat ()] -> Rhs () -> Maybe (Binds ()) -> Match ()
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match () (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"wireGet") [String -> Pat ()
patvar String
"ft'"] Rhs ()
getCases Maybe (Binds ())
whereDecls]
        ]

instanceReflectDescriptor :: DescriptorInfo -> Decl ()
instanceReflectDescriptor :: DescriptorInfo -> Decl ()
instanceReflectDescriptor DescriptorInfo
di
    = ()
-> Maybe (Overlap ())
-> InstRule ()
-> Maybe [InstDecl ()]
-> Decl ()
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl () Maybe (Overlap ())
forall a. Maybe a
Nothing (QName () -> [Type ()] -> InstRule ()
mkSimpleIRule (String -> QName ()
private String
"ReflectDescriptor") [() -> QName () -> Type ()
forall l. l -> QName l -> Type l
TyCon () (ProtoName -> QName ()
unqualName (DescriptorInfo -> ProtoName
descName DescriptorInfo
di))]) (Maybe [InstDecl ()] -> Decl ())
-> ([InstDecl ()] -> Maybe [InstDecl ()])
-> [InstDecl ()]
-> Decl ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstDecl ()] -> Maybe [InstDecl ()]
forall a. a -> Maybe a
Just ([InstDecl ()] -> Decl ()) -> [InstDecl ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$
        [ String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"getMessageInfo" [() -> Pat ()
forall l. l -> Pat l
PWildCard ()] Exp ()
gmi
        , String -> [Pat ()] -> Exp () -> InstDecl ()
inst String
"reflectDescriptorInfo" [() -> Pat ()
forall l. l -> Pat l
PWildCard ()] Exp ()
rdi ]
  where -- massive shortcut through show and read
        rdi :: Exp ()
        rdi :: Exp ()
rdi = String -> Exp ()
preludevar String
"read" Exp () -> Exp () -> Exp ()
$$ String -> Exp ()
litStr (DescriptorInfo -> String
forall a. Show a => a -> String
show DescriptorInfo
di)
        gmi,reqId,allId :: Exp ()
        gmi :: Exp ()
gmi = String -> Exp ()
pcon String
"GetMessageInfo" Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () Exp ()
reqId Exp () -> Exp () -> Exp ()
$$ () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
Paren () Exp ()
allId
        reqId :: Exp ()
reqId = String -> Exp ()
pvar String
"fromDistinctAscList" Exp () -> Exp () -> Exp ()
$$
                () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () ((Word32 -> Exp ()) -> [Word32] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> Exp ()
forall x. Integral x => x -> Exp ()
litInt ([Word32] -> [Exp ()])
-> ([[Word32]] -> [Word32]) -> [[Word32]] -> [Exp ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word32] -> [Word32]
forall a. Ord a => [a] -> [a]
sort ([Word32] -> [Word32])
-> ([[Word32]] -> [Word32]) -> [[Word32]] -> [Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Word32]] -> [Word32]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Word32]] -> [Exp ()]) -> [[Word32]] -> [Exp ()]
forall a b. (a -> b) -> a -> b
$ [ FieldInfo -> [Word32]
allowedList FieldInfo
fi | FieldInfo
fi <- Seq FieldInfo -> [FieldInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq FieldInfo
fields DescriptorInfo
di), FieldInfo -> Bool
isRequired FieldInfo
fi])
        allId :: Exp ()
allId = String -> Exp ()
pvar String
"fromDistinctAscList" Exp () -> Exp () -> Exp ()
$$
                () -> [Exp ()] -> Exp ()
forall l. l -> [Exp l] -> Exp l
List () ((Word32 -> Exp ()) -> [Word32] -> [Exp ()]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> Exp ()
forall x. Integral x => x -> Exp ()
litInt ([Word32] -> [Exp ()])
-> ([[Word32]] -> [Word32]) -> [[Word32]] -> [Exp ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word32] -> [Word32]
forall a. Ord a => [a] -> [a]
sort ([Word32] -> [Word32])
-> ([[Word32]] -> [Word32]) -> [[Word32]] -> [Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Word32]] -> [Word32]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Word32]] -> [Exp ()]) -> [[Word32]] -> [Exp ()]
forall a b. (a -> b) -> a -> b
$ [ FieldInfo -> [Word32]
allowedList FieldInfo
fi | FieldInfo
fi <- Seq FieldInfo -> [FieldInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq FieldInfo
fields DescriptorInfo
di)] [[Word32]] -> [[Word32]] -> [[Word32]]
forall a. [a] -> [a] -> [a]
++
                                                   [ FieldInfo -> [Word32]
allowedList FieldInfo
fi | FieldInfo
fi <- Seq FieldInfo -> [FieldInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorInfo -> Seq FieldInfo
knownKeys DescriptorInfo
di)])
        allowedList :: FieldInfo -> [Word32]
allowedList FieldInfo
fi | Just (WireTag
wt1,WireTag
wt2) <- FieldInfo -> Maybe (WireTag, WireTag)
packedTag FieldInfo
fi = [WireTag -> Word32
getWireTag WireTag
wt1,WireTag -> Word32
getWireTag WireTag
wt2]
                       | Bool
otherwise = [WireTag -> Word32
getWireTag (FieldInfo -> WireTag
wireTag FieldInfo
fi)]

------------------------------------------------------------------

mkSimpleIRule :: QName () -> [Type ()] -> InstRule ()
mkSimpleIRule :: QName () -> [Type ()] -> InstRule ()
mkSimpleIRule QName ()
con [Type ()]
args =
    let instHead :: InstHead ()
instHead = (InstHead () -> Type () -> InstHead ())
-> InstHead () -> [Type ()] -> InstHead ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (() -> InstHead () -> Type () -> InstHead ()
forall l. l -> InstHead l -> Type l -> InstHead l
IHApp ()) (() -> QName () -> InstHead ()
forall l. l -> QName l -> InstHead l
IHCon () QName ()
con) [Type ()]
args
    in ()
-> Maybe [TyVarBind ()]
-> Maybe (Context ())
-> InstHead ()
-> InstRule ()
forall l.
l
-> Maybe [TyVarBind l]
-> Maybe (Context l)
-> InstHead l
-> InstRule l
IRule () Maybe [TyVarBind ()]
forall a. Maybe a
Nothing Maybe (Context ())
forall a. Maybe a
Nothing InstHead ()
instHead

mkDeriving :: [QName ()] -> Deriving ()
#if MIN_VERSION_haskell_src_exts(1, 20, 0)
mkDeriving :: [QName ()] -> Deriving ()
mkDeriving [QName ()]
xs = () -> Maybe (DerivStrategy ()) -> [InstRule ()] -> Deriving ()
forall l.
l -> Maybe (DerivStrategy l) -> [InstRule l] -> Deriving l
Deriving () Maybe (DerivStrategy ())
forall a. Maybe a
Nothing ((QName () -> InstRule ()) -> [QName ()] -> [InstRule ()]
forall a b. (a -> b) -> [a] -> [b]
map (\QName ()
x -> QName () -> [Type ()] -> InstRule ()
mkSimpleIRule QName ()
x []) [QName ()]
xs)
#else
mkDeriving xs = Deriving () (map (\x -> mkSimpleIRule x []) xs)
#endif

derives,derivesEnum,derivesTypeable :: Deriving ()
derives :: Deriving ()
derives = [QName ()] -> Deriving ()
mkDeriving ([QName ()] -> Deriving ()) -> [QName ()] -> Deriving ()
forall a b. (a -> b) -> a -> b
$ (String -> QName ()) -> [String] -> [QName ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> QName ()
prelude [String
"Show",String
"Eq",String
"Ord",String
"Typeable",String
"Data",String
"Generic"]
derivesEnum :: Deriving ()
derivesEnum = [QName ()] -> Deriving ()
mkDeriving ([QName ()] -> Deriving ()) -> [QName ()] -> Deriving ()
forall a b. (a -> b) -> a -> b
$ (String -> QName ()) -> [String] -> [QName ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> QName ()
prelude [String
"Read",String
"Show",String
"Eq",String
"Ord",String
"Typeable",String
"Data",String
"Generic"]
derivesTypeable :: Deriving ()
derivesTypeable = [QName ()] -> Deriving ()
mkDeriving ([QName ()] -> Deriving ()) -> [QName ()] -> Deriving ()
forall a b. (a -> b) -> a -> b
$ [String -> QName ()
prelude String
"Typeable"]

-- All of these type names are also exported by Text.ProtocolBuffers.Header via Text.ProtocolBuffers.Basic
useType :: Int -> Maybe String
useType :: Int -> Maybe String
useType  Int
1 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Double"
useType  Int
2 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Float"
useType  Int
3 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Int64"
useType  Int
4 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Word64"
useType  Int
5 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Int32"
useType  Int
6 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Word64"
useType  Int
7 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Word32"
useType  Int
8 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Bool"
useType  Int
9 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Utf8"
useType Int
10 = Maybe String
forall a. Maybe a
Nothing
useType Int
11 = Maybe String
forall a. Maybe a
Nothing
useType Int
12 = String -> Maybe String
forall a. a -> Maybe a
Just String
"ByteString"
useType Int
13 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Word32"
useType Int
14 = Maybe String
forall a. Maybe a
Nothing
useType Int
15 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Int32"
useType Int
16 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Int64"
useType Int
17 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Int32"
useType Int
18 = String -> Maybe String
forall a. a -> Maybe a
Just String
"Int64"
useType  Int
x = String -> Maybe String
forall a. String -> a
imp (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"useType: Unknown type code (expected 1 to 18) of "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
x