module Text.Regex.TDFA.NewDFA.MakeTest(test_singleline,test_multiline) where

import qualified Data.IntSet as ISet(IntSet,member,fromAscList)
import Text.Regex.TDFA.Common(WhichTest(..),Index)
import Text.Regex.TDFA.NewDFA.Uncons(Uncons(uncons))

{-# INLINE test_singleline #-}
{-# INLINE test_multiline #-}
{-# INLINE test_common #-}
test_singleline,test_multiline,test_common :: Uncons text => WhichTest -> Index -> Char -> text -> Bool
test_multiline :: WhichTest -> Index -> Char -> text -> Bool
test_multiline WhichTest
Test_BOL Index
_off Char
prev text
_input = Char
prev Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
test_multiline WhichTest
Test_EOL Index
_off Char
_prev text
input = case text -> Maybe (Char, text)
forall a. Uncons a => a -> Maybe (Char, a)
uncons text
input of
                                                     Maybe (Char, text)
Nothing -> Bool
True
                                                     Just (Char
next,text
_) -> Char
next Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
test_multiline WhichTest
test Index
off Char
prev text
input = WhichTest -> Index -> Char -> text -> Bool
forall text.
Uncons text =>
WhichTest -> Index -> Char -> text -> Bool
test_common WhichTest
test Index
off Char
prev text
input

test_singleline :: WhichTest -> Index -> Char -> text -> Bool
test_singleline WhichTest
Test_BOL Index
off Char
_prev text
_input = Index
off Index -> Index -> Bool
forall a. Eq a => a -> a -> Bool
== Index
0
test_singleline WhichTest
Test_EOL Index
_off Char
_prev text
input = case text -> Maybe (Char, text)
forall a. Uncons a => a -> Maybe (Char, a)
uncons text
input of
                                              Maybe (Char, text)
Nothing -> Bool
True
                                              Maybe (Char, text)
_ -> Bool
False
test_singleline WhichTest
test Index
off Char
prev text
input = WhichTest -> Index -> Char -> text -> Bool
forall text.
Uncons text =>
WhichTest -> Index -> Char -> text -> Bool
test_common WhichTest
test Index
off Char
prev text
input

test_common :: WhichTest -> Index -> Char -> text -> Bool
test_common WhichTest
Test_BOB Index
off Char
_prev text
_input = Index
offIndex -> Index -> Bool
forall a. Eq a => a -> a -> Bool
==Index
0
test_common WhichTest
Test_EOB Index
_off Char
_prev text
input = case text -> Maybe (Char, text)
forall a. Uncons a => a -> Maybe (Char, a)
uncons text
input of
                                          Maybe (Char, text)
Nothing -> Bool
True
                                          Maybe (Char, text)
_ -> Bool
False
test_common WhichTest
Test_BOW Index
_off Char
prev text
input = Bool -> Bool
not (Char -> Bool
isWord Char
prev) Bool -> Bool -> Bool
&& case text -> Maybe (Char, text)
forall a. Uncons a => a -> Maybe (Char, a)
uncons text
input of
                                                            Maybe (Char, text)
Nothing -> Bool
False
                                                            Just (Char
c,text
_) -> Char -> Bool
isWord Char
c
test_common WhichTest
Test_EOW Index
_off Char
prev text
input = Char -> Bool
isWord Char
prev Bool -> Bool -> Bool
&& case text -> Maybe (Char, text)
forall a. Uncons a => a -> Maybe (Char, a)
uncons text
input of
                                                        Maybe (Char, text)
Nothing -> Bool
True
                                                        Just (Char
c,text
_) -> Bool -> Bool
not (Char -> Bool
isWord Char
c)
test_common WhichTest
Test_EdgeWord Index
_off Char
prev text
input =
  if Char -> Bool
isWord Char
prev
    then case text -> Maybe (Char, text)
forall a. Uncons a => a -> Maybe (Char, a)
uncons text
input of Maybe (Char, text)
Nothing -> Bool
True
                              Just (Char
c,text
_) -> Bool -> Bool
not (Char -> Bool
isWord Char
c)
    else case text -> Maybe (Char, text)
forall a. Uncons a => a -> Maybe (Char, a)
uncons text
input of Maybe (Char, text)
Nothing -> Bool
False
                              Just (Char
c,text
_) -> Char -> Bool
isWord Char
c
test_common WhichTest
Test_NotEdgeWord Index
_off Char
prev text
input = Bool -> Bool
not (WhichTest -> Index -> Char -> text -> Bool
forall text.
Uncons text =>
WhichTest -> Index -> Char -> text -> Bool
test_common WhichTest
Test_EdgeWord Index
_off Char
prev text
input)

test_common WhichTest
Test_BOL Index
_ Char
_ text
_ = Bool
forall a. HasCallStack => a
undefined
test_common WhichTest
Test_EOL Index
_ Char
_ text
_ = Bool
forall a. HasCallStack => a
undefined

isWord :: Char -> Bool
isWord :: Char -> Bool
isWord Char
c = Index -> IntSet -> Bool
ISet.member (Char -> Index
forall a. Enum a => a -> Index
fromEnum Char
c) IntSet
wordSet
  where wordSet :: ISet.IntSet
        wordSet :: IntSet
wordSet = [Index] -> IntSet
ISet.fromAscList ([Index] -> IntSet) -> ([Char] -> [Index]) -> [Char] -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Index) -> [Char] -> [Index]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Index
forall a. Enum a => a -> Index
fromEnum ([Char] -> IntSet) -> [Char] -> IntSet
forall a b. (a -> b) -> a -> b
$ [Char]
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz"