skylighting 0.1.1.1 → 0.1.1.2
raw patch · 8 files changed
+163/−65 lines, 8 filesdep +randomdep −QuickCheckPVP ok
version bump matches the API change (PVP)
Dependencies added: random
Dependencies removed: QuickCheck
API changes (from Hackage documentation)
Files
- README.md +3/−0
- benchmark/benchmark.hs +0/−3
- changelog.md +9/−0
- skylighting.cabal +5/−2
- src/Skylighting/Tokenizer.hs +92/−55
- test/cases/if.cmake +3/−0
- test/expected/if.cmake.native +9/−0
- test/test-skylighting.hs +42/−5
README.md view
@@ -29,6 +29,9 @@ dynamically. It is also now possible to convert `.theme` files directly into styles. +Skylighting is also faster than highlighting-kate, by a+factor of 3 in some cases.+ Installing ----------
benchmark/benchmark.hs view
@@ -2,14 +2,11 @@ import Criterion.Main import Criterion.Types (Config(..)) import System.FilePath-import System.Directory import Data.Text (Text) import qualified Data.Text as Text main :: IO () main = do- -- inputs <- filter (\fp -> take 1 fp /= ".")- -- <$> getDirectoryContents ("test" </> "cases") let inputs = ["abc.haskell", "abc.java", "abc.c", "archive.rhtml", "life.lua", "abc.javascript"] let getCase fp = do
changelog.md view
@@ -20,3 +20,12 @@ and often better. * Added benchmarks. +## 0.1.1.2 -- 2017-01-28++* Added much more extensive testing to ensure that tokenizers+ don't hang or drop input.+* Fixed some issues with line-end and fallthrough context+ handling.+* Fixed a bug in WordDetect handling which caused it to drop+ input (#2).+
skylighting.cabal view
@@ -1,5 +1,5 @@ name: skylighting-version: 0.1.1.1+version: 0.1.1.2 synopsis: syntax highlighting library description: Skylighting is a syntax highlighting library with support for over one hundred languages. It derives@@ -51,6 +51,7 @@ test/cases/archive.rhtml test/cases/life.lua test/cases/hk91.html+ test/cases/if.cmake test/expected/abc.ada.native test/expected/abc.agda.native test/expected/abc.c.native@@ -80,6 +81,7 @@ test/expected/archive.rhtml.native test/expected/life.lua.native test/expected/hk91.html.native+ test/expected/if.cmake.native cabal-version: >=1.10 @@ -320,6 +322,8 @@ tasty, tasty-golden, tasty-hunit,+ containers,+ random, Diff, text, pretty-show,@@ -327,7 +331,6 @@ bytestring, directory, filepath,- QuickCheck, skylighting default-language: Haskell2010 ghc-options: -Wall
src/Skylighting/Tokenizer.hs view
@@ -41,6 +41,7 @@ data TokenizerState = TokenizerState{ input :: ByteString+ , endline :: Bool , prevChar :: Char , contextStack :: ContextStack , captures :: [ByteString]@@ -62,16 +63,21 @@ popContextStack = do ContextStack cs <- gets contextStack case cs of- [] -> throwError "Empty context stack" -- programming error- (_:[]) -> return () -- don't pop last context+ [] -> throwError "Empty context stack (the impossible happened)"+ -- programming error+ (_:[]) -> return () (_:rest) -> do modify (\st -> st{ contextStack = ContextStack rest })+ currentContext >>= checkLineEnd infoContextStack pushContextStack :: Context -> TokenizerM () pushContextStack cont = do modify (\st -> st{ contextStack = ContextStack (cont : unContextStack (contextStack st)) } )+ -- not sure why we need this in pop but not here, but if we+ -- put it here we can get loops...+ -- checkLineEnd cont infoContextStack currentContext :: TokenizerM Context@@ -81,21 +87,19 @@ [] -> throwError "Empty context stack" -- programming error (c:_) -> return c -doContextSwitch :: [ContextSwitch] -> TokenizerM ()-doContextSwitch [] = return ()-doContextSwitch (Pop : xs) = do- popContextStack- currentContext >>= checkLineEnd- doContextSwitch xs-doContextSwitch (Push (syn,c) : xs) = do+doContextSwitch :: ContextSwitch -> TokenizerM ()+doContextSwitch Pop = popContextStack+doContextSwitch (Push (syn,c)) = do syntaxes <- asks syntaxMap case Map.lookup syn syntaxes >>= lookupContext c of- Just con -> do- pushContextStack con- checkLineEnd con- doContextSwitch xs+ Just con -> pushContextStack con Nothing -> throwError $ "Unknown syntax or context: " ++ show (syn, c) +doContextSwitches :: [ContextSwitch] -> TokenizerM ()+doContextSwitches [] = return ()+doContextSwitches xs = do+ mapM_ doContextSwitch xs+ lookupContext :: Text -> Syntax -> Maybe Context lookupContext name syntax | Text.null name = if Text.null (sStartingContext syntax)@@ -111,6 +115,7 @@ (runExceptT (mapM tokenizeLine $ zip (BS.lines $ encodeUtf8 inp) [1..])) config) startingState{ input = encodeUtf8 inp+ , endline = Text.null inp , contextStack = case lookupContext (sStartingContext syntax) syntax of Just c -> ContextStack [c]@@ -119,6 +124,7 @@ startingState :: TokenizerState startingState = TokenizerState{ input = BS.empty+ , endline = True , prevChar = '\n' , contextStack = ContextStack [] , captures = []@@ -129,6 +135,7 @@ tokenizeLine :: (ByteString, Int) -> TokenizerM [Token] tokenizeLine (ln, linenum) = do+ modify $ \st -> st{ input = ln, endline = BS.null ln, prevChar = '\n' } cur <- currentContext lineCont <- gets lineContinuation if lineCont@@ -137,14 +144,13 @@ modify $ \st -> st{ column = 0 , firstNonspaceColumn = BS.findIndex (not . isSpace) ln }- doContextSwitch (cLineBeginContext cur)+ doContextSwitches (cLineBeginContext cur) if BS.null ln- then doContextSwitch (cLineEmptyContext cur)- else doContextSwitch (cLineBeginContext cur)- modify $ \st -> st{ input = ln, prevChar = '\n' }+ then doContextSwitches (cLineEmptyContext cur)+ else doContextSwitches (cLineBeginContext cur) ts <- normalizeHighlighting . catMaybes <$> many getToken- inp <- gets input- if BS.null inp+ eol <- gets endline+ if eol then do currentContext >>= checkLineEnd return ts@@ -156,11 +162,16 @@ getToken :: TokenizerM (Maybe Token) getToken = do inp <- gets input- guard $ not (BS.null inp)+ gets endline >>= guard . not context <- currentContext msum (map (\r -> tryRule r inp) (cRules context)) <|> if cFallthrough context- then doContextSwitch (cFallthroughContext context) >> getToken+ then do+ let fallthroughContext = case cFallthroughContext context of+ [] -> [Pop]+ cs -> cs+ doContextSwitches fallthroughContext+ getToken else (\x -> Just (cAttribute context, x)) <$> normalChunk takeChars :: Int -> TokenizerM Text@@ -171,6 +182,7 @@ guard $ not (BS.null bs) t <- decodeBS bs modify $ \st -> st{ input = rest,+ endline = BS.null rest, prevChar = Text.last t, column = column st + numchars } return t@@ -226,13 +238,15 @@ Nothing -> return Nothing Just (tt, s) | rLookahead rule -> do- (oldinput, oldprevChar, oldColumn) <-+ (oldinput, oldendline, oldprevChar, oldColumn) <- case oldstate of Nothing -> throwError "oldstate not saved with lookahead rule" Just st -> return- (input st, prevChar st, column st)+ (input st, endline st,+ prevChar st, column st) modify $ \st -> st{ input = oldinput+ , endline = oldendline , prevChar = oldprevChar , column = oldColumn } return Nothing@@ -242,7 +256,7 @@ Just (_, cresult) -> return $ Just (tt, s <> cresult) info $ takeWhile (/=' ') (show (rMatcher rule)) ++ " MATCHED " ++ show mbtok'- doContextSwitch (rContextSwitch rule)+ doContextSwitches (rContextSwitch rule) return mbtok' withAttr :: TokenType -> TokenizerM Text -> TokenizerM (Maybe Token)@@ -270,25 +284,42 @@ } where reStr = "'(?:" <> reHlCStringChar <> "|[^'\\\\])'" +{-+-- Try a tokenizer and return to original state if it fails.+-- This is used when one tokenizer calls another.+try :: TokenizerM a -> TokenizerM a+try tokenizer' = do+ origstate <- get+ tokenizer' <|> (put origstate >> mzero)+-}+ wordDetect :: Bool -> Text -> ByteString -> TokenizerM Text wordDetect caseSensitive s inp = do- res <- stringDetect caseSensitive s inp- -- now check for word boundary: (TODO: check to make sure this is correct)- case UTF8.uncons inp of- Just (c, _) | not (isAlphaNum c) -> return res- _ -> mzero+ wordBoundary inp+ t <- decodeBS $ UTF8.take (Text.length s) inp+ -- we assume here that the case fold will not change length,+ -- which is safe for ASCII keywords and the like...+ guard $ if caseSensitive+ then s == t+ else mk s == mk t+ guard $ not (Text.null t)+ let c = Text.last t+ let rest = UTF8.drop (Text.length s) inp+ let d = case UTF8.uncons rest of+ Nothing -> '\n'+ Just (x,_) -> x+ guard $ isWordBoundary c d+ takeChars (Text.length t) stringDetect :: Bool -> Text -> ByteString -> TokenizerM Text stringDetect caseSensitive s inp = do t <- decodeBS $ UTF8.take (Text.length s) inp -- we assume here that the case fold will not change length, -- which is safe for ASCII keywords and the like...- let matches = if caseSensitive- then s == t- else mk s == mk t- if matches- then takeChars (Text.length s)- else mzero+ guard $ if caseSensitive+ then s == t+ else mk s == mk t+ takeChars (Text.length s) -- This assumes that nothing significant will happen -- in the middle of a string of spaces or a string@@ -302,10 +333,10 @@ Nothing -> mzero Just (c, _) | c == ' ' ->- let (bs,_) = BS.span (==' ') inp+ let bs = BS.takeWhile (==' ') inp in takeChars (BS.length bs) | isAscii c && isAlphaNum c ->- let (bs,_) = BS.span isAlphaNum inp+ let bs = BS.takeWhile isAlphaNum inp in takeChars (BS.length bs) | otherwise -> takeChars 1 @@ -317,18 +348,21 @@ Nothing -> throwError $ "Context lookup failed " ++ show (syn, con) Just c -> do mbtok <- msum (map (\r -> tryRule r inp) (cRules c))- checkLineEnd c return $ case (mbtok, mbattr) of- (Just (NormalTok, xs), Just attr) ->- Just (attr, xs)+ (Just (NormalTok, xs), Just attr) -> Just (attr, xs) _ -> mbtok checkLineEnd :: Context -> TokenizerM () checkLineEnd c = do- inp <- gets input- when (BS.null inp) $ do- lineCont' <- gets lineContinuation- unless lineCont' $ doContextSwitch (cLineEndContext c)+ if null (cLineEndContext c)+ then return ()+ else do+ eol <- gets endline+ info $ "checkLineEnd for " ++ show (cName c) ++ " eol = " ++ show eol ++ " cLineEndContext = " ++ show (cLineEndContext c)+ when eol $ do+ lineCont' <- gets lineContinuation+ unless lineCont' $+ doContextSwitches (cLineEndContext c) detectChar :: Bool -> Char -> ByteString -> TokenizerM Text detectChar dynamic c inp = do@@ -410,23 +444,26 @@ -- note, for dynamic regexes rCompiled == Nothing: let regex = fromMaybe (compileRegex (reCaseSensitive re) reStr) $ reCompiled re- -- If regex starts with \b, determine if we're at a word- -- boundary and mzero if not (TODO - is this the correct- -- definition of a word boundary?)- when (BS.take 2 reStr == "\\b") $- case UTF8.uncons inp of- Nothing -> return ()- Just (c, _) -> do- prev <- gets prevChar- if isAlphaNum prev- then guard (not (isAlphaNum c))- else guard (isAlphaNum c)+ when (BS.take 2 reStr == "\\b") $ wordBoundary inp case matchRegex regex inp of Just (match:capts) -> do match' <- decodeBS match modify $ \st -> st{ captures = capts } takeChars (Text.length match') _ -> mzero++wordBoundary :: ByteString -> TokenizerM ()+wordBoundary inp = do+ case UTF8.uncons inp of+ Nothing -> return ()+ Just (d, _) -> do+ c <- gets prevChar+ guard $ isWordBoundary c d++-- TODO is this right?+isWordBoundary :: Char -> Char -> Bool+isWordBoundary c d =+ (isAlphaNum c && not (isAlphaNum d)) || (isAlphaNum d && not (isAlphaNum c)) decodeBS :: ByteString -> TokenizerM Text decodeBS bs = case decodeUtf8' bs of
+ test/cases/if.cmake view
@@ -0,0 +1,3 @@+if(CMARK_TESTS and CMARK_SHARED)+ add_subdirectory(api_test)+endif()
+ test/expected/if.cmake.native view
@@ -0,0 +1,9 @@+[ [ ( KeywordTok , "if" )+ , ( NormalTok , "(CMARK_TESTS and CMARK_SHARED)" )+ ]+, [ ( NormalTok , " " )+ , ( KeywordTok , "add_subdirectory" )+ , ( NormalTok , "(api_test)" )+ ]+, [ ( KeywordTok , "endif" ) , ( NormalTok , "()" ) ]+]
test/test-skylighting.hs view
@@ -17,11 +17,28 @@ import Test.Tasty.Golden.Advanced (goldenTest) import Test.Tasty.HUnit import Text.Show.Pretty+import qualified Data.Map as Map+import System.Random +syntaxes :: [Syntax]+syntaxes = Map.elems defaultSyntaxMap++defConfig :: TokenizerConfig+defConfig = TokenizerConfig{ traceOutput = False+ , syntaxMap = defaultSyntaxMap }++tokToText :: Token -> Text+tokToText (_, s) = s+ main :: IO () main = do+ stdgen <- newStdGen+ let randomText = Text.unlines $ Text.chunksOf 31+ $ Text.pack $ take 5000 $ randomRs ('\0','\127') stdgen inputs <- filter (\fp -> take 1 fp /= ".") <$> getDirectoryContents ("test" </> "cases")+ allcases <- mconcat <$>+ mapM (Text.readFile . (("test" </> "cases") </>)) inputs args <- getArgs let regen = "--regenerate" `elem` args defaultTheme <- BL.readFile ("test" </> "default.theme")@@ -51,6 +68,10 @@ ["Perl"] @=? map sName (syntaxesByFilename defaultSyntaxMap "foo/bar.pl") ]+ , testGroup "Doesn't hang or drop text on a mixed syntax sample" $+ map (noDropTest allcases) syntaxes+ , testGroup "Doesn't hang or drop text on fuzz" $+ map (noDropTest randomText) syntaxes , testGroup "Regression tests" $ [ testCase "perl quoting case" $ Right [ [ ( KeywordTok , "my" )@@ -83,11 +104,27 @@ compareValues referenceFile expected actual = if expected == actual then return $ Nothing- else return $ Just $ unlines $- [ "--- " ++ referenceFile- , "+++ actual" ] ++- map (Text.unpack . vividize)- (getDiff (Text.lines expected) (Text.lines actual))+ else return $ Just $ makeDiff referenceFile+ (Text.lines expected) (Text.lines actual)++makeDiff :: FilePath -> [Text] -> [Text] -> String+makeDiff referenceFile expected actual = unlines $+ [ "--- " ++ referenceFile+ , "+++ actual" ] +++ map (Text.unpack . vividize) (filter notBoth (getDiff expected actual))+ where notBoth (Both _ _ ) = False+ notBoth _ = True++noDropTest :: Text -> Syntax -> TestTree+noDropTest inp syntax = localOption (mkTimeout 1000000) $+ testCase (Text.unpack (sName syntax)) $+ case tokenize defConfig syntax inp of+ Right ts -> assertBool ("Text has been dropped:\n" ++ diffs)+ (inplines == toklines)+ where inplines = Text.lines inp+ toklines = map (mconcat . map tokToText) ts+ diffs = makeDiff "expected" inplines toklines+ Left e -> assert ("Unexpected error: " ++ e) tokenizerTest :: Bool -> FilePath -> TestTree tokenizerTest regen inpFile = localOption (mkTimeout 1000000) $