@@ -0,0 +1,115 @@
1+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
2+
3+-- |
4+-- Module : Network.Wai.Search
5+-- Copyright : (c) Bryan O'Sullivan 2009
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+-- Port of Data.Text.Search to ByteStrings, applied to the Wai framework
14+--
15+-- References:
16+--
17+-- * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm.
18+-- Communications of the ACM, 20, 10, 762-772 (1977)
19+--
20+-- * R. N. Horspool: Practical Fast Searching in Strings. Software -
21+-- Practice and Experience 10, 501-506 (1980)
22+--
23+-- * D. M. Sunday: A Very Fast Substring Search Algorithm.
24+-- Communications of the ACM, 33, 8, 132-142 (1990)
25+--
26+-- * F. Lundh: The Fast Search Algorithm.
27+-- <http://effbot.org/zone/stringlib.htm> (2006)
28+
29+module Network.Wai.Search
30+ (
31+ index
32+ , checkNeg
33+ , checkFound
34+ ) where
35+
36+import qualified Data.ByteString.Unsafe as SU
37+import qualified Data.ByteString as S
38+import Data.ByteString ( ByteString )
39+import Data.Word (Word64)
40+import Data.Bits ((.|.), (.&.), shiftL)
41+
42+data PairS a b = !a :*: !b
43+
44+-- | /O(n+m)/ Find the offset of @needle@ within @haystack@. The offset
45+-- returned represents the location within the haystack ByteString
46+--
47+-- In (unlikely) bad cases, this algorithm's complexity degrades
48+-- towards /O(n*m)/.
49+index :: ByteString -- ^ Substring to search for (@needle@)
50+ -> ByteString -- ^ Text to search in (@haystack@)
51+ -> Maybe Int
52+index needle haystack
53+ | nlen == 1 = scanOne (nindex 0)
54+ | nlen <= 0 || ldiff < 0 = Nothing
55+ | otherwise = scan 0
56+ where
57+ nlen = S.length needle
58+ hlen = S.length haystack
59+ ldiff = hlen - nlen
60+ nlast = nlen - 1
61+ z = nindex nlast
62+ nindex k = SU.unsafeIndex needle k
63+ hindex k = SU.unsafeIndex haystack k
64+ hindex' k | k == hlen = 0
65+ | otherwise = SU.unsafeIndex haystack k
66+ (mask :: Word64) :*: skip = buildTable 0 0 (nlen-2)
67+ buildTable !i !msk !skp
68+ | i >= nlast = (msk .|. swizzle z) :*: skp
69+ | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
70+ where c = nindex i
71+ skp' | c == z = nlen - i - 2
72+ | otherwise = skp
73+ swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
74+ scan !i
75+ | i > ldiff = Nothing
76+ | c == z && candidateMatch 0 = Just i
77+ | otherwise = scan (i + delta)
78+ where c = hindex (i + nlast)
79+ candidateMatch !j
80+ | j >= nlast = True
81+ | hindex (i+j) /= nindex j = False
82+ | otherwise = candidateMatch (j+1)
83+ delta | nextInPattern = nlen + 1
84+ | c == z = skip + 1
85+ | otherwise = 1
86+ nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
87+ scanOne c = loop 0
88+ where loop !i | i >= hlen = Nothing
89+ | hindex i == c = Just i
90+ | otherwise = loop (i+1)
91+{-# INLINE index #-}
92+
93+-- It's not likely that one arbitrary string will ever be a substring of some
94+-- other string, so this is pretty much a negative test
95+{-
96+checkNeg :: ByteString -> ByteString -> Bool
97+checkNeg n h
98+ | S.null n = True
99+ | otherwise = (S.findSubstring n h) == (index n h)
100+ -}
101+
102+-- Make sure that index works the same as ByteString.findSubstring when we
103+-- force matches
104+{-
105+checkFound :: ByteString -> Int -> Int -> Bool
106+checkFound bs offset len
107+ | S.null n = True -- cop out
108+ | otherwise = case index n bs of
109+ Nothing -> False
110+ _ -> checkNeg n bs
111+ where
112+ n = S.take len $ S.drop offset bs
113+ -}
114+
115+