make parser monadic

src/Language/Wasm/Parser.y

@@ -101,6 +101,7 @@ import Debug.Trace as Debug
 %name parseModule mod
 %name parseModuleFields modAsFields
 %name parseScript script
+%monad { Either String }
 %tokentype { Lexeme }
 
 %token
@@ -1355,8 +1356,8 @@ data ModuleField =
     | MFData DataSegment
     deriving(Show, Eq, Generic, NFData)
 
-happyError (Lexeme _ EOF : []) = error $ "Error occuried during parsing phase at the end of file"
+happyError (Lexeme _ EOF : []) = Left $ "Error occuried during parsing phase at the end of file"
-happyError (Lexeme (AlexPn abs line col) tok : tokens) = error $
+happyError (Lexeme (AlexPn abs line col) tok : tokens) = Left $
     "Error occuried during parsing phase. " ++
     "Line " ++ show line ++ ", " ++
     "Column " ++ show col ++ ", " ++

src/Language/Wasm/Script.hs

@@ -144,7 +144,7 @@ runScript onAssertFail script = do
         buildModule :: ModuleDef -> (Maybe Ident, Struct.Module)
         buildModule (RawModDef ident m) = (ident, m)
         buildModule (TextModDef ident textRep) =
-            let Right m = Parser.parseModule <$> Lexer.scanner (TLEncoding.encodeUtf8 textRep) in
+            let Right m = Lexer.scanner (TLEncoding.encodeUtf8 textRep) >>= Parser.parseModule in
             (ident, m)
         buildModule (BinaryModDef ident binaryRep) =
             let Right m = Binary.decodeModuleLazy binaryRep in
@@ -199,7 +199,7 @@ runScript onAssertFail script = do
                                 ++ show (getFailureString reason)
                         in onAssertFail msg assert
         runAssert st assert@(AssertMalformed (TextModDef _ textRep) failureString) =
-            case DeepSeq.force $ Parser.parseModule <$> Lexer.scanner (TLEncoding.encodeUtf8 textRep) of
+            case DeepSeq.force $ Lexer.scanner (TLEncoding.encodeUtf8 textRep) >>= Parser.parseModule of
                 Right _ -> onAssertFail ("Module parsing should fail with failure string " ++ show failureString) assert
                 Left _ -> return ()
         runAssert st assert@(AssertMalformed (BinaryModDef ident binaryRep) failureString) =

tests/Test.hs

@@ -27,7 +27,7 @@ isRight _         = False
 compile :: String -> IO ()
 compile file = do
   content <- LBS.readFile $ "tests/samples/" ++ file
-  let Right mod = Parser.parseModule <$> Lexer.scanner content
+  let Right mod = Lexer.scanner content >>= Parser.parseModule
   LBS.writeFile ("tests/runnable/" ++ file) $ Binary.dumpModuleLazy mod
   -- to run: python -m SimpleHTTPServer 8081 && open http://localhost:8081/tests/runnable
 
@@ -37,7 +37,7 @@ main = do
   -- let files = ["data.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     content <- LBS.readFile $ "tests/samples/" ++ file
-    let Right script = Parser.parseScript <$> Lexer.scanner content
+    let Right script = Lexer.scanner content >>= Parser.parseScript
     return $ testCase file $ do
       Script.runScript (\msg assert -> assertFailure ("Failed assert: " ++ msg ++ ". Assert " ++ show assert)) script
   defaultMain $ testGroup "Wasm Core Test Suit" scriptTestCases