1{-# LANGUAGE GADTs #-} 2{-# LANGUAGE FlexibleContexts #-} 3{-# LANGUAGE ScopedTypeVariables #-} 4{-# OPTIONS_GHC -fspec-constr -fspec-constr-count=8 #-} 5----------------------------------------------------------------------------- 6-- | 7-- Module : Distribution.Compat.CharParsing 8-- Copyright : (c) Edward Kmett 2011 9-- License : BSD3 10-- 11-- Maintainer : ekmett@gmail.com 12-- Stability : experimental 13-- Portability : non-portable 14-- 15-- Parsers for character streams 16-- 17-- Originally in @parsers@ package. 18-- 19----------------------------------------------------------------------------- 20module Distribution.Compat.CharParsing 21 ( 22 -- * Combinators 23 oneOf -- :: CharParsing m => [Char] -> m Char 24 , noneOf -- :: CharParsing m => [Char] -> m Char 25 , spaces -- :: CharParsing m => m () 26 , space -- :: CharParsing m => m Char 27 , newline -- :: CharParsing m => m Char 28 , tab -- :: CharParsing m => m Char 29 , upper -- :: CharParsing m => m Char 30 , lower -- :: CharParsing m => m Char 31 , alphaNum -- :: CharParsing m => m Char 32 , letter -- :: CharParsing m => m Char 33 , digit -- :: CharParsing m => m Char 34 , hexDigit -- :: CharParsing m => m Char 35 , octDigit -- :: CharParsing m => m Char 36 , satisfyRange -- :: CharParsing m => Char -> Char -> m Char 37 -- * Class 38 , CharParsing(..) 39 -- * Cabal additions 40 , integral 41 , signedIntegral 42 , munch1 43 , munch 44 , skipSpaces1 45 , module Distribution.Compat.Parsing 46 ) where 47 48import Prelude () 49import Distribution.Compat.Prelude 50 51import Control.Monad.Trans.Class (lift) 52import Control.Monad.Trans.State.Lazy as Lazy 53import Control.Monad.Trans.State.Strict as Strict 54import Control.Monad.Trans.Writer.Lazy as Lazy 55import Control.Monad.Trans.Writer.Strict as Strict 56import Control.Monad.Trans.RWS.Lazy as Lazy 57import Control.Monad.Trans.RWS.Strict as Strict 58import Control.Monad.Trans.Reader (ReaderT (..)) 59import Control.Monad.Trans.Identity (IdentityT (..)) 60import Data.Char 61import Data.Text (Text, unpack) 62 63import qualified Text.Parsec as Parsec 64 65import Distribution.Compat.Parsing 66 67-- | @oneOf cs@ succeeds if the current character is in the supplied 68-- list of characters @cs@. Returns the parsed character. See also 69-- 'satisfy'. 70-- 71-- > vowel = oneOf "aeiou" 72oneOf :: CharParsing m => [Char] -> m Char 73oneOf xs = satisfy (\c -> c `elem` xs) 74{-# INLINE oneOf #-} 75 76-- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current 77-- character is /not/ in the supplied list of characters @cs@. Returns the 78-- parsed character. 79-- 80-- > consonant = noneOf "aeiou" 81noneOf :: CharParsing m => [Char] -> m Char 82noneOf xs = satisfy (\c -> c `notElem` xs) 83{-# INLINE noneOf #-} 84 85-- | Skips /zero/ or more white space characters. See also 'skipMany'. 86spaces :: CharParsing m => m () 87spaces = skipMany space <?> "white space" 88{-# INLINE spaces #-} 89 90-- | Parses a white space character (any character which satisfies 'isSpace') 91-- Returns the parsed character. 92space :: CharParsing m => m Char 93space = satisfy isSpace <?> "space" 94{-# INLINE space #-} 95 96-- | Parses a newline character (\'\\n\'). Returns a newline character. 97newline :: CharParsing m => m Char 98newline = char '\n' <?> "new-line" 99{-# INLINE newline #-} 100 101-- | Parses a tab character (\'\\t\'). Returns a tab character. 102tab :: CharParsing m => m Char 103tab = char '\t' <?> "tab" 104{-# INLINE tab #-} 105 106-- | Parses an upper case letter. Returns the parsed character. 107upper :: CharParsing m => m Char 108upper = satisfy isUpper <?> "uppercase letter" 109{-# INLINE upper #-} 110 111-- | Parses a lower case character. Returns the parsed character. 112lower :: CharParsing m => m Char 113lower = satisfy isLower <?> "lowercase letter" 114{-# INLINE lower #-} 115 116-- | Parses a letter or digit. Returns the parsed character. 117alphaNum :: CharParsing m => m Char 118alphaNum = satisfy isAlphaNum <?> "letter or digit" 119{-# INLINE alphaNum #-} 120 121-- | Parses a letter (an upper case or lower case character). Returns the 122-- parsed character. 123letter :: CharParsing m => m Char 124letter = satisfy isAlpha <?> "letter" 125{-# INLINE letter #-} 126 127-- | Parses a digit. Returns the parsed character. 128digit :: CharParsing m => m Char 129digit = satisfy isDigit <?> "digit" 130{-# INLINE digit #-} 131 132-- | Parses a hexadecimal digit (a digit or a letter between \'a\' and 133-- \'f\' or \'A\' and \'F\'). Returns the parsed character. 134hexDigit :: CharParsing m => m Char 135hexDigit = satisfy isHexDigit <?> "hexadecimal digit" 136{-# INLINE hexDigit #-} 137 138-- | Parses an octal digit (a character between \'0\' and \'7\'). Returns 139-- the parsed character. 140octDigit :: CharParsing m => m Char 141octDigit = satisfy isOctDigit <?> "octal digit" 142{-# INLINE octDigit #-} 143 144satisfyRange :: CharParsing m => Char -> Char -> m Char 145satisfyRange a z = satisfy (\c -> c >= a && c <= z) 146{-# INLINE satisfyRange #-} 147 148-- | Additional functionality needed to parse character streams. 149class Parsing m => CharParsing m where 150 -- | Parse a single character of the input, with UTF-8 decoding 151 satisfy :: (Char -> Bool) -> m Char 152 153 -- | @char c@ parses a single character @c@. Returns the parsed 154 -- character (i.e. @c@). 155 -- 156 -- /e.g./ 157 -- 158 -- @semiColon = 'char' ';'@ 159 char :: Char -> m Char 160 char c = satisfy (c ==) <?> show [c] 161 {-# INLINE char #-} 162 163 -- | @notChar c@ parses any single character other than @c@. Returns the parsed 164 -- character. 165 notChar :: Char -> m Char 166 notChar c = satisfy (c /=) 167 {-# INLINE notChar #-} 168 169 -- | This parser succeeds for any character. Returns the parsed character. 170 anyChar :: m Char 171 anyChar = satisfy (const True) 172 {-# INLINE anyChar #-} 173 174 -- | @string s@ parses a sequence of characters given by @s@. Returns 175 -- the parsed string (i.e. @s@). 176 -- 177 -- > divOrMod = string "div" 178 -- > <|> string "mod" 179 string :: String -> m String 180 string s = s <$ try (traverse_ char s) <?> show s 181 {-# INLINE string #-} 182 183 -- | @text t@ parses a sequence of characters determined by the text @t@ Returns 184 -- the parsed text fragment (i.e. @t@). 185 -- 186 -- Using @OverloadedStrings@: 187 -- 188 -- > divOrMod = text "div" 189 -- > <|> text "mod" 190 text :: Text -> m Text 191 text t = t <$ string (unpack t) 192 {-# INLINE text #-} 193 194instance (CharParsing m, MonadPlus m) => CharParsing (Lazy.StateT s m) where 195 satisfy = lift . satisfy 196 {-# INLINE satisfy #-} 197 char = lift . char 198 {-# INLINE char #-} 199 notChar = lift . notChar 200 {-# INLINE notChar #-} 201 anyChar = lift anyChar 202 {-# INLINE anyChar #-} 203 string = lift . string 204 {-# INLINE string #-} 205 text = lift . text 206 {-# INLINE text #-} 207 208instance (CharParsing m, MonadPlus m) => CharParsing (Strict.StateT s m) where 209 satisfy = lift . satisfy 210 {-# INLINE satisfy #-} 211 char = lift . char 212 {-# INLINE char #-} 213 notChar = lift . notChar 214 {-# INLINE notChar #-} 215 anyChar = lift anyChar 216 {-# INLINE anyChar #-} 217 string = lift . string 218 {-# INLINE string #-} 219 text = lift . text 220 {-# INLINE text #-} 221 222instance (CharParsing m, MonadPlus m) => CharParsing (ReaderT e m) where 223 satisfy = lift . satisfy 224 {-# INLINE satisfy #-} 225 char = lift . char 226 {-# INLINE char #-} 227 notChar = lift . notChar 228 {-# INLINE notChar #-} 229 anyChar = lift anyChar 230 {-# INLINE anyChar #-} 231 string = lift . string 232 {-# INLINE string #-} 233 text = lift . text 234 {-# INLINE text #-} 235 236instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Strict.WriterT w m) where 237 satisfy = lift . satisfy 238 {-# INLINE satisfy #-} 239 char = lift . char 240 {-# INLINE char #-} 241 notChar = lift . notChar 242 {-# INLINE notChar #-} 243 anyChar = lift anyChar 244 {-# INLINE anyChar #-} 245 string = lift . string 246 {-# INLINE string #-} 247 text = lift . text 248 {-# INLINE text #-} 249 250instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Lazy.WriterT w m) where 251 satisfy = lift . satisfy 252 {-# INLINE satisfy #-} 253 char = lift . char 254 {-# INLINE char #-} 255 notChar = lift . notChar 256 {-# INLINE notChar #-} 257 anyChar = lift anyChar 258 {-# INLINE anyChar #-} 259 string = lift . string 260 {-# INLINE string #-} 261 text = lift . text 262 {-# INLINE text #-} 263 264instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Lazy.RWST r w s m) where 265 satisfy = lift . satisfy 266 {-# INLINE satisfy #-} 267 char = lift . char 268 {-# INLINE char #-} 269 notChar = lift . notChar 270 {-# INLINE notChar #-} 271 anyChar = lift anyChar 272 {-# INLINE anyChar #-} 273 string = lift . string 274 {-# INLINE string #-} 275 text = lift . text 276 {-# INLINE text #-} 277 278instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Strict.RWST r w s m) where 279 satisfy = lift . satisfy 280 {-# INLINE satisfy #-} 281 char = lift . char 282 {-# INLINE char #-} 283 notChar = lift . notChar 284 {-# INLINE notChar #-} 285 anyChar = lift anyChar 286 {-# INLINE anyChar #-} 287 string = lift . string 288 {-# INLINE string #-} 289 text = lift . text 290 {-# INLINE text #-} 291 292instance (CharParsing m, MonadPlus m) => CharParsing (IdentityT m) where 293 satisfy = lift . satisfy 294 {-# INLINE satisfy #-} 295 char = lift . char 296 {-# INLINE char #-} 297 notChar = lift . notChar 298 {-# INLINE notChar #-} 299 anyChar = lift anyChar 300 {-# INLINE anyChar #-} 301 string = lift . string 302 {-# INLINE string #-} 303 text = lift . text 304 {-# INLINE text #-} 305 306instance Parsec.Stream s m Char => CharParsing (Parsec.ParsecT s u m) where 307 satisfy = Parsec.satisfy 308 char = Parsec.char 309 notChar c = Parsec.satisfy (/= c) 310 anyChar = Parsec.anyChar 311 string = Parsec.string 312 313------------------------------------------------------------------------------- 314-- Our additions 315------------------------------------------------------------------------------- 316 317integral :: (CharParsing m, Integral a) => m a 318integral = toNumber <$> some d <?> "integral" 319 where 320 toNumber = foldl' (\a b -> a * 10 + b) 0 321 d = f <$> satisfyRange '0' '9' 322 f '0' = 0 323 f '1' = 1 324 f '2' = 2 325 f '3' = 3 326 f '4' = 4 327 f '5' = 5 328 f '6' = 6 329 f '7' = 7 330 f '8' = 8 331 f '9' = 9 332 f _ = error "panic! integral" 333{-# INLINE integral #-} 334 335-- | Accepts negative (starting with @-@) and positive (without sign) integral 336-- numbers. 337-- 338-- @since 3.4.0.0 339signedIntegral :: (CharParsing m, Integral a) => m a 340signedIntegral = negate <$ char '-' <*> integral <|> integral 341{-# INLINE signedIntegral #-} 342 343-- | Greedily munch characters while predicate holds. 344-- Require at least one character. 345munch1 :: CharParsing m => (Char -> Bool) -> m String 346munch1 = some . satisfy 347{-# INLINE munch1 #-} 348 349-- | Greedely munch characters while predicate holds. 350-- Always succeeds. 351munch :: CharParsing m => (Char -> Bool) -> m String 352munch = many . satisfy 353{-# INLINE munch #-} 354 355skipSpaces1 :: CharParsing m => m () 356skipSpaces1 = skipSome space 357{-# INLINE skipSpaces1 #-} 358