Encounter runtime parse error in ghci representation issue #4

src/ProtoRoute.hs

@@ -2,22 +2,14 @@ module ProtoRoute
        ( main
        ) where
 
-import Data.ProtoLens
-import Language.Haskell.Ghcid  (execStream, startGhci, stopGhci)
-import System.Directory (getCurrentDirectory)
+import Data.Text (pack)
+import ProtoRoute.Ghcid (runGhci)
+import ProtoRoute.Message (MsgName (..), FieldName (..), FVType (..),
+                           FieldValue (..), constructProtoMsg)
 
 main :: IO ()
-main = do
-    let f = \_ s -> putStrLn s
-    curDir <- getCurrentDirectory
-    (g, _) <- startGhci "ghci" (Just curDir) f
-    let runCmd s = execStream g s f
-    runCmd "import Data.Text"
-    runCmd "import Data.ProtoLens.Encoding"
-    runCmd ":load src/ProtoExports"
-    runCmd "test = \"someQuery\""
-    runCmd $ passArgs "test" []
-    -- Value of generated msg, and its serialized representation
-    runCmd "sr"
-    runCmd "encodeMessage sr"
-    stopGhci g
+main = runGhci $ constructProtoMsg sreq [(query, someText)]
+  where
+    sreq  = MN $ pack "SearchRequest"
+    query = FN $ pack "query"
+    someText = FieldText (Req $ pack "someText")

src/ProtoRoute/Ghcid.hs

@@ -2,16 +2,17 @@ module ProtoRoute.Ghcid
     ( runGhci
     ) where
 
-import Data.Text (unpack)
+import Data.Text (unpack, Text)
 import Language.Haskell.Ghcid (execStream, startGhci, stopGhci)
-import ProtoRoute.Message (constructProtoMessage, FieldName, FieldValue, MessageName)
+import ProtoRoute.Message (constructProtoMsg)
 import System.Directory (getCurrentDirectory)
 
 -- Should runGhci have the following type signature and start off like so?
 runGhci :: Text -> IO ()
-runGhci = do
+runGhci stuff = do
     let f = \_ s -> putStrLn s
     curDir <- getCurrentDirectory
     (g, _) <- startGhci "ghci" (Just curDir) f
     let runCmd s = execStream g s f
+    runCmd ("let testMsg = " ++ unpack stuff)
     stopGhci g

src/ProtoRoute/Message.hs

@@ -1,26 +1,35 @@
 module ProtoRoute.Message
-    ( constructProtoMessage
-    , MessageName
-    , FieldName
-    , FieldValue
-    ) where
+    ( MsgName (..)
+    , FieldName (..)
+    , FVType (..)
+    , Msg (..)
+    , FieldValue (..)
+    , constructProtoMsg) where
 
-import Data.ProtoLens
-import Data.Text (pack)
-import ProtoExports
+import Data.Text (pack, Text)
 
+newtype MsgName   = MN Text deriving (Show)
+newtype FieldName = FN Text deriving (Show)
 
-newtype MessageName = MessageName { unMessageName :: Text }
-newtype FieldName   = FieldName   { unFieldName   :: Text }
-data    FieldValue  = FV [Int] | FV [Text] | FV [FieldValue]
+data FieldValue a = Req a | Opt (Maybe a) | Rep [a] deriving (Show)
+data FVType       = FieldText (FieldValue Text) | FieldInt (FieldValue Int) |
+                    FieldMsg (FieldValue Msg) deriving (Show)
+-- Typesafe representation of a protobuf mesage
+data Msg = Msg
+    { messageName :: MsgName
+    , messageFields :: [(FieldName, FVType)]
+    } deriving (Show)
 
-constructProtoMessage :: MessageName -> [(FieldName, FieldValue)] -> Text
-constructProtoMessage msgName namesVals = msgName ++ pack " {"
+constructProtoMsg :: MsgName -> [(FieldName, FVType)] -> Text
+constructProtoMsg msgName namesVals =
+    pack (show msgName ++ " {" ++ addRest msgName namesVals ++ "} ")
   where
-    singleEntry = pack ("_" ++ msgName ++ "\'" ++ fn ++ " = " ++ pack . show fv)
+    singleEntry :: MsgName -> (FieldName, FVType) -> String
+    singleEntry name (fn, fv) =
+        "_" ++ show name ++ "\'" ++ show fn ++ " = " ++ show fv
 
-    addRest :: MessageName -> [(FieldName, FieldValue)] -> Text
-    addRest _ [] = pack ""
-    addRest _ [(fn, fv)] = singleEntry
-    addRest msgName (fn,fv):others =
-        pack (singleEntry ++ ", " ++ addRest msgName rest)
+    addRest :: MsgName -> [(FieldName, FVType)] -> String
+    addRest _ [] = ""
+    addRest name [(fn, fv)] = singleEntry name (fn, fv)
+    addRest name ((fn, fv) : others) =
+        singleEntry name (fn, fv) ++ ", " ++ addRest name others