diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,11 +1,22 @@ For the package version policy (PVP), see http://pvp.haskell.org/faq . +### 1.3.1.4 + +_2022-07-17, Andreas Abel_ + +- Fix parsing of dashes in bracket expressions, e.g. `[-a-z]` ([#1](https://github.com/haskell-hvr/regex-tdfa/issues/1)) +- Fix a deprecation warning except for on GHC 8.2 ([#21](https://github.com/haskell-hvr/regex-tdfa/issues/21)) +- Documentation: link `defaultComptOpt` to its definition ([#13](https://github.com/haskell-hvr/regex-tdfa/issues/13)) +- Verify documentation examples with new `doc-test` testsuite +- Tested with GHC 7.4 - 9.4 + ### 1.3.1.3 _2022-07-14, Andreas Abel_ -- Fix an `undefined` in `Show PatternSet` [#37](https://github.com/haskell-hvr/regex-tdfa/issues/37)) -- Document POSIX character classes (e.g. `[[:digit:]]`) +- Fix an `undefined` in `Show PatternSet` ([#37](https://github.com/haskell-hvr/regex-tdfa/issues/37)) +- Document POSIX character classes (e.g. `[[:digit:]]`) in README +- Tested with GHC 7.4 - 9.4 ### 1.3.1.2 Revision 1 diff --git a/lib/Data/IntMap/CharMap2.hs b/lib/Data/IntMap/CharMap2.hs --- a/lib/Data/IntMap/CharMap2.hs +++ b/lib/Data/IntMap/CharMap2.hs @@ -9,7 +9,7 @@ import Data.Char as C(ord) import Data.List as L (map) import qualified Data.IntMap as M -#if MIN_VERSION_containers(0,6,0) +#if MIN_VERSION_containers(0,5,11) import qualified Data.IntMap.Internal.Debug as MD #else import qualified Data.IntMap as MD diff --git a/lib/Data/IntMap/EnumMap2.hs b/lib/Data/IntMap/EnumMap2.hs --- a/lib/Data/IntMap/EnumMap2.hs +++ b/lib/Data/IntMap/EnumMap2.hs @@ -4,7 +4,7 @@ import Data.Foldable as F (Foldable(foldMap)) import qualified Data.IntMap as M -#if MIN_VERSION_containers(0,6,0) +#if MIN_VERSION_containers(0,5,11) import qualified Data.IntMap.Internal.Debug as MD #else import qualified Data.IntMap as MD diff --git a/lib/Text/Regex/TDFA.hs b/lib/Text/Regex/TDFA.hs --- a/lib/Text/Regex/TDFA.hs +++ b/lib/Text/Regex/TDFA.hs @@ -32,10 +32,19 @@ = Basics @ -λ> let emailRegex = "[a-zA-Z0-9+.\_-]+\@[a-zA-Z-]+\\\\.[a-z]+" -λ> "my email is email@email.com" '=~' emailRegex :: Bool ->>> True +>>> let emailRegex = "[a-zA-Z0-9+._-]+\\@[-a-zA-Z]+\\.[a-z]+" +>>> "my email is first-name.lastname_1974@e-mail.com" =~ emailRegex :: Bool +True +>>> "invalid@mail@com" =~ emailRegex :: Bool +False + +>>> "invalid@mail.COM" =~ emailRegex :: Bool +False + +>>> "#@invalid.com" =~ emailRegex :: Bool +False + /-- non-monadic/ λ> \ '=~' \ @@ -61,11 +70,12 @@ /-- returns empty string if no match/ a '=~' b :: String /-- or ByteString, or Text.../ -λ> "alexis-de-tocqueville" '=~' "[a-z]+" :: String ->>> "alexis" +>>> "alexis-de-tocqueville" =~ "[a-z]+" :: String +"alexis" -λ> "alexis-de-tocqueville" '=~' "[0-9]+" :: String ->>> "" +>>> "alexis-de-tocqueville" =~ "[0-9]+" :: String +"" + @ == Check if it matched at all @@ -73,8 +83,9 @@ @ a '=~' b :: Bool -λ> "alexis-de-tocqueville" '=~' "[a-z]+" :: Bool ->>> True +>>> "alexis-de-tocqueville" =~ "[a-z]+" :: Bool +True + @ == Get first match + text before/after @@ -84,11 +95,12 @@ /-- string in the first element of the tuple/ a =~ b :: (String, String, String) -λ> "alexis-de-tocqueville" '=~' "de" :: (String, String, String) ->>> ("alexis-", "de", "-tocqueville") +>>> "alexis-de-tocqueville" =~ "de" :: (String, String, String) +("alexis-","de","-tocqueville") -λ> "alexis-de-tocqueville" '=~' "kant" :: (String, String, String) ->>> ("alexis-de-tocqueville", "", "") +>>> "alexis-de-tocqueville" =~ "kant" :: (String, String, String) +("alexis-de-tocqueville","","") + @ == Get first match + submatches @@ -98,8 +110,9 @@ /-- submatch list is empty if regex doesn't match at all/ a '=~' b :: (String, String, String, [String]) -λ> "div[attr=1234]" '=~' "div\\\\[([a-z]+)=([^]]+)\\\\]" :: (String, String, String, [String]) ->>> ("", "div[attr=1234]", "", ["attr","1234"]) +>>> "div[attr=1234]" =~ "div\\[([a-z]+)=([^]]+)\\]" :: (String, String, String, [String]) +("","div[attr=1234]","",["attr","1234"]) + @ == Get /all/ matches @@ -108,8 +121,9 @@ /-- can also return Data.Array instead of List/ 'getAllTextMatches' (a '=~' b) :: [String] -λ> 'getAllTextMatches' ("john anne yifan" '=~' "[a-z]+") :: [String] ->>> ["john","anne","yifan"] +>>> getAllTextMatches ("john anne yifan" =~ "[a-z]+") :: [String] +["john","anne","yifan"] + @ = Feature support @@ -143,6 +157,12 @@ ASCII only, valid classes are alnum, digit, punct, alpha, graph, space, blank, lower, upper, cntrl, print, xdigit, word. +@ +>>> getAllTextMatches ("john anne yifan" =~ "[[:lower:]]+") :: [String] +["john","anne","yifan"] + +@ + This package does not provide "basic" regular expressions. This package does not provide back references inside regular expressions. @@ -165,7 +185,7 @@ import Text.Regex.TDFA λ> "2 * (3 + 1) / 4" '=~' [r|\\([^)]+\\)|] :: String ->>> "(3 + 1)" +"(3 + 1)" @ -} diff --git a/lib/Text/Regex/TDFA/Common.hs b/lib/Text/Regex/TDFA/Common.hs --- a/lib/Text/Regex/TDFA/Common.hs +++ b/lib/Text/Regex/TDFA/Common.hs @@ -1,7 +1,9 @@ {-# OPTIONS -funbox-strict-fields #-} --- | Common provides simple functions to the backend. It defines most --- of the data types. All modules should call error via the --- common_error function below. + +-- | Common provides simple functions to the backend. +-- It defines most of the data types. +-- All modules should call 'error' via the 'common_error' function below. + module Text.Regex.TDFA.Common where import Text.Regex.Base(RegexOptions(..)) @@ -31,14 +33,14 @@ on :: (t1 -> t1 -> t2) -> (t -> t1) -> t -> t -> t2 f `on` g = (\x y -> (g x) `f` (g y)) --- | after 'sort' or 'sortBy' the use of 'nub'\/'nubBy' can be replaced by 'norep'\/'norepBy' +-- | After 'sort' or 'sortBy' the use of 'nub' or 'nubBy' can be replaced by 'norep' or 'norepBy'. norep :: (Eq a) => [a]->[a] norep [] = [] norep x@[_] = x norep (a:bs@(c:cs)) | a==c = norep (a:cs) | otherwise = a:norep bs --- | after 'sort' or 'sortBy' the use of 'nub'\/'nubBy' can be replaced by 'norep'\/'norepBy' +-- | After 'sort' or 'sortBy' the use of 'nub' or 'nubBy' can be replaced by 'norep' or 'norepBy'. norepBy :: (a -> a -> Bool) -> [a] -> [a] norepBy _ [] = [] norepBy _ x@[_] = x @@ -68,8 +70,7 @@ noWin :: WinTags -> Bool noWin = null --- | Used to track elements of the pattern that accept characters or --- are anchors +-- | Used to track elements of the pattern that accept characters or are anchors. newtype DoPa = DoPa {dopaIndex :: Int} deriving (Eq,Ord) instance Enum DoPa where @@ -82,19 +83,26 @@ -- | Control whether the pattern is multiline or case-sensitive like Text.Regex and whether to -- capture the subgroups (\\1, \\2, etc). Controls enabling extra anchor syntax. data CompOption = CompOption { - caseSensitive :: Bool -- ^ True in blankCompOpt and defaultCompOpt - , multiline :: Bool {- ^ False in blankCompOpt, True in defaultCompOpt. Compile for - newline-sensitive matching. "By default, newline is a completely ordinary - character with no special meaning in either REs or strings. With this flag, - inverted bracket expressions and . never match newline, a ^ anchor matches the - null string after any newline in the string in addition to its normal - function, and the $ anchor matches the null string before any newline in the - string in addition to its normal function." -} - , rightAssoc :: Bool -- ^ True (and therefore Right associative) in blankCompOpt and defaultCompOpt - , newSyntax :: Bool -- ^ False in blankCompOpt, True in defaultCompOpt. Add the extended non-POSIX syntax described in "Text.Regex.TDFA" haddock documentation. - , lastStarGreedy :: Bool -- ^ False by default. This is POSIX correct but it takes space and is slower. - -- Setting this to true will improve performance, and should be done - -- if you plan to set the captureGroups ExecOption to False. + caseSensitive :: Bool + -- ^ True in 'blankCompOpt' and 'defaultCompOpt'. + , multiline :: Bool + -- ^ False in 'blankCompOpt', True in 'defaultCompOpt'. + -- Compile for newline-sensitive matching. + -- + -- From [regexp man page](https://www.tcl.tk/man/tcl8.4/TclCmd/regexp.html#M8): + -- "By default, newline is a completely ordinary character with no special meaning in either REs or strings. + -- With this flag, inverted bracket expressions @[^@ and @.@ never match newline, + -- a @^@ anchor matches the null string after any newline in the string in addition to its normal function, + -- and the @$@ anchor matches the null string before any newline in the string in addition to its normal function." + , rightAssoc :: Bool + -- ^ True (and therefore right associative) in 'blankCompOpt' and 'defaultCompOpt'. + , newSyntax :: Bool + -- ^ False in 'blankCompOpt', True in 'defaultCompOpt'. + -- Enables the extended non-POSIX syntax described in "Text.Regex.TDFA" haddock documentation. + , lastStarGreedy :: Bool + -- ^ False by default. This is POSIX correct but it takes space and is slower. + -- Setting this to True will improve performance, and should be done + -- if you plan to set the 'captureGroups' 'ExecOption' to False. } deriving (Read,Show) data ExecOption = ExecOption { @@ -102,28 +110,31 @@ } deriving (Read,Show) -- | Used by implementation to name certain Postions during --- matching. Identity of Position tag to set during a transition +-- matching. Identity of Position tag to set during a transition. type Tag = Int --- | Internal use to indicate type of tag and preference for larger or smaller Positions + +-- | Internal use to indicate type of tag and preference for larger or smaller Positions. data OP = Maximize | Minimize | Orbit | Ignore deriving (Eq,Show) --- | Internal NFA node identity number + +-- | Internal NFA node identity number. type Index = Int --- | Internal DFA identity is this Set of NFA Index + +-- | Internal DFA identity is this Set of NFA Index. type SetIndex = IntSet {- Index -} --- | Index into the text being searched + +-- | Index into the text being searched. type Position = Int --- | GroupIndex is for indexing submatches from capturing --- parenthesized groups (PGroup\/Group) +-- | GroupIndex is for indexing submatches from capturing parenthesized groups ('PGroup' or 'Group'). type GroupIndex = Int --- | GroupInfo collects the parent and tag information for an instance --- of a group + +-- | GroupInfo collects the parent and tag information for an instance of a group. data GroupInfo = GroupInfo { thisIndex, parentIndex :: GroupIndex , startTag, stopTag, flagTag :: Tag } deriving Show --- | The TDFA backend specific 'Regex' type, used by this module's RegexOptions and RegexMaker +-- | The TDFA backend specific 'Regex' type, used by this module's 'RegexOptions' and 'RegexMaker'. data Regex = Regex { regex_dfa :: DFA -- ^ starting DFA state , regex_init :: Index -- ^ index of starting state @@ -161,10 +172,10 @@ | WinTest WhichTest (Maybe WinEmpty) (Maybe WinEmpty) deriving Show --- | Internal NFA node type +-- | Internal NFA node type. data QNFA = QNFA {q_id :: Index, q_qt :: QT} --- | Internal to QNFA type. +-- | Internal to 'QNFA' type. data QT = Simple { qt_win :: WinTags -- ^ empty transitions to the virtual winning state , qt_trans :: CharMap QTrans -- ^ all ways to leave this QNFA to other or the same QNFA , qt_other :: QTrans -- ^ default ways to leave this QNFA to other or the same QNFA @@ -182,29 +193,38 @@ -- Also support for GNU extensions is being added: \\\` beginning of -- buffer, \\\' end of buffer, \\\< and \\\> for begin and end of words, \\b -- and \\B for word boundary and not word boundary. -data WhichTest = Test_BOL | Test_EOL -- '^' and '$' (affected by multiline option) - | Test_BOB | Test_EOB -- \` and \' begin and end buffer - | Test_BOW | Test_EOW -- \< and \> begin and end word - | Test_EdgeWord | Test_NotEdgeWord -- \b and \B word boundaries +data WhichTest + = Test_BOL -- ^ @^@ (affected by multiline option) + | Test_EOL -- ^ @$@ (affected by multiline option) + | Test_BOB -- ^ @\\`@ beginning of buffer + | Test_EOB -- ^ @\\'@ end ofbuffer + | Test_BOW -- ^ @\\<@ beginning of word + | Test_EOW -- ^ @\\>@ end of word + | Test_EdgeWord -- ^ @\\b@ word boundary + | Test_NotEdgeWord -- ^ @\\B@ not word boundary deriving (Show,Eq,Ord,Enum) --- | The things that can be done with a Tag. TagTask and --- ResetGroupStopTask are for tags with Maximize or Minimize OP --- values. ResetOrbitTask and EnterOrbitTask and LeaveOrbitTask are +-- | The things that can be done with a Tag. 'TagTask' and +-- 'ResetGroupStopTask' are for tags with Maximize or Minimize OP +-- values. 'ResetOrbitTask' and 'EnterOrbitTask' and 'LeaveOrbitTask' are -- for tags with Orbit OP value. data TagTask = TagTask | ResetGroupStopTask | SetGroupStopTask | ResetOrbitTask | EnterOrbitTask | LeaveOrbitTask deriving (Show,Eq) --- | Ordered list of tags and their associated Task +-- | Ordered list of tags and their associated Task. type TagTasks = [(Tag,TagTask)] + -- | When attached to a QTrans the TagTask can be done before or after -- accepting the character. data TagUpdate = PreUpdate TagTask | PostUpdate TagTask deriving (Show,Eq) + -- | Ordered list of tags and their associated update operation. type TagList = [(Tag,TagUpdate)] + -- | A TagList and the location of the item in the original pattern -- that is being accepted. type TagCommand = (DoPa,TagList) + -- | Ordered list of tags and their associated update operation to -- perform on an empty transition to the virtual winning state. type WinTags = TagList @@ -227,26 +247,25 @@ } -- | Internal type to represent the commands for the tagged transition. --- The outer IntMap is for the destination Index and the inner IntMap +-- The outer 'IntMap' is for the destination Index and the inner 'IntMap' -- is for the Source Index. This is convenient since all runtime data -- going to the same destination must be compared to find the best. -- --- A Destination IntMap entry may have an empty Source IntMap if and --- only if the destination is the starting index and the NFA\/DFA. +-- A Destination 'IntMap' entry may have an empty Source 'IntMap' if and +-- only if the destination is the starting index and the NFA or DFA. -- This instructs the matching engine to spawn a new entry starting at -- the post-update position. type DTrans = IntMap {- Index of Destination -} (IntMap {- Index of Source -} (DoPa,Instructions)) -- type DTrans = IntMap {- Index of Destination -} (IntMap {- Index of Source -} (DoPa,RunState ())) --- | Internal convenience type for the text display code + +-- | Internal convenience type for the text display code. type DTrans' = [(Index, [(Index, (DoPa, ([(Tag, (Position,Bool))],[String])))])] --- | Positions for which a * was re-started while looping. Need to +-- | Positions for which a @*@ was re-started while looping. Need to -- append locations at back but compare starting with front, so use --- Seq as a Queue. The initial position is saved in basePos (and a --- Maximize Tag), the middle positions in the Seq, and the final +-- 'Seq' as a queue. The initial position is saved in 'basePos' (and a +-- Maximize Tag), the middle positions in the 'Seq', and the final -- position is NOT saved in the Orbits (only in a Maximize Tag). --- --- The original code is being written XXX TODO document it. data Orbits = Orbits { inOrbit :: !Bool -- True if enterOrbit, False if LeaveOrbit , basePos :: Position diff --git a/lib/Text/Regex/TDFA/ReadRegex.hs b/lib/Text/Regex/TDFA/ReadRegex.hs --- a/lib/Text/Regex/TDFA/ReadRegex.hs +++ b/lib/Text/Regex/TDFA/ReadRegex.hs @@ -1,24 +1,32 @@ -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} -- | This is a POSIX version of parseRegex that allows NUL characters. -- Lazy\/Possessive\/Backrefs are not recognized. Anchors \^ and \$ are -- recognized. -- --- The PGroup returned always have (Maybe GroupIndex) set to (Just _) --- and never to Nothing. +-- A 'PGroup' returned always has @(Maybe 'GroupIndex')@ set to @(Just _)@ +-- and never to @Nothing@. + module Text.Regex.TDFA.ReadRegex (parseRegex) where {- By Chris Kuklewicz, 2007. BSD License, see the LICENSE file. -} import Text.Regex.TDFA.Pattern {- all -} import Text.ParserCombinators.Parsec((<|>), (), - unexpected, try, runParser, many, getState, setState, CharParser, ParseError, + try, runParser, many, getState, setState, CharParser, ParseError, sepBy1, option, notFollowedBy, many1, lookAhead, eof, between, string, noneOf, digit, char, anyChar) -import Control.Monad(liftM, when, guard) + +import Control.Monad (liftM, guard) + +import Data.Foldable (asum) import qualified Data.Set as Set(fromList) --- | BracketElement is internal to this module -data BracketElement = BEChar Char | BEChars String | BEColl String | BEEquiv String | BEClass String +-- | An element inside @[...]@, denoting a character class. +data BracketElement + = BEChar Char -- ^ A single character. + | BERange Char Char -- ^ A character range (e.g. @a-z@). + | BEColl String -- ^ @foo@ in @[.foo.]@. + | BEEquiv String -- ^ @bar@ in @[=bar=]@. + | BEClass String -- ^ A POSIX character class (candidate), e.g. @alpha@ parsed from @[:alpha:]@. -- | Return either an error message or a tuple of the Pattern and the -- largest group index and the largest DoPa index (both have smallest @@ -30,37 +38,46 @@ (lastGroupIndex,lastDopa) <- getState return (pat,(lastGroupIndex,DoPa lastDopa))) (0,0) x x -p_regex :: CharParser (GroupIndex,Int) Pattern +type P = CharParser (GroupIndex, Int) + +p_regex :: P Pattern p_regex = liftM POr $ sepBy1 p_branch (char '|') -- man re_format helps a lot, it says one-or-more pieces so this is -- many1 not many. Use "()" to indicate an empty piece. +p_branch :: P Pattern p_branch = liftM PConcat $ many1 p_piece +p_piece :: P Pattern p_piece = (p_anchor <|> p_atom) >>= p_post_atom -- correct specification +p_atom :: P Pattern p_atom = p_group <|> p_bracket <|> p_char "an atom" -group_index :: CharParser (GroupIndex,Int) (Maybe GroupIndex) +group_index :: P (Maybe GroupIndex) group_index = do (gi,ci) <- getState let index = succ gi setState (index,ci) return (Just index) +p_group :: P Pattern p_group = lookAhead (char '(') >> do index <- group_index liftM (PGroup index) $ between (char '(') (char ')') p_regex -- p_post_atom takes the previous atom as a parameter +p_post_atom :: Pattern -> P Pattern p_post_atom atom = (char '?' >> return (PQuest atom)) <|> (char '+' >> return (PPlus atom)) <|> (char '*' >> return (PStar True atom)) <|> p_bound atom <|> return atom +p_bound :: Pattern -> P Pattern p_bound atom = try $ between (char '{') (char '}') (p_bound_spec atom) +p_bound_spec :: Pattern -> P Pattern p_bound_spec atom = do lowS <- many1 digit let lowI = read lowS highMI <- option (Just lowI) $ try $ do @@ -76,6 +93,7 @@ return (PBound lowI highMI atom) -- An anchor cannot be modified by a repetition specifier +p_anchor :: P Pattern p_anchor = (char '^' >> liftM PCarat char_index) <|> (char '$' >> liftM PDollar char_index) <|> try (do _ <- string "()" @@ -83,11 +101,13 @@ return $ PGroup index PEmpty) "empty () or anchor ^ or $" +char_index :: P DoPa char_index = do (gi,ci) <- getState let ci' = succ ci setState (gi,ci') return (DoPa ci') +p_char :: P Pattern p_char = p_dot <|> p_left_brace <|> p_escaped <|> p_other_char where p_dot = char '.' >> char_index >>= return . PDot p_left_brace = try $ (char '{' >> notFollowedBy digit >> char_index >>= return . (`PChar` '{')) @@ -96,16 +116,18 @@ where specials = "^.[$()|*+?{\\" -- parse [bar] and [^bar] sets of characters +p_bracket :: P Pattern p_bracket = (char '[') >> ( (char '^' >> p_set True) <|> (p_set False) ) --- p_set :: Bool -> GenParser Char st Pattern +p_set :: Bool -> P Pattern p_set invert = do initial <- (option "" ((char ']' >> return "]") <|> (char '-' >> return "-"))) values <- if null initial then many1 p_set_elem else many p_set_elem _ <- char ']' ci <- char_index - let chars = maybe'set $ initial - ++ [c | BEChar c <- values ] - ++ concat [s | BEChars s <- values ] + let chars = maybe'set $ concat $ + initial : + [ c | BEChar c <- values ] : + [ [start..end] | BERange start end <- values ] colls = maybe'set [PatternSetCollatingElement coll | BEColl coll <- values ] equivs = maybe'set [PatternSetEquivalenceClass equiv | BEEquiv equiv <- values] class's = maybe'set [PatternSetCharacterClass a'class | BEClass a'class <- values] @@ -115,31 +137,57 @@ -- From here down the code is the parser and functions for pattern [ ] set things -p_set_elem = p_set_elem_class <|> p_set_elem_equiv <|> p_set_elem_coll - <|> p_set_elem_range <|> p_set_elem_char "Failed to parse bracketed string" +p_set_elem :: P BracketElement +p_set_elem = checkBracketElement =<< asum + [ p_set_elem_class + , p_set_elem_equiv + , p_set_elem_coll + , p_set_elem_range + , p_set_elem_char + , fail "Failed to parse bracketed string" + ] +p_set_elem_class :: P BracketElement p_set_elem_class = liftM BEClass $ try (between (string "[:") (string ":]") (many1 $ noneOf ":]")) +p_set_elem_equiv :: P BracketElement p_set_elem_equiv = liftM BEEquiv $ try (between (string "[=") (string "=]") (many1 $ noneOf "=]")) +p_set_elem_coll :: P BracketElement p_set_elem_coll = liftM BEColl $ try (between (string "[.") (string ".]") (many1 $ noneOf ".]")) +p_set_elem_range :: P BracketElement p_set_elem_range = try $ do start <- noneOf "]-" _ <- char '-' end <- noneOf "]" - -- bug fix: check start <= end before "return (BEChars [start..end])" - if start <= end - then return (BEChars [start..end]) - else unexpected "End point of dashed character range is less than starting point" + return $ BERange start end +p_set_elem_char :: P BracketElement p_set_elem_char = do c <- noneOf "]" - when (c == '-') $ do - atEnd <- (lookAhead (char ']') >> return True) <|> (return False) - when (not atEnd) (unexpected "A dash is in the wrong place in a bracket") return (BEChar c) +-- | Fail when 'BracketElement' is invalid, e.g. empty range @1-0@. +-- This failure should not be caught. +-- +checkBracketElement :: BracketElement -> P BracketElement +checkBracketElement e = + case e of + BERange start end + | start > end -> fail $ unwords + [ "End point" + , show end + , "of dashed character range is less than starting point" + , show start + ] + | otherwise -> ok + BEChar _ -> ok + BEClass _ -> ok + BEColl _ -> ok + BEEquiv _ -> ok + where + ok = return e diff --git a/regex-tdfa.cabal b/regex-tdfa.cabal --- a/regex-tdfa.cabal +++ b/regex-tdfa.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: regex-tdfa -version: 1.3.1.3 +version: 1.3.1.4 build-Type: Simple license: BSD3 @@ -46,7 +46,7 @@ source-repository this type: git location: https://github.com/haskell-hvr/regex-tdfa.git - tag: v1.3.1.3 + tag: v1.3.1.4 flag force-O2 default: False @@ -173,3 +173,16 @@ if flag(force-O2) ghc-options: -O2 + +test-suite doc-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: DocTestMain.hs + + build-depends: + base + , regex-tdfa + , doctest-parallel >= 0.2.2 + -- doctest-parallel-0.2.2 is the first to filter out autogen-modules + + default-language: Haskell2010 diff --git a/test/DocTestMain.hs b/test/DocTestMain.hs new file mode 100644 --- /dev/null +++ b/test/DocTestMain.hs @@ -0,0 +1,16 @@ +module Main where + +import System.Environment + ( getArgs ) +import Test.DocTest + ( mainFromLibrary ) +import Test.DocTest.Helpers + ( extractSpecificCabalLibrary, findCabalPackage ) + +main :: IO () +main = do + args <- getArgs + pkg <- findCabalPackage "regex-tdfa" + -- Need to give the library name, otherwise the parser does not find it. + lib <- extractSpecificCabalLibrary Nothing pkg + mainFromLibrary lib args