diff options
| author | Jan Sucan <jan@jansucan.com> | 2025-09-06 21:57:23 +0200 |
|---|---|---|
| committer | Jan Sucan <jan@jansucan.com> | 2025-09-06 21:57:23 +0200 |
| commit | 167271ef6a3dfac1c4603e92bc651f8c9963d96e (patch) | |
| tree | 3bab7880a1c417a105bfcbfaeba0b97265fd6dea | |
| parent | d73d68b69da59f2895e3340007adf9aa9acadc72 (diff) | |
19_b_2, 19_b_3: Add solution
| -rw-r--r-- | README.md | 4 | ||||
| -rw-r--r-- | ch19/19_b_2.hs | 118 |
2 files changed, 120 insertions, 2 deletions
@@ -182,8 +182,8 @@ are prefixed with 'Module_'. | **_18_b_1_** | yes | 441 | | | **_19_a_1_** | yes | 462 | 19. Error handling | | **_Module_19_b_1_** | yes | 465 | | -| 19_b_2 | | | | -| 19_b_3 | | | | +| 19_b_2 | yes | | | +| 19_b_3 | yes, in 19_b_2 | | | | **_23_a_1_** | | 529 | 23. GUI programming with gtk2hs| | 23_a_2 | | | | | 23_a_3 | | | | diff --git a/ch19/19_b_2.hs b/ch19/19_b_2.hs new file mode 100644 index 0000000..8e8300c --- /dev/null +++ b/ch19/19_b_2.hs @@ -0,0 +1,118 @@ +-- 1. Use many to write an int parser, with type Parser Int. It should accept +-- negative as well as positive integers. +-- +-- 2. Modify your int parser to throw a NumericOverflow exception if it detects +-- a numeric overflow while parsing. + + +-- For simplicity, I use NumericOverflow also for indicating underflow as the +-- ParseError doesn't contain it and I didn't want to modify it in the module of +-- the previous exercise. + + +import Module_19_b_1 + +import qualified Data.ByteString.Char8 as B -- For testing + +import Data.Char +import Control.Monad.Except +import Control.Monad.State + +parseIntStr :: Parser String +parseIntStr = do + -- It's not possible to decide about success or error only from the first + -- char. When the string starts with '-', then it depends on what is following + -- it: digit is success, not digit is error. + -- Save the the input string so it can be restored in the case of error. + s <- liftP get + + -- 'satisfy' doesn't consume from the input in the case of error. No need to + -- restore it before throwing error. + first <- satisfy (\x -> x == '-' || isDigit x) `catchError` \_ -> throwError notAnIntError + rest <- many $ satisfy isDigit + if first == '-' && null rest + then + -- Error: Minus char is not followed by any digits. Restore the input (the + -- '-' char). + liftP (put s) >> throwError notAnIntError + else return $ first : rest + where + notAnIntError = Chatty "not an Int" + +parseInt :: Parser Int +parseInt = do + str <- parseIntStr + let i = read str :: Int + -- Detect overflow/underflow by doing 'show.read' roundtrip. If the Int-string + -- is too long (too big positive or negative number), the 'read' function + -- still converts it successfully, but with overflow/underflow. If 'show' + -- doesn't produce back the original Int-string, then overflow/underflow + -- happened. + if show i == str + then return i + else throwError NumericOverflow + + + + +-- Parse Int-string or the first two chars. When parsing "-abc" fails, the "-a" +-- should still stay in the input and be parsed and returned by this parser. +testRestore :: Parser String +testRestore = do + parseIntStr `catchError` \_ -> (\x y -> [x, y]) <$> satisfy allChar <*> satisfy allChar + where + allChar _ = True + + +-- ghci> :l 19_b_2.hs +-- [1 of 3] Compiling Module_19_b_1 ( Module_19_b_1.hs, interpreted ) +-- [2 of 3] Compiling Main ( 19_b_2.hs, interpreted ) +-- Ok, two modules loaded. + +-- ghci> runParser testRestore (B.pack "-abc") +-- Right ("-a","bc") + +-- ghci> runParser parseInt (B.pack "") +-- Left (Chatty "not an Int") + +-- ghci> runParser parseInt (B.pack "-") +-- Left (Chatty "not an Int") + +-- ghci> runParser parseInt (B.pack "-abc") +-- Left (Chatty "not an Int") + +-- ghci> runParser parseInt (B.pack "-123") +-- Right (-123,"") + +-- ghci> runParser parseInt (B.pack "-123abc") +-- Right (-123,"abc") + +-- ghci> runParser parseInt (B.pack "-1") +-- Right (-1,"") + +-- ghci> runParser parseInt (B.pack "0") +-- Right (0,"") + +-- ghci> runParser parseInt (B.pack "1") +-- Right (1,"") + +-- ghci> runParser parseInt (B.pack "abc") +-- Left (Chatty "not an Int") + +-- ghci> runParser parseInt (B.pack "123") +-- Right (123,"") + +-- ghci> runParser parseInt (B.pack "123abc") +-- Right (123,"abc") + +-- ghci> runParser parseInt (B.pack $ show ((toInteger (minBound :: Int)) - 1)) +-- Left NumericOverflow + +-- ghci> runParser parseInt (B.pack $ show ((toInteger (minBound :: Int)) )) +-- Right (-9223372036854775808,"") + +-- ghci> runParser parseInt (B.pack $ show ((toInteger (maxBound :: Int)) )) +-- Right (9223372036854775807,"") + +-- ghci> runParser parseInt (B.pack $ show ((toInteger (maxBound :: Int)) + 1)) +-- Left NumericOverflow |
