1module Text.Regex.TDFA.NewDFA.MakeTest(test_singleline,test_multiline) where
2
3import qualified Data.IntSet as ISet(IntSet,member,fromAscList)
4import Text.Regex.TDFA.Common(WhichTest(..),Index)
5import Text.Regex.TDFA.NewDFA.Uncons(Uncons(uncons))
6
7{-# INLINE test_singleline #-}
8{-# INLINE test_multiline #-}
9{-# INLINE test_common #-}
10test_singleline,test_multiline,test_common :: Uncons text => WhichTest -> Index -> Char -> text -> Bool
11test_multiline Test_BOL _off prev _input = prev == '\n'
12test_multiline Test_EOL _off _prev input = case uncons input of
13                                                     Nothing -> True
14                                                     Just (next,_) -> next == '\n'
15test_multiline test off prev input = test_common test off prev input
16
17test_singleline Test_BOL off _prev _input = off == 0
18test_singleline Test_EOL _off _prev input = case uncons input of
19                                              Nothing -> True
20                                              _ -> False
21test_singleline test off prev input = test_common test off prev input
22
23test_common Test_BOB off _prev _input = off==0
24test_common Test_EOB _off _prev input = case uncons input of
25                                          Nothing -> True
26                                          _ -> False
27test_common Test_BOW _off prev input = not (isWord prev) && case uncons input of
28                                                            Nothing -> False
29                                                            Just (c,_) -> isWord c
30test_common Test_EOW _off prev input = isWord prev && case uncons input of
31                                                        Nothing -> True
32                                                        Just (c,_) -> not (isWord c)
33test_common Test_EdgeWord _off prev input =
34  if isWord prev
35    then case uncons input of Nothing -> True
36                              Just (c,_) -> not (isWord c)
37    else case uncons input of Nothing -> False
38                              Just (c,_) -> isWord c
39test_common Test_NotEdgeWord _off prev input = not (test_common Test_EdgeWord _off prev input)
40
41test_common Test_BOL _ _ _ = undefined
42test_common Test_EOL _ _ _ = undefined
43
44isWord :: Char -> Bool
45isWord c = ISet.member (fromEnum c) wordSet
46  where wordSet :: ISet.IntSet
47        wordSet = ISet.fromAscList . map fromEnum $ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz"
48