@@ -0,0 +1,113 @@
1+{-# LANGUAGE OverloadedStrings #-}
4+-- Module : Data.Text.Lex
5+-- Copyright : (c) 2010 Bryan O'Sullivan
8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
10+-- Stability : experimental
13+-- Lexing functions used frequently when handling textual data.
23+import Control.Monad (liftM)
24+import Data.Char (digitToInt, isDigit, isHexDigit, ord)
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)
32+-- | Read a decimal number.
33+decimal :: Integral a => Lexer a
34+{-# SPECIALIZE decimal :: Lexer Int #-}
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))
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 #-}
46+ | T.toLower h == "0x" = hex t
47+ | otherwise = hex txt
48+ where (h,t) = T.splitAt 2 txt
50+hex :: Integral a => Lexer a
51+{-# SPECIALIZE hex :: Lexer Int #-}
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))
58+hexDigitToInt :: Char -> Int
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"
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
69+signed f = runP (signa (P f))
71+signa :: Num a => Parser a -> Parser a
72+{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}
74+ sign <- perhaps '+' $ char (`elem` "-+")
75+ if sign == '+' then p else negate `liftM` p
77+newtype Parser a = P {
78+ runP :: Text -> Either String (a,Text)
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
86+ Right (a,t') -> runP (k a) t'
88+ fail msg = P $ \_ -> Left msg
90+perhaps :: a -> Parser a -> Parser a
91+perhaps def m = P $ \t -> case runP m t of
92+ Left _ -> Right (def,t)
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')
100+-- | Read a rational number.
101+rational :: RealFloat a => Lexer a
102+{-# SPECIALIZE rational :: Lexer Double #-}
104+ real <- signa (P decimal)
105+ (fraction,fracDigits) <- perhaps (0,0) $ do
107+ digits <- P $ \t -> Right (T.length $ T.takeWhile isDigit t, t)
110+ power <- perhaps 0 (char (`elem` "eE") >> signa (P decimal) :: Parser Int)
111+ return $! fromRational ((real % 1 + fraction % (10 ^ fracDigits)) *