@@ -0,0 +1,113 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+-- |
4+-- Module : Data.Text.Lex
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+-- Lexing functions used frequently when handling textual data.
14+module Data.Text.Lex
15+ (
16+ Lexer
17+ , decimal
18+ , hexadecimal
19+ , signed
20+ , rational
21+ ) where
22+
23+import Control.Monad (liftM)
24+import Data.Char (digitToInt, isDigit, isHexDigit, ord)
25+import Data.Ratio
26+import Data.Text as T
27+
28+-- | Read some text, and if the read succeeds, return its value and
29+-- the remaining text.
30+type Lexer a = Text -> Either String (a,Text)
31+
32+-- | Read a decimal number.
33+decimal :: Integral a => Lexer a
34+{-# SPECIALIZE decimal :: Lexer Int #-}
35+decimal txt
36+ | T.null h = Left "no digits in input"
37+ | otherwise = Right (T.foldl' go 0 h, t)
38+ where (h,t) = T.spanBy isDigit txt
39+ go n d = (n * 10 + fromIntegral (digitToInt d))
40+
41+-- | Read a hexadecimal number, with optional leading @\"0x\"@. This
42+-- function is case insensitive.
43+hexadecimal :: Integral a => Lexer a
44+{-# SPECIALIZE hex :: Lexer Int #-}
45+hexadecimal txt
46+ | T.toLower h == "0x" = hex t
47+ | otherwise = hex txt
48+ where (h,t) = T.splitAt 2 txt
49+
50+hex :: Integral a => Lexer a
51+{-# SPECIALIZE hex :: Lexer Int #-}
52+hex txt
53+ | T.null h = Left "no digits in input"
54+ | otherwise = Right (T.foldl' go 0 h, t)
55+ where (h,t) = T.spanBy isHexDigit txt
56+ go n d = (n * 16 + fromIntegral (hexDigitToInt d))
57+
58+hexDigitToInt :: Char -> Int
59+hexDigitToInt c
60+ | c >= '0' && c <= '9' = ord c - ord '0'
61+ | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)
62+ | c >= 'A' && c <= 'F' = ord c - (ord 'A' - 10)
63+ | otherwise = error "Data.Text.Lex.hexDigitToInt: bad input"
64+
65+-- | Read a leading sign character (@\'-\'@ or @\'+\'@) and apply it
66+-- to the result of applying the given reader.
67+signed :: Num a => Lexer a -> Lexer a
68+{-# INLINE signed #-}
69+signed f = runP (signa (P f))
70+
71+signa :: Num a => Parser a -> Parser a
72+{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}
73+signa p = do
74+ sign <- perhaps '+' $ char (`elem` "-+")
75+ if sign == '+' then p else negate `liftM` p
76+
77+newtype Parser a = P {
78+ runP :: Text -> Either String (a,Text)
79+ }
80+
81+instance Monad Parser where
82+ return a = P $ \t -> Right (a,t)
83+ {-# INLINE return #-}
84+ m >>= k = P $ \t -> case runP m t of
85+ Left err -> Left err
86+ Right (a,t') -> runP (k a) t'
87+ {-# INLINE (>>=) #-}
88+ fail msg = P $ \_ -> Left msg
89+
90+perhaps :: a -> Parser a -> Parser a
91+perhaps def m = P $ \t -> case runP m t of
92+ Left _ -> Right (def,t)
93+ r@(Right _) -> r
94+
95+char :: (Char -> Bool) -> Parser Char
96+char p = P $ \t -> case T.uncons t of
97+ Just (c,t') | p c -> Right (c,t')
98+ _ -> Left "char"
99+
100+-- | Read a rational number.
101+rational :: RealFloat a => Lexer a
102+{-# SPECIALIZE rational :: Lexer Double #-}
103+rational = runP $ do
104+ real <- signa (P decimal)
105+ (fraction,fracDigits) <- perhaps (0,0) $ do
106+ _ <- char (=='.')
107+ digits <- P $ \t -> Right (T.length $ T.takeWhile isDigit t, t)
108+ n <- P decimal
109+ return (n, digits)
110+ power <- perhaps 0 (char (`elem` "eE") >> signa (P decimal) :: Parser Int)
111+ return $! fromRational ((real % 1 + fraction % (10 ^ fracDigits)) *
112+ (10 ^ power))
113+