Finish parsing protocols! 🎊

higherkindness · Feb 3, 2020 · f1a1c75 · f1a1c75
1 parent 1970a13
commit f1a1c75
Show file tree

Hide file tree

Showing 3 changed files with 32 additions and 6 deletions.
diff --git a/src/Language/Avro/Parser.hs b/src/Language/Avro/Parser.hs
@@ -91,9 +91,29 @@ parseImport =
 
 parseProtocol :: MonadParsec Char T.Text m => m Protocol
 parseProtocol =
-  Protocol <$> optional parseNamespace <* reserved "protocol"
+  buildProtocol <$> optional parseNamespace <* reserved "protocol"
     <*> identifier
-    <*> braces (many parseImport) -- TODO: here goes more things!
+    <*> braces (many serviceThing)
+  where
+    buildProtocol :: Maybe Namespace -> T.Text -> [ProtocolThing] -> Protocol
+    buildProtocol ns name things =
+      Protocol
+        ns
+        name
+        [i | ProtocolThingImport i <- things]
+        [t | ProtocolThingType t <- things]
+        [m | ProtocolThingMethod m <- things]
+
+data ProtocolThing
+  = ProtocolThingImport ImportType
+  | ProtocolThingType Schema
+  | ProtocolThingMethod Method
+
+serviceThing :: MonadParsec Char T.Text m => m ProtocolThing
+serviceThing =
+  ProtocolThingImport <$> parseImport
+  <|> ProtocolThingType <$> parseSchema
+  <|> ProtocolThingMethod <$> parseMethod
 
 parseVector :: MonadParsec Char T.Text m => m a -> m (Vector a)
 parseVector t = fromList <$> braces (lexeme $ sepBy1 t $ symbol ",")

diff --git a/src/Language/Avro/Types.hs b/src/Language/Avro/Types.hs
@@ -1,4 +1,6 @@
-module Language.Avro.Types where
+module Language.Avro.Types (
+  module Language.Avro.Types, Schema (..)
+) where
 
 import Data.Avro.Schema
 import qualified Data.Text as T
@@ -7,9 +9,9 @@ data Protocol
   = Protocol
       { ns :: Maybe Namespace,
         pname :: T.Text,
-        imports :: [ImportType]
-        -- TODO: , types :: [Schema]
-        -- TODO: , messages :: [Method]
+        imports :: [ImportType],
+        types :: [Schema],
+        messages :: [Method]
       }
   deriving (Eq, Show)
 

diff --git a/test/Spec.hs b/test/Spec.hs
@@ -168,6 +168,8 @@ main = hspec $ do
                          Nothing
                          "PeopleService"
                          [IdlImport "People.avdl"]
+                         []
+                         []
                    )
     it "should parse with namespace" $
       parse parseProtocol "" (T.unlines simpleProtocol)
@@ -176,6 +178,8 @@ main = hspec $ do
                          (Just (Namespace ["example", "seed", "server", "protocol", "avro"]))
                          "PeopleService"
                          [IdlImport "People.avdl"]
+                         []
+                         []
                    )
   describe "Parse services" $ do
     it "should parse simple messages" $