improving the parser

bitcoin-script-engine.cabal

@@ -39,4 +39,5 @@ executable Test
   build-depends:
     HUnit >= 1.2.2.1
   other-modules:
-    Language.Bitcoin.Test.Opcodes
+    Language.Bitcoin.Test.Simulator
+    Language.Bitcoin.Test.Parser

examples/success.bcs

@@ -0,0 +1 @@
+OP_TRUE

src/Language/Bitcoin/Parser.hs

@@ -1,7 +1,8 @@
 module Language.Bitcoin.Parser
 -- export {{{1
 (
-	run_parser, run_printer
+  run_parser, run_parser',
+  run_printer
 ) where
 
 -- import {{{1
@@ -10,22 +11,33 @@ import Text.ParserCombinators.Parsec
 import qualified Data.ByteString.Char8 as B
 
 -- run_parser :: Code -> Script {{{1
+
 run_parser :: String -> Code -> Either ParseError Script
-run_parser source code = parse script source (B.unpack code)
+run_parser source code = run_parser' source (B.unpack code)
 
+run_parser' :: String -> String -> Either ParseError Script
+run_parser' source code = parse script source code
 
 script :: Parser Script
-script = endBy operation separator
+script = spaces >> endBy operation separator
 
 operation :: Parser Opcode
 operation = opcode -- <|> paste
 
 opcode :: Parser Opcode
-opcode = string "OP_FALSE" >> return OP_FALSE
+opcode = do
+  prefix <- string "OP_"
+  suffix <- many alphaNum
+  let op = prefix ++ suffix
+  let readings = reads op
+  if length readings /= 1 || snd (head readings) /= ""
+    then unexpected op <?> "valid opcode"
+    else return $ fst $ head readings
+
 --paste = string "PASTE" >> bytes >>= (\bs -> return PASTE DATA (pack bs))
 
 separator :: Parser Char
-separator = char '\n' <|> char ';'
+separator = newline <|> char ';'
 
 
 -- run_printer :: Script -> Code {{{1

src/Language/Bitcoin/Types.hs

@@ -1,5 +1,4 @@
 module Language.Bitcoin.Types where
-
 -- import {{{1
 import Data.Word (Word8)
 import qualified Data.ByteString.Char8 as B
@@ -149,13 +148,13 @@ data Opcode =
   | OP_NOP8
   | OP_NOP9
   | OP_NOP10
-  deriving (Show)
+  deriving (Show, Eq, Read)
 
 -- data Data = {{{1
 data Data =
 	  DATA Word8
   | OP_PUSHDATA1 Word8
   | OP_PUSHDATA2 Word8 Word8
   | OP_PUSHDATA4 Word8 Word8 Word8 Word8
-	deriving (Show)
+	deriving (Show, Eq, Read)
 

test/Language/Bitcoin/Test/Parser.hs

@@ -0,0 +1,39 @@
+module Language.Bitcoin.Test.Parser
+(
+  tests
+) where
+
+import Language.Bitcoin.Parser (run_parser')
+import Language.Bitcoin.Types
+import Test.HUnit
+
+tests = TestLabel "Parser" $ TestList $ good ++ bad
+
+goodCases = [
+    ("OP_FALSE\n", [OP_FALSE])
+  , ("OP_FALSE;", [OP_FALSE])
+  , (" OP_FALSE;", [OP_FALSE])
+  , ("OP_FALSE;OP_TRUE;", [OP_FALSE, OP_TRUE])
+  , ("OP_FALSE\nOP_TRUE;", [OP_FALSE, OP_TRUE])
+  ]
+
+badCases = [
+  "OP_DOESNOTEXIST;"
+  ]
+
+good :: [Test]
+good = map runTest goodCases
+  where
+    runTest (code, expected) = TestCase $
+      case run_parser' "<<test>>" code of
+        Left e -> assertString $ show e
+        Right script -> expected @=? script
+
+
+bad :: [Test]
+bad = map runTest badCases
+  where
+    runTest code = TestCase $
+      case run_parser' "<<test>>" code of
+        Left _ -> return ()
+        Right _ -> assertString "Parser should have failed"

test/Language/Bitcoin/Test/Opcodes.hs → test/Language/Bitcoin/Test/Simulator.hs

@@ -1,4 +1,4 @@
-module Language.Bitcoin.Test.Opcodes
+module Language.Bitcoin.Test.Simulator
 (
 	tests
 ) where
@@ -7,7 +7,7 @@ import Language.Bitcoin.Simulator (run_simulator')
 import Language.Bitcoin.Types
 import Test.HUnit
 
-tests = TestLabel "Opcodes" $ TestList testSimpleOps
+tests = TestLabel "Simulator" $ TestList testSimpleOps
 
 simpleOps = [
 	  ([], [], [])

test/Test.hs

@@ -2,9 +2,10 @@ import Test.HUnit (Test(TestList), runTestText, putTextToHandle, Counts(errors,
 import System.IO (stderr)
 import System.Exit (exitWith, ExitCode(ExitFailure))
 
-import qualified Language.Bitcoin.Test.Opcodes as A
+import qualified Language.Bitcoin.Test.Simulator as A
+import qualified Language.Bitcoin.Test.Parser as B
 
-tests = TestList [A.tests]
+tests = TestList [A.tests, B.tests]
 
 main = do
   (count, _ ) <- runTestText (putTextToHandle stderr False) tests