Ticket #3034: Parse.hs

File Parse.hs, 2.2 KB (added by batterseapower, 5 years ago)
Line 
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
2
3module Main where
4
5import Data.Word
6
7import qualified Data.ByteString as BS
8import qualified Data.ByteString.Unsafe as BS
9
10-- MTL
11import Control.Monad.Identity
12import Control.Monad.Error
13import Control.Monad.State.Strict
14
15
16data Step s a = Yield a s
17              | Skip s
18              | Done
19
20
21type ParseInt q a = StateT q (StateT Int (ErrorT String Identity)) a
22
23main = print "Hello"
24
25
26foo :: Int -> Int -> BS.ByteString -> Either String Int
27foo n1 n2 bs = runIdentity $ runErrorT $ evalStateT (evalStateT s2 n1) 100
28  where
29    next :: Int -> Step Int Word8
30    next i | i == n2   = Done
31           | otherwise = Yield (bs `BS.unsafeIndex` i) (i+1)
32
33    wrap :: Monad m => (Word8 -> StateT Int m a) -> StateT Int m a -> StateT Int m a
34    wrap yield (done::StateT Int m a) = loop
35       where loop :: StateT Int m a
36             loop = do q <- get
37                       case next q of
38                         Yield x q' -> put q' >> yield x
39                         Skip    q' -> put q' >> loop
40                         Done       -> done
41    s2 :: ParseInt Int Int
42    s2 = wrap yield done
43       where yield :: Word8 -> StateT Int (StateT Int (ErrorT String Identity)) Int
44             yield x | x==48     = digit 0
45                     | x==49     = digit 1
46                     | x==50     = digit 2
47                     | x==51     = digit 3
48                     | x==52     = digit 4
49                     | x==53     = digit 5
50                     | x==54     = digit 6
51                     | x==55     = digit 7
52                     | x==56     = digit 8
53                     | x==57     = digit 9
54                     | otherwise = do !y <- lift get
55                                      return y
56                 where digit :: Int -> ParseInt Int Int
57                       digit !x = do !y <- lift get
58                                     ( if y <= (maxBound-9)`quot`10 || y <= (maxBound-x)`div`10
59                                       then let !y' = y*10+x in (lift $ put y') >> s2
60                                       else throwError "integer overflow" )
61                               
62             done :: ParseInt Int Int
63             done                = do !y <- lift get
64                                      return y