@@ -0,0 +1,155 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+-- |
4+-- Module : Data.Text.Lazy.Read
5+-- Copyright : (c) 2010 Bryan O'Sullivan
6+--
7+-- License : BSD-style
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
9+-- duncan@haskell.org
10+-- Stability : experimental
11+-- Portability : GHC
12+--
13+-- Functions used frequently when reading textual data.
14+module Data.Text.Lazy.Read
15+ (
16+ Reader
17+ , decimal
18+ , hexadecimal
19+ , signed
20+ , rational
21+ , double
22+ ) where
23+
24+import Control.Monad (liftM)
25+import Data.Char (digitToInt, isDigit, isHexDigit, ord)
26+import Data.Ratio
27+import Data.Text.Lazy as T
28+
29+-- | Read some text, and if the read succeeds, return its value and
30+-- the remaining text.
31+type Reader a = Text -> Either String (a,Text)
32+
33+-- | Read a decimal integer.
34+--
35+-- This function does not handle leading sign characters. If you need
36+-- to handle signed input, use @'signed' 'decimal'@.
37+decimal :: Integral a => Reader a
38+{-# SPECIALIZE decimal :: Reader Int #-}
39+{-# SPECIALIZE decimal :: Reader Integer #-}
40+decimal txt
41+ | T.null h = Left "no digits in input"
42+ | otherwise = Right (T.foldl' go 0 h, t)
43+ where (h,t) = T.spanBy isDigit txt
44+ go n d = (n * 10 + fromIntegral (digitToInt d))
45+
46+-- | Read a hexadecimal number, with optional leading @\"0x\"@. This
47+-- function is case insensitive.
48+--
49+-- This function does not handle leading sign characters. If you need
50+-- to handle signed input, use @'signed' 'hexadecimal'@.
51+hexadecimal :: Integral a => Reader a
52+{-# SPECIALIZE hex :: Reader Int #-}
53+{-# SPECIALIZE hex :: Reader Integer #-}
54+hexadecimal txt
55+ | T.toLower h == "0x" = hex t
56+ | otherwise = hex txt
57+ where (h,t) = T.splitAt 2 txt
58+
59+-- | Read a leading sign character (@\'-\'@ or @\'+\'@) and apply it
60+-- to the result of applying the given reader.
61+signed :: Num a => Reader a -> Reader a
62+{-# INLINE signed #-}
63+signed f = runP (signa (P f))
64+
65+-- | Read a rational number.
66+--
67+-- This function accepts an optional leading sign character.
68+rational :: RealFloat a => Reader a
69+{-# SPECIALIZE rational :: Reader Double #-}
70+rational = floaty $ \real frac fracDenom -> fromRational $
71+ real % 1 + frac % fracDenom
72+
73+-- | Read a rational number.
74+--
75+-- This function accepts an optional leading sign character.
76+--
77+-- /Note/: This function is almost ten times faster than 'rational',
78+-- but is slightly less accurate.
79+--
80+-- The 'Double' type supports about 16 decimal places of accuracy.
81+-- For 94.2% of numbers, this function and 'rational' give identical
82+-- results, but for the remaining 5.8%, this function loses precision
83+-- around the 15th decimal place. For 0.001% of numbers, this
84+-- function will lose precision at the 13th or 14th decimal place.
85+double :: Reader Double
86+double = floaty $ \real frac fracDenom ->
87+ fromIntegral real +
88+ fromIntegral frac / fromIntegral fracDenom
89+
90+hex :: Integral a => Reader a
91+{-# SPECIALIZE hex :: Reader Int #-}
92+{-# SPECIALIZE hex :: Reader Integer #-}
93+hex txt
94+ | T.null h = Left "no digits in input"
95+ | otherwise = Right (T.foldl' go 0 h, t)
96+ where (h,t) = T.spanBy isHexDigit txt
97+ go n d = (n * 16 + fromIntegral (hexDigitToInt d))
98+
99+hexDigitToInt :: Char -> Int
100+hexDigitToInt c
101+ | c >= '0' && c <= '9' = ord c - ord '0'
102+ | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)
103+ | c >= 'A' && c <= 'F' = ord c - (ord 'A' - 10)
104+ | otherwise = error "Data.Text.Lex.hexDigitToInt: bad input"
105+
106+signa :: Num a => Parser a -> Parser a
107+{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}
108+{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}
109+signa p = do
110+ sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
111+ if sign == '+' then p else negate `liftM` p
112+
113+newtype Parser a = P {
114+ runP :: Text -> Either String (a,Text)
115+ }
116+
117+instance Monad Parser where
118+ return a = P $ \t -> Right (a,t)
119+ {-# INLINE return #-}
120+ m >>= k = P $ \t -> case runP m t of
121+ Left err -> Left err
122+ Right (a,t') -> runP (k a) t'
123+ {-# INLINE (>>=) #-}
124+ fail msg = P $ \_ -> Left msg
125+
126+perhaps :: a -> Parser a -> Parser a
127+perhaps def m = P $ \t -> case runP m t of
128+ Left _ -> Right (def,t)
129+ r@(Right _) -> r
130+
131+char :: (Char -> Bool) -> Parser Char
132+char p = P $ \t -> case T.uncons t of
133+ Just (c,t') | p c -> Right (c,t')
134+ _ -> Left "char"
135+
136+data T = T !Integer !Int
137+
138+floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Reader a
139+{-# INLINE floaty #-}
140+floaty f = runP $ do
141+ real <- signa (P decimal)
142+ T fraction fracDigits <- perhaps (T 0 0) $ do
143+ _ <- char (=='.')
144+ digits <- P $ \t -> Right (fromIntegral . T.length $ T.takeWhile isDigit t, t)
145+ n <- P decimal
146+ return $ T n digits
147+ let e c = c == 'e' || c == 'E'
148+ power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)
149+ return $! if fracDigits == 0
150+ then if power == 0
151+ then fromIntegral real
152+ else fromIntegral real * (10 ^^ power)
153+ else if power == 0
154+ then f real fraction (10 ^ fracDigits)
155+ else f real fraction (10 ^ fracDigits) * (10 ^^ power)