lexer-applicative 1.0 → 1.0.0.1

raw patch · 4 files changed

+39/−1 lines, 4 filesdep +deepseqPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq

API changes (from Hackage documentation)

Files

CHANGELOG.md +8/−0
lexer-applicative.cabal +3/−1
src/Language/Lexer/Applicative.hs +8/−0
tests/test.hs +20/−0

+ CHANGELOG.md view

@@ -0,0 +1,8 @@+Changelog+=========++1.0.0.1+-------++Signal a lexical error (instead of looping) when a regex does not consume any+characters

lexer-applicative.cabal view

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                lexer-applicative-version:             1.0+version:             1.0.0.1 synopsis:            Simple lexer based on applicative regular expressions description:         Simple lexer based on applicative regular expressions homepage:            https://github.com/feuerbach/lexer-applicative@@ -15,6 +15,7 @@ build-type:          Simple extra-source-files:   README.md+  CHANGELOG.md cabal-version:       >=1.10  Source-repository head@@ -49,3 +50,4 @@     , regex-applicative     , lexer-applicative     , srcloc+    , deepseq

src/Language/Lexer/Applicative.hs view

@@ -32,6 +32,10 @@ -- In case of a lexical error, throws the 'LexicalError' exception. -- This may seem impure compared to using 'Either', but it allows to -- consume the token list lazily.+--+-- Both token and whitespace regexes consume as many characters as possible+-- (the maximal munch rule). When a regex returns without consuming any+-- characters, a lexical error is signaled. tokens   :: forall token.      RE Char token -- ^ regular expression for tokens@@ -45,6 +49,10 @@     [] -> []     s@((_, pos1, _):_) ->       case findLongestPrefix re s of+        -- If the longest match is empty, we have a lexical error+        Just (v, (_, pos1', _):_) | pos1' == pos1 ->+          throw $ LexicalError pos1+         Just (Just tok, rest) ->           let             pos2 =

tests/test.hs view

@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} import Test.Tasty import Test.Tasty.HUnit @@ -6,11 +7,16 @@ import Text.Regex.Applicative.Common import Data.Char import Data.Loc (L(..), Loc(..), Pos(..))+import Control.Exception+import Control.DeepSeq  whitespace = () <$ some (psym isSpace)  unloc (L l a) = (a, l) +-- this is bad, because it accepts an empty string+badWhitespace = () <$ many (psym isSpace)+ main = defaultMain $ testGroup "Tests"   [ testCase "Empty string" $       tokens (empty :: RE Char Int) empty "-" "" @=? []@@ -20,4 +26,18 @@       , (23, Loc (Pos "-" 2 1 3) (Pos "-" 2 2 4))       , (456,Loc (Pos "-" 2 5 7) (Pos "-" 2 7 9))       ]+  , testCase "Nullable parser, no error" $ do+      r <- try . evaluate $ tokens decimal badWhitespace "-" "31 45"+      case r of+        Right (_ :: [L Int]) -> return ()+        Left (e :: SomeException) -> assertFailure $ show e+  , testCase "Nullable parser, error" $ do+      r <- try . evaluate . force $ tokens decimal badWhitespace "-" "31? 45"+      case r of+        Right (_ :: [L Int]) -> assertFailure "No error?"+        Left (LexicalError p) -> p @?= Pos "-" 1 2 2   ]++-- orphan+instance NFData a => NFData (L a) where+  rnf (L loc a) = loc `seq` rnf a