Commits

solirc committed 8a8f1d3

Add asciiCI, as suggested in #9

Comments (0)

Files changed (3)

Data/Attoparsec/Text.hs

     -- * Efficient string handling
     , I.string
     , I.stringCI
+    , I.asciiCI
     , skipSpace
     , I.skipWhile
     , I.scan

Data/Attoparsec/Text/Internal.hs

     , skipWhile
     , string
     , stringCI
+    , asciiCI
     , take
     , scan
     , takeWhile
 import Data.String (IsString(..))
 import Data.Text (Text)
 import Prelude hiding (getChar, take, takeWhile)
+import Data.Char (chr, ord)
 import qualified Data.Attoparsec.Internal.Types as T
 import qualified Data.Attoparsec.Text.FastSet as Set
 import qualified Data.Text as T
     fs = T.toCaseFold s
 {-# INLINE stringCI #-}
 
+-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
+asciiCI :: Text -> Parser Text
+asciiCI input = do
+  t <- ensure n
+  let h = unsafeTake n t
+  if asciiToLower h == s
+    then put (unsafeDrop n t) >> return h
+    else fail "asciiCI"
+  where
+    n = T.length input
+    s = asciiToLower input
+
+    -- convert letters in the ASCII range to lower-case
+    asciiToLower = T.map f
+      where
+        offset = ord 'a' - ord 'A'
+        f c | 'A' <= c && c <= 'Z' = chr (ord c + offset)
+            | otherwise            = c
+{-# INLINE asciiCI #-}
+
 -- | Skip past input for as long as the predicate returns 'True'.
 skipWhile :: (Char -> Bool) -> Parser ()
 skipWhile p = go
 import Prelude hiding (takeWhile)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.QuickCheck
+import qualified Data.Char as Char
 import qualified Data.Attoparsec.Text as P
 import qualified Data.Attoparsec.Text.Lazy as PL
 import qualified Data.Text as T
 stringCI s = P.parseOnly (P.stringCI fs) s == Right s
   where fs = T.toCaseFold s
 
+asciiCI x =
+  (\s i -> P.parseOnly (P.asciiCI s) i == Right i)
+    <$> maybeModifyCase x
+    <*> maybeModifyCase x
+  where
+    maybeModifyCase s = elements [s, toLower s, toUpper s]
+    toLower = T.map (\c -> if c < Char.chr 127 then Char.toLower c else c)
+    toUpper = T.map (\c -> if c < Char.chr 127 then Char.toUpper c else c)
+
 toStrict = T.concat . L.toChunks
 
 skipWhile w s =
     testProperty "peekChar" peekChar,
     testProperty "string" string,
     testProperty "stringCI" stringCI,
+    testProperty "asciiCI" asciiCI,
     testProperty "skipWhile" skipWhile,
     testProperty "takeCount" takeCount,
     testProperty "takeWhile" takeWhile,