module Text.ProtocolBuffers.ProtoCompile.Instances(showsType,parseType,showsLabel,parseLabel) where

import Text.ParserCombinators.ReadP
import Text.DescriptorProtos.FieldDescriptorProto.Type(Type(..))
import Text.DescriptorProtos.FieldDescriptorProto.Label(Label(..))

{-
instance Show Type where
  showsPrec _ = showsType

instance Read Type where
  readsPrec _ = readP_to_S readType
-}

showsLabel :: Label -> ShowS
showsLabel :: Label -> ShowS
showsLabel Label
LABEL_OPTIONAL String
s = String
"optional" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsLabel Label
LABEL_REQUIRED String
s = String
"required" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsLabel Label
LABEL_REPEATED String
s = String
"repeated" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

showsType :: Type -> ShowS
showsType :: Type -> ShowS
showsType Type
TYPE_DOUBLE String
s = String
"double" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_FLOAT String
s = String
"float" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_INT64 String
s = String
"int64" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_UINT64 String
s = String
"uint64" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_INT32  String
s = String
"int32" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_FIXED64 String
s = String
"fixed64" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_FIXED32 String
s = String
"fixed32" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_BOOL String
s = String
"bool" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_STRING String
s = String
"string" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_GROUP String
s = String
"group" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_MESSAGE String
s = String
"message" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_BYTES String
s = String
"bytes" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_UINT32 String
s = String
"uint32" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_ENUM String
s = String
"enum" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_SFIXED32 String
s = String
"sfixed32" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_SFIXED64 String
s = String
"sfixed64" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_SINT32 String
s = String
"sint32" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showsType Type
TYPE_SINT64 String
s = String
"sint64" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | parseType returns Nothing when the String is user-defined.  This means it could be either a
-- Message or an Enum or a syntax error. The Nothing return is fixed up in
-- Text.ProtocolBuffers.ProtoCompile.Resolve.fqField
parseType :: String -> Maybe Type
parseType :: String -> Maybe Type
parseType String
s = case ReadP Type -> ReadS Type
forall a. ReadP a -> ReadS a
readP_to_S ReadP Type
readType String
s of
                [(Type
val,[])] -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
val
                [(Type, String)]
_ -> Maybe Type
forall a. Maybe a
Nothing

-- | parseLabel recognizes optional, required, and repeated.  All other strings result in Nothing
parseLabel :: String -> Maybe Label
parseLabel :: String -> Maybe Label
parseLabel String
s = case ReadP Label -> ReadS Label
forall a. ReadP a -> ReadS a
readP_to_S ReadP Label
readLabel String
s of
                [(Label
val,[])] -> Label -> Maybe Label
forall a. a -> Maybe a
Just Label
val
                [(Label, String)]
_ -> Maybe Label
forall a. Maybe a
Nothing

readLabel :: ReadP Label
readLabel :: ReadP Label
readLabel = [ReadP Label] -> ReadP Label
forall a. [ReadP a] -> ReadP a
choice [ Label -> ReadP Label
forall (m :: * -> *) a. Monad m => a -> m a
return Label
LABEL_OPTIONAL ReadP Label -> ReadP String -> ReadP Label
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"optional"
                   , Label -> ReadP Label
forall (m :: * -> *) a. Monad m => a -> m a
return Label
LABEL_REQUIRED ReadP Label -> ReadP String -> ReadP Label
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"required"
                   , Label -> ReadP Label
forall (m :: * -> *) a. Monad m => a -> m a
return Label
LABEL_REPEATED ReadP Label -> ReadP String -> ReadP Label
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"repeated"
                   ]

-- readType interprets the string in the proto file, but there is no way to know if an unknown
-- string refers to a Message or to an Enum
readType :: ReadP Type
readType :: ReadP Type
readType = [ReadP Type] -> ReadP Type
forall a. [ReadP a] -> ReadP a
choice [ Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_DOUBLE ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"double"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_FLOAT ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"float"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_INT64 ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"int64"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_UINT64 ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"uint64"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_INT32  ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"int32"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_FIXED64 ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"fixed64"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_FIXED32 ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"fixed32"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_BOOL ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"bool"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_STRING ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"string"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_GROUP ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"group"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_BYTES ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"bytes"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_UINT32 ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"uint32"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_SFIXED32 ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"sfixed32"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_SFIXED64 ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"sfixed64"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_SINT32 ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"sint32"
                  , Type -> ReadP Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
TYPE_SINT64 ReadP Type -> ReadP String -> ReadP Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ReadP String
string String
"sint64"
                  ]
--                , return TYPE_MESSAGE << string "..."
--                , return TYPE_ENUM << string "..."

(<<) :: Monad m => m a -> m b -> m a
<< :: m a -> m b -> m a
(<<) = (m b -> m a -> m a) -> m a -> m b -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m b -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)