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 Test_BOL _off :: Index
_off prev :: Char
prev _input :: text
_input = Char
prev Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n'
test_multiline Test_EOL _off :: Index
_off _prev :: Char
_prev input :: text
input = case text -> Maybe (Char, text)
forall a. Uncons a => a -> Maybe (Char, a)
uncons text
input of
                                                     Nothing -> Bool
True
                                                     Just (next :: Char
next,_) -> Char
next Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n'
test_multiline test :: WhichTest
test off :: Index
off prev :: Char
prev input :: 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 Test_BOL off :: Index
off _prev :: Char
_prev _input :: text
_input = Index
off Index -> Index -> Bool
forall a. Eq a => a -> a -> Bool
== 0
test_singleline Test_EOL _off :: Index
_off _prev :: Char
_prev input :: text
input = case text -> Maybe (Char, text)
forall a. Uncons a => a -> Maybe (Char, a)
uncons text
input of
                                              Nothing -> Bool
True
                                              _ -> Bool
False
test_singleline test :: WhichTest
test off :: Index
off prev :: Char
prev input :: 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 Test_BOB off :: Index
off _prev :: Char
_prev _input :: text
_input = Index
offIndex -> Index -> Bool
forall a. Eq a => a -> a -> Bool
==0
test_common Test_EOB _off :: Index
_off _prev :: Char
_prev input :: text
input = case text -> Maybe (Char, text)
forall a. Uncons a => a -> Maybe (Char, a)
uncons text
input of
                                          Nothing -> Bool
True
                                          _ -> Bool
False
test_common Test_BOW _off :: Index
_off prev :: Char
prev input :: 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
                                                            Nothing -> Bool
False
                                                            Just (c :: Char
c,_) -> Char -> Bool
isWord Char
c
test_common Test_EOW _off :: Index
_off prev :: Char
prev input :: 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
                                                        Nothing -> Bool
True
                                                        Just (c :: Char
c,_) -> Bool -> Bool
not (Char -> Bool
isWord Char
c)
test_common Test_EdgeWord _off :: Index
_off prev :: Char
prev input :: 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 Nothing -> Bool
True
                              Just (c :: Char
c,_) -> 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 Nothing -> Bool
False
                              Just (c :: Char
c,_) -> Char -> Bool
isWord Char
c
test_common Test_NotEdgeWord _off :: Index
_off prev :: Char
prev input :: 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 Test_BOL _ _ _ = Bool
forall a. HasCallStack => a
undefined
test_common Test_EOL _ _ _ = Bool
forall a. HasCallStack => a
undefined

isWord :: Char -> Bool
isWord :: Char -> Bool
isWord c :: 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
$ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz"