aboutsummaryrefslogtreecommitdiff
path: root/ch19/19_b_2.hs
blob: 8e8300ce8cf29919fa979af044918f96d1400f1d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
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