git.iko.soy/typeable/attoparsec
on master help sign in
Write a more correct stringCI implementation.

This is hacky and slow :-(

commit5ccadc10445d5d68d99b3a581de58499f55670a3 authorBryan O'Sullivan <bos@serpentine.com> dateFri 13 Jan 2012, 15:56 (15 years ago) parent0a30923
2 files changed+21−11
Data/Attoparsec/Text.hs+1−6 Data/Attoparsec/Text/Internal.hs+20−5
Data/Attoparsec/Text.hs+1−6
@@ -62,7 +62,7 @@ module Data.Attoparsec.Text
6262
6363 -- * Efficient string handling
6464 , I.string
65− , stringCI
65+ , I.stringCI
6666 , skipSpace
6767 , I.skipWhile
6868 , I.scan
@@ -392,11 +392,6 @@ space :: Parser Char
392392space = I.satisfy isSpace <?> "space"
393393{-# INLINE space #-}
394394
395−-- | Satisfy a literal string, ignoring case.
396−stringCI :: Text -> Parser Text
397−stringCI = I.stringTransform T.toCaseFold
398−{-# INLINE stringCI #-}
399−
400395-- | Skip over white space.
401396skipSpace :: Parser ()
402397skipSpace = I.skipWhile isSpace
Data/Attoparsec/Text/Internal.hs+20−5
@@ -43,7 +43,7 @@ module Data.Attoparsec.Text.Internal
4343 -- * Efficient string handling
4444 , skipWhile
4545 , string
46− , stringTransform
46+ , stringCI
4747 , take
4848 , scan
4949 , takeWhile
@@ -224,10 +224,25 @@ string :: Text -> Parser Text
224224string s = takeWith (T.length s) (==s)
225225{-# INLINE string #-}
226226
227−stringTransform :: (Text -> Text) -> Text
228− -> Parser Text
229−stringTransform f s = takeWith (T.length s) ((==f s) . f)
230−{-# INLINE stringTransform #-}
227+-- | Satisfy a literal string, ignoring case.
228+--
229+-- Note: this function is currently quite inefficient. Unicode case
230+-- folding can change the length of a string (\"&#223;\" becomes
231+-- "ss"), which makes a simple, efficient implementation tricky. We
232+-- have (for now) chosen simplicity over efficiency.
233+stringCI :: Text -> Parser Text
234+stringCI s = go (T.length s)
235+ where
236+ go !n
237+ | n > T.length fs = fail "stringCI"
238+ | otherwise = do
239+ t <- ensure n
240+ let h = unsafeTake n t
241+ if T.toCaseFold h == fs
242+ then put (unsafeDrop n t) >> return h
243+ else go (n+1)
244+ fs = T.toCaseFold s
245+{-# INLINE stringCI #-}
231246
232247-- | Skip past input for as long as the predicate returns 'True'.
233248skipWhile :: (Char -> Bool) -> Parser ()