Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

adding support for comments to parser

  • Loading branch information...
commit 29c28a50271ce38ea106f63f9e477ce7b33f65b3 1 parent 7b29fe6
Alexander Bernauer authored
Showing with 49 additions and 39 deletions.
  1. +36 −25 src/Language/Bitcoin/Parser.hs
  2. +13 −14 test/Language/Bitcoin/Test/Parser.hs
View
61 src/Language/Bitcoin/Parser.hs
@@ -5,51 +5,62 @@ module Language.Bitcoin.Parser
) where
-- import {{{1
+import Control.Monad (liftM, when)
+import Data.Char (isSpace)
+import Data.Int (Int32)
+import Data.Maybe (catMaybes)
+import Data.Word (Word8)
import Language.Bitcoin.Types
import Language.Bitcoin.Utils (b2i, bsLength)
-import Text.ParserCombinators.Parsec (Parser, parse, sepEndBy, eof, many, (<|>), (<?>), alphaNum, char, hexDigit, newline, unexpected, satisfy)
-import Text.Parsec.Prim (parserFail)
-import Control.Monad (liftM, when)
import qualified Data.ByteString as B
import qualified Data.Char as C
-import Data.Word (Word8)
-import Data.Int (Int32)
-import Data.Char (isSpace)
-import Data.Maybe (catMaybes)
+import qualified Data.List as List
+import Text.Parsec.Prim (parserFail)
+import Text.ParserCombinators.Parsec (Parser, parse, sepEndBy, eof, many, (<|>), (<?>), alphaNum, char, hexDigit, newline, unexpected, satisfy)
-- run_parser :: String -> Code -> Either String Script {{{1
run_parser :: String -> Code -> Either String Script
run_parser source code =
- case parse script source code of
+ case parse script source (removeComments code) of
Left parseError -> Left $ show parseError
Right x -> Right x
+removeComments :: String -> String
+removeComments [] = []
+removeComments string =
+ let
+ (code, rest) = List.break (=='#') string
+ (_, string') = List.break (=='\n') rest
+ in code ++ removeComments string'
+
script :: Parser Script
script = do
- ops <- liftM catMaybes $ sepEndBy operation separator
- spaces >> eof
+ ops <- spaces >> (liftM catMaybes $ sepEndBy operation separator)
+ eof
return ops
-separator :: Parser Char
-separator = spaces >> (newline <|> char ';')
+separator :: Parser ()
+separator = (newline <|> char ';') >> spaces >> return ()
spaces :: Parser String
spaces = many (satisfy (\c -> isSpace c && not (c =='\n')))
operation :: Parser (Maybe Command)
operation = do
- command <- spaces >> many (alphaNum <|> char '_' <?> "opcode")
- if command == ""
- then return Nothing
- else liftM Just $ case command of
- "DATA" -> spaces >> liftM DATA hexString
- "KEY" -> keyOrSig KEY
- "SIG" -> keyOrSig SIG
- "OP_PUSHDATA" -> push
- "OP_PUSHDATA1" -> push1
- "OP_PUSHDATA2" -> push2
- "OP_PUSHDATA4" -> push4
- x -> opcode x
+ op <- do
+ command <- many (alphaNum <|> char '_' <?> "opcode")
+ if command == ""
+ then return Nothing
+ else liftM Just $ case command of
+ "DATA" -> spaces >> liftM DATA hexString
+ "KEY" -> keyOrSig KEY
+ "SIG" -> keyOrSig SIG
+ "OP_PUSHDATA" -> push
+ "OP_PUSHDATA1" -> push1
+ "OP_PUSHDATA2" -> push2
+ "OP_PUSHDATA4" -> push4
+ x -> opcode x
+ spaces >> return op
keyOrSig :: (Int32 -> Command) -> Parser Command
keyOrSig createCommand = do
@@ -65,7 +76,7 @@ push :: Parser Command
push = pushN checkLength checkValue Direct
where
checkLength len = when (len /= 1) $ parserFail "OP_PUSHDATA expects a one byte size parameter"
- checkValue value = when (value > 75) $ parserFail "OP_PUSHDATA only support up to 0x75 bytes of data"
+ checkValue value = when (value > 75) $ parserFail "OP_PUSHDATA only support up to 75 bytes of data"
push1 :: Parser Command
push1 = pushN checkLength checkValue OneByte
View
27 test/Language/Bitcoin/Test/Parser.hs
@@ -15,10 +15,14 @@ tests = TestLabel "Parser" $ TestList $ good ++ bad
goodCases = [
("OP_FALSE", [CmdOpcode OP_FALSE])
+ , ("OP_FALSE ", [CmdOpcode OP_FALSE])
+ , (" OP_FALSE", [CmdOpcode OP_FALSE])
+ , (" OP_FALSE ; ", [CmdOpcode OP_FALSE])
, ("OP_FALSE\n", [CmdOpcode OP_FALSE])
, ("OP_FALSE;", [CmdOpcode OP_FALSE])
- , (" OP_FALSE ; ", [CmdOpcode OP_FALSE])
, (" ; \n ;", [])
+ , ("OP_FALSE # comment", [CmdOpcode OP_FALSE])
+ , ("# comment\nOP_FALSE", [CmdOpcode OP_FALSE])
, ("OP_FALSE;OP_TRUE", [CmdOpcode OP_FALSE, CmdOpcode OP_TRUE])
, ("OP_PUSHDATA 01 23", [CmdOpcode $ OP_PUSHDATA Direct (bs 0x23)])
, ("OP_PUSHDATA1 06 040815162342", [CmdOpcode $ OP_PUSHDATA OneByte (bs 0x40815162342)])
@@ -30,12 +34,12 @@ goodCases = [
]
badCases = [
- "foo;",
- "OP_DOESNOTEXIST;",
- "OP_PUSHDATA 0;",
- "OP_PUSHDATA 76;",
- "OP_PUSHDATA1 100 1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111;",
- "OP_PUSHDATA1 1 2342"
+ ("foo", "expecting opcode")
+ , ("OP_DOESNOTEXIST", "expecting opcode")
+ , ("OP_PUSHDATA 0;", "expecting hexadecimal digit")
+ , ("OP_PUSHDATA 4c;", "OP_PUSHDATA only support up to 75 bytes of data")
+ , ("OP_PUSHDATA1 100 1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111;", "expecting hexadecimal digit")
+ , ("OP_PUSHDATA1 1 2342", "expecting hexadecimal digit")
]
good :: [Test]
@@ -50,12 +54,7 @@ good = map runTest goodCases
bad :: [Test]
bad = map runTest badCases
where
- runTest code = TestCase $
+ runTest (code, expected) = TestCase $
case run_parser "<<test>>" code of
- Left err -> putStrLn $ infoString code err
+ Left err -> (last . lines) err @=? expected
Right _ -> assertFailure "Parser should have failed"
-
-infoString :: String -> String -> String
-infoString code err =
- "'" ++ code ++ "' -> " ++ (last $ lines $ err)
-
Please sign in to comment.
Something went wrong with that request. Please try again.