packages feed

skylighting 0.3 → 0.3.1

raw patch · 6 files changed

+152/−55 lines, 6 filesdep +attoparsec

Dependencies added: attoparsec

Files

benchmark/benchmark.hs view
@@ -5,7 +5,7 @@ import System.FilePath import Data.Text (Text) import qualified Data.Text as Text-import System.Directory+-- import System.Directory  main :: IO () main = do@@ -17,8 +17,9 @@         let format = drop 1 $ takeExtension fp         return (Text.pack format, Text.pack contents)   cases <- mapM getCase inputs-  xmlfiles <- filter (\x -> takeExtension x == ".xml") <$>-                  getDirectoryContents "xml"+  -- xmlfiles <- filter (\x -> takeExtension x == ".xml") <$>+  --                getDirectoryContents "xml"+  let xmlfiles = ["haskell.xml"]   defaultMainWith defaultConfig{ timeLimit = 10.0 }     $ parseBench xmlfiles : map testBench cases
changelog.md view
@@ -1,5 +1,16 @@ # Revision history for skylighting +## 0.3.1 -- 2017-02-28++  * Use handwritten parser for Float instead of regex.  Fixes+    jgm/highlighting-kate#57 (again).+  * Added float parsing tests.+  * Use parsec parsers, not regex, for CStringChar and CChar.+  * Rewrote Int, Hex, Oct, CStringChar, CCHar parsers with parsec+    instead of regex.  This speeds things up.+  * Don't include leading + in Int, Hex, Oct parsers.  That gives+    bad results for things like `i+1`.+ ## 0.3 -- 2017-02-19    * Store literal binary-encoded representations of the Syntax
skylighting.cabal view
@@ -1,5 +1,5 @@ name:                skylighting-version:             0.3+version:             0.3.1 synopsis:            syntax highlighting library description:         Skylighting is a syntax highlighting library with                      support for over one hundred languages.  It derives@@ -233,6 +233,7 @@                        filepath,                        aeson,                        case-insensitive,+                       attoparsec,                        utf8-string,                        hxt,                        safe,
src/Skylighting/Tokenizer.hs view
@@ -20,6 +20,7 @@ import qualified Data.Text as Text import Data.Text.Encoding (decodeUtf8', encodeUtf8) import qualified Data.ByteString.UTF8 as UTF8+import qualified Data.Attoparsec.ByteString.Char8 as A import Debug.Trace import Skylighting.Regex import Skylighting.Types@@ -214,13 +215,12 @@                 AnyChar cs -> withAttr attr $ anyChar cs inp                 RangeDetect c d -> withAttr attr $ rangeDetect c d inp                 RegExpr re -> withAttr attr $ regExpr (rDynamic rule) re inp-                Int -> withAttr attr $ regExpr False integerRegex inp-                HlCOct -> withAttr attr $ regExpr False octRegex inp-                HlCHex -> withAttr attr $ regExpr False hexRegex inp-                HlCStringChar -> withAttr attr $-                                     regExpr False hlCStringCharRegex inp-                HlCChar -> withAttr attr $ regExpr False hlCCharRegex inp-                Float -> withAttr attr $ regExpr False floatRegex inp+                Int -> withAttr attr $ parseInt inp+                HlCOct -> withAttr attr $ parseOct inp+                HlCHex -> withAttr attr $ parseHex inp+                HlCStringChar -> withAttr attr $ parseCStringChar inp+                HlCChar -> withAttr attr $ parseCChar inp+                Float -> withAttr attr $ parseFloat inp                 Keyword kwattr kws ->                   withAttr attr $ keyword kwattr kws inp                 StringDetect s -> withAttr attr $@@ -269,22 +269,6 @@      then return Nothing      else return $ Just (tt, res) -hlCStringCharRegex :: RE-hlCStringCharRegex = RE{-    reString = reHlCStringChar-  , reCaseSensitive = False-  }--reHlCStringChar :: ByteString-reHlCStringChar = "\\\\(?:[abefnrtv\"'?\\\\]|[xX][a-fA-F0-9]+|0[0-7]+)"--hlCCharRegex :: RE-hlCCharRegex = RE{-    reString = reStr-  , reCaseSensitive = False-  }-  where reStr = "'(?:" <> reHlCStringChar <> "|[^'\\\\])'"- {- -- Try a tokenizer and return to original state if it fails. -- This is used when one tokenizer calls another.@@ -472,8 +456,12 @@ -- TODO is this right? isWordBoundary :: Char -> Char -> Bool isWordBoundary c d =-  (isAlphaNum c && not (isAlphaNum d)) || (isAlphaNum d && not (isAlphaNum c))+  (isAlphaNum c && not (isAlphaNum d))+  || (isAlphaNum d && not (isAlphaNum c))+  || (isSpace d && not (isSpace c))+  || (isSpace c && not (isSpace d)) + decodeBS :: ByteString -> TokenizerM Text decodeBS bs = case decodeUtf8' bs of                     Left _ -> throwError ("ByteString " ++@@ -543,31 +531,110 @@     (t, Text.concat (x : map snd matches)) : normalizeHighlighting rest     where (matches, rest) = span (\(z,_) -> z == t) xs -integerRegex :: RE-integerRegex = RE{-    reString = intReStr-  , reCaseSensitive = False-  }-  where intReStr = "\\b[-+]?(0[Xx][0-9A-Fa-f]+|0[Oo][0-7]+|[0-9]+)\\b"+parseCStringChar :: ByteString -> TokenizerM Text+parseCStringChar inp = do+  case A.parseOnly (A.match pCStringChar) inp of+       Left _ -> mzero+       Right (r,_) -> takeChars (BS.length r) -- assumes ascii -floatRegex :: RE-floatRegex = RE{-    reString = floatReStr-  , reCaseSensitive = False-  }-  where floatReStr = "\\b[-+]?(([0-9]+\\.[0-9]*|[0-9]*\\.[0-9]+)([Ee][-+]?[0-9]+)?|[0-9]+[Ee][-+]?[0-9]+)\\b"+pCStringChar :: A.Parser ()+pCStringChar = do+  _ <- A.char '\\'+  next <- A.anyChar+  case next of+       c | c == 'x' || c == 'X' -> () <$ A.takeWhile1 (A.inClass "0-9a-fA-F")+         | c == '0' -> () <$ A.takeWhile1 (A.inClass "0-7")+         | A.inClass "abefnrtv\"'?\\" c -> return ()+         | otherwise -> mzero -octRegex :: RE-octRegex = RE{-    reString = octRegexStr-  , reCaseSensitive = False-  }-  where octRegexStr = "\\b[-+]?0[Oo][0-7]+\\b"+parseCChar :: ByteString -> TokenizerM Text+parseCChar inp = do+  case A.parseOnly (A.match pCChar) inp of+       Left _ -> mzero+       Right (r,_) -> takeChars (BS.length r) -- assumes ascii -hexRegex :: RE-hexRegex = RE{-    reString = hexRegexStr-  , reCaseSensitive = False-  }-  where hexRegexStr = "\\b[-+]?0[Xx][0-9A-Fa-f]+\\b"+pCChar :: A.Parser ()+pCChar = do+  () <$ A.char '\''+  pCStringChar <|> () <$ A.satisfy (\c -> c /= '\'' && c /= '\\')+  () <$ A.char '\''++parseInt :: ByteString -> TokenizerM Text+parseInt inp = do+  wordBoundary inp+  case A.parseOnly (A.match (pHex <|> pOct <|> pDec)) inp of+       Left _ -> mzero+       Right (r,_) -> takeChars (BS.length r) -- assumes ascii++pDec :: A.Parser ()+pDec = do+  mbMinus+  _ <- A.takeWhile1 (A.inClass "0-9")+  guardWordBoundary++parseOct :: ByteString -> TokenizerM Text+parseOct inp = do+  wordBoundary inp+  case A.parseOnly (A.match pHex) inp of+       Left _ -> mzero+       Right (r,_) -> takeChars (BS.length r) -- assumes ascii++pOct :: A.Parser ()+pOct = do+  mbMinus+  _ <- A.char '0'+  _ <- A.satisfy (A.inClass "Oo")+  _ <- A.takeWhile1 (A.inClass "0-7")+  guardWordBoundary++parseHex :: ByteString -> TokenizerM Text+parseHex inp = do+  wordBoundary inp+  case A.parseOnly (A.match pHex) inp of+       Left _ -> mzero+       Right (r,_) -> takeChars (BS.length r) -- assumes ascii++pHex :: A.Parser ()+pHex = do+  mbMinus+  _ <- A.char '0'+  _ <- A.satisfy (A.inClass "Xx")+  _ <- A.takeWhile1 (A.inClass "0-9a-fA-F")+  guardWordBoundary++guardWordBoundary :: A.Parser ()+guardWordBoundary = do+  mbw <- A.peekChar+  case mbw of+       Just c ->  guard $ isWordBoundary '0' c+       Nothing -> return ()++mbMinus :: A.Parser ()+mbMinus = (() <$ A.char '-') <|> return ()++mbPlusMinus :: A.Parser ()+mbPlusMinus = () <$ A.satisfy (A.inClass "+-") <|> return ()++parseFloat :: ByteString -> TokenizerM Text+parseFloat inp = do+  wordBoundary inp+  case A.parseOnly (A.match pFloat) inp of+       Left _ -> mzero+       Right (r,_) -> takeChars (BS.length r)  -- assumes all ascii+  where pFloat :: A.Parser ()+        pFloat = do+          let digits = A.takeWhile1 (A.inClass "0-9")+          mbPlusMinus+          before <- A.option False $ True <$ digits+          dot <- A.option False $ True <$ A.satisfy (A.inClass ".")+          after <- A.option False $ True <$ digits+          e <- A.option False $ True <$ (A.satisfy (A.inClass "Ee") >>+                                         mbPlusMinus >> digits)+          mbnext <- A.peekChar+          case mbnext of+               Nothing   -> return ()+               Just c    -> guard (not $ A.inClass "." c)+          guard $ (before && not dot && e)     -- 5e2+               || (before && dot && (after || not e)) -- 5.2e2 or 5.2 or 5.+               || (not before && dot && after) -- .23 or .23e2
test/expected/abc.javascript.native view
@@ -100,8 +100,7 @@   , ( NormalTok , " (index " )   , ( OperatorTok , "!==" )   , ( NormalTok , " " )-  , ( OperatorTok , "-" )-  , ( DecValTok , "1" )+  , ( DecValTok , "-1" )   , ( NormalTok , ") " )   , ( OperatorTok , "{" )   ]
test/test-skylighting.hs view
@@ -75,7 +75,9 @@         map (noDropTest randomText) syntaxes     , testGroup "Regression tests" $       let perl = maybe (error "could not find Perl syntax") id-                             (lookupSyntax "Perl" defaultSyntaxMap) in+                             (lookupSyntax "Perl" defaultSyntaxMap)+          cpp  = maybe (error "could not find CPP syntax") id+                             (lookupSyntax "cpp" defaultSyntaxMap) in       [ testCase "perl NUL case" $ Right              [[(KeywordTok,"s\NUL")               ,(OtherTok,"b")@@ -115,6 +117,22 @@               ]             ] @=? tokenize defConfig perl                      "my $foo = q/bar/;\nmy $baz = 'quux';\n"+      , testCase "cpp floats" $ Right+           [ [ ( FloatTok , "0.1f" ) ]+           , [ ( FloatTok , "1.0f" ) ]+           , [ ( FloatTok , "-0.1f" ) ]+           , [ ( FloatTok , "-1.0F" ) ]+           , [ ( FloatTok , "-1.0L" ) ]+           , [ ( FloatTok , "1e3" ) ]+           , [ ( FloatTok , "-15e+3" ) ]+           , [ ( FloatTok , "0.f" ) ]+           , [ ( FloatTok , "1.F" ) ]+           , [ ( DecValTok , "1" )+             , ( NormalTok ,".E" )+             , ( DecValTok , "3" )+             ]+           ] @=? tokenize defConfig cpp+                     "0.1f\n1.0f\n-0.1f\n-1.0F\n-1.0L\n1e3\n-15e+3\n0.f\n1.F\n1.E3"       ]     ]