diff --git a/benchmark/benchmark.hs b/benchmark/benchmark.hs --- a/benchmark/benchmark.hs +++ b/benchmark/benchmark.hs @@ -1,10 +1,10 @@ -import Skylighting -import qualified Data.Map as Map import Criterion.Main -import Criterion.Types (Config(..)) -import System.FilePath +import Criterion.Types (Config (..)) +import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as Text +import Skylighting +import System.FilePath -- import System.Directory main :: IO () @@ -30,7 +30,7 @@ where addFile f = do result <- parseSyntaxDefinition ("xml" f) case result of - Left e -> error e + Left e -> error e Right r -> return r testBench :: (Text, Text) -> Benchmark diff --git a/bin/extract.hs b/bin/extract.hs --- a/bin/extract.hs +++ b/bin/extract.hs @@ -1,5 +1,6 @@ {-# LANGUAGE Arrows #-} +import Data.Binary (encode) import Data.Either (partitionEithers) import Data.List (intercalate, isInfixOf) import qualified Data.Text as Text @@ -9,7 +10,6 @@ import System.Environment (getArgs) import System.Exit import System.IO (hPutStrLn, stderr) -import Data.Binary (encode) main :: IO () main = do diff --git a/bin/main.hs b/bin/main.hs --- a/bin/main.hs +++ b/bin/main.hs @@ -29,12 +29,14 @@ | NumberLines | Syn String | TitleAttributes + | ColorLevel String | Definition String | Trace | Version deriving (Eq, Show) -data HighlightFormat = FormatHtml +data HighlightFormat = FormatANSI + | FormatHtml | FormatLaTeX | FormatNative deriving (Eq, Show) @@ -52,7 +54,7 @@ ,Option ['f'] ["format"] (ReqArg Format "FORMAT") - "output format (html|latex|native)" + "output format (ansi|html|latex|native)" ,Option ['r'] ["fragment"] (NoArg Fragment) @@ -77,10 +79,14 @@ ["title-attributes"] (NoArg TitleAttributes) "include structure in title attributes" + ,Option ['C'] + ["color-level"] + (ReqArg ColorLevel "LEVEL") + "ANSI color support level (auto|16|256|true)" ,Option ['d'] ["definition"] (ReqArg Definition "PATH") - "load xml syntax definition file (may be repeated)" + "load xml syntax definition (may be repeated)" ,Option ['T'] ["trace"] (NoArg Trace) @@ -108,25 +114,47 @@ Left e -> err e Right sty -> return sty styleOf (Sty s : _) = case map toLower s of - "pygments" -> return pygments - "espresso" -> return espresso - "kate" -> return kate - "tango" -> return tango - "haddock" -> return haddock - "monochrome" -> return monochrome + "pygments" -> return pygments + "espresso" -> return espresso + "kate" -> return kate + "tango" -> return tango + "haddock" -> return haddock + "monochrome" -> return monochrome "breeze-dark" -> return breezeDark - _ -> err $ "Unknown style: " ++ s + _ -> err $ "Unknown style: " ++ s styleOf (_ : xs) = styleOf xs formatOf :: [Flag] -> IO HighlightFormat -formatOf [] = return FormatHtml -- default +formatOf [] = return FormatANSI -- default formatOf (Format s : _) = case map toLower s of + "ansi" -> return FormatANSI "html" -> return FormatHtml "latex" -> return FormatLaTeX "native" -> return FormatNative _ -> err $ "Unknown format: " ++ s formatOf (_ : xs) = formatOf xs +colorLevelOf :: [Flag] -> IO (Maybe ANSIColorLevel) +colorLevelOf [] = return Nothing +colorLevelOf (ColorLevel s : _) = case map toLower s of + "auto" -> return Nothing + "16" -> return $ Just ANSI16Color + "256" -> return $ Just ANSI256Color + "true" -> return $ Just ANSITrueColor + _ -> err $ "Unknown color level: " ++ s +colorLevelOf (_ : xs) = colorLevelOf xs + +-- Crude, but conservative enough to work. Maybe extendable later? +getActualColorLevel :: Maybe ANSIColorLevel -> IO ANSIColorLevel +getActualColorLevel (Just cl) = return cl +getActualColorLevel Nothing = do mct <- lookupEnv "COLORTERM" + mtm <- lookupEnv "TERM" + if mct == Just "truecolor" || mct == Just "24bit" + then return ANSITrueColor + else if mtm == Just "xterm-256color" + then return ANSI256Color + else return ANSI16Color + extractDefinitions :: [Flag] -> IO [Syntax] extractDefinitions [] = return [] extractDefinitions (Definition fp : xs) = do @@ -163,14 +191,6 @@ syntaxMap' <- foldr addSyntaxDefinition defaultSyntaxMap <$> extractDefinitions opts -{- - case missingIncludes (Map.elems syntaxMap') of - [] -> return () - xs -> err $ "Missing syntax definitions:\n" ++ - unlines (map - (\(syn,dep) -> (Text.unpack syn ++ " requires " ++ - Text.unpack dep ++ " through IncludeRules.")) xs) --} when (List `elem` opts) $ do let printSyntaxNames s = putStrLn (printf "%s (%s)" (Text.unpack (Text.toLower (sShortname s))) @@ -182,9 +202,11 @@ then Text.getContents else mconcat <$> mapM Text.readFile fnames + actualColorLevel <- colorLevelOf opts >>= getActualColorLevel let highlightOpts = defaultFormatOpts{ titleAttributes = TitleAttributes `elem` opts , numberLines = NumberLines `elem` opts , lineAnchors = NumberLines `elem` opts + , ansiColorLevel = actualColorLevel } let fragment = Fragment `elem` opts let fname = case fnames of @@ -204,9 +226,16 @@ Right ls -> return ls case format of + FormatANSI -> hlANSI highlightOpts style sourceLines FormatHtml -> hlHtml fragment fname highlightOpts style sourceLines FormatLaTeX -> hlLaTeX fragment fname highlightOpts style sourceLines FormatNative -> putStrLn $ ppShow sourceLines + +hlANSI :: FormatOptions + -> Style + -> [SourceLine] + -> IO () +hlANSI opts sty = Text.putStrLn . formatANSI opts sty hlHtml :: Bool -- ^ Fragment -> FilePath -- ^ Filename diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,25 @@ # Revision history for skylighting +## 0.6 -- 2018-01-18 + + * Add ANSI color output (Alexander Ronald Altman, #22). + + + New package dependencies: `ansi-terminal` and `colour`. + + New module: `Skylighting.Format.ANSI`, exporting `formatANSI`, + (also reexported from the module `Skylighting`). + + In `Skylighting.Types`, new types `ANSIColorLevel` and + `Xterm256ColorCode`, and a new field `ansiColorLevel` in + `FormatOptions`. + + Main `skylighting` executable now supports ANSI output (use + `ansi` as argument to `--format`), which is now the default output + format. A new flag `--color-level` has been added to select + the number of colors (with options `16`, `256`, `true`, and + the default `auto`). + + * Reword error for missing contexts in IncludeRules. + + * Use ordNub instead of nub for missingIncludes. + ## 0.5.1 -- 2018-01-07 * Fixed tokenizer exceptions (#31). Previously `throwError` diff --git a/prelude/Prelude.hs b/prelude/Prelude.hs --- a/prelude/Prelude.hs +++ b/prelude/Prelude.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} -{-# LANGUAGE CPP #-} -- This custom Prelude emulates the API of the prelude -- with base 4.8. @@ -20,7 +20,7 @@ #if MIN_VERSION_base(4,8,0) import "base" Prelude as P #else -import "base" Prelude as P import Control.Applicative import Data.Monoid +import "base" Prelude as P #endif diff --git a/skylighting.cabal b/skylighting.cabal --- a/skylighting.cabal +++ b/skylighting.cabal @@ -1,5 +1,5 @@ name: skylighting -version: 0.5.1 +version: 0.6 synopsis: syntax highlighting library description: Skylighting is a syntax highlighting library with support for over one hundred languages. It derives @@ -98,6 +98,7 @@ Skylighting.Parser Skylighting.Styles Skylighting.Tokenizer + Skylighting.Format.ANSI Skylighting.Format.HTML Skylighting.Format.LaTeX Skylighting.Syntax @@ -242,7 +243,9 @@ safe, base64-bytestring, blaze-html >= 0.5, - containers + containers, + ansi-terminal >= 0.7, + colour >= 2.0 if flag(system-pcre) build-depends: regex-pcre else @@ -282,7 +285,9 @@ aeson >= 1.0, binary, containers, - directory + directory, + ansi-terminal >= 0.7, + colour >= 2.0 if flag(system-pcre) build-depends: regex-pcre else @@ -371,7 +376,8 @@ text, containers, directory, - criterion >= 1.0 && < 1.3 + criterion >= 1.0 && < 1.4 Ghc-Options: -rtsopts -Wall -fno-warn-unused-do-bind Default-Language: Haskell2010 - + if flag(bootstrap) + buildable: False diff --git a/src/Skylighting.hs b/src/Skylighting.hs --- a/src/Skylighting.hs +++ b/src/Skylighting.hs @@ -10,6 +10,7 @@ , module Skylighting.Regex , module Skylighting.Syntax , module Skylighting.Styles + , module Skylighting.Format.ANSI , module Skylighting.Format.HTML , module Skylighting.Format.LaTeX ) where @@ -19,6 +20,7 @@ import Data.Maybe (listToMaybe) import Data.Text (Text) import qualified Data.Text as Text +import Skylighting.Format.ANSI import Skylighting.Format.HTML import Skylighting.Format.LaTeX import Skylighting.Parser diff --git a/src/Skylighting/Format/ANSI.hs b/src/Skylighting/Format/ANSI.hs new file mode 100644 --- /dev/null +++ b/src/Skylighting/Format/ANSI.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE OverloadedStrings #-} +module Skylighting.Format.ANSI ( + formatANSI + ) where +import Control.Monad (mplus) +import qualified Data.Map as Map +import Data.Maybe (fromMaybe, isNothing, maybeToList) +import Data.Monoid +import Data.Text (Text) +import qualified Data.Text as Text +import Skylighting.Types +import qualified System.Console.ANSI.Codes as ANSI + +formatANSI :: FormatOptions -> Style -> [SourceLine] -> Text +formatANSI opts sty = (beforeText <>) + . (<> afterText) + . Text.intercalate (Text.singleton '\n') + . zipWith (sourceLineToANSI opts sty) [startNum..] + where beforeText = ansiResetText <> ansiStyleText clv (defaultColor sty) (backgroundColor sty) False False False + afterText = ansiResetText + startNum = LineNo $ startNumber opts + clv = ansiColorLevel opts + +sourceLineToANSI :: FormatOptions -> Style -> LineNo -> SourceLine -> Text +sourceLineToANSI opts sty lno = prependLineNoText + . mconcat + . map (tokenToANSI clv sty) + where prependLineNoText = if numberLines opts + then (lineNoText <>) + else id + lineNoText = ansiStyleText clv lineNoFgc lineNoBgc False False False + <> Text.pack (show $ lineNo lno) + <> ansiStyleText clv (defaultColor sty) (backgroundColor sty) False False False + <> "\t" + lineNoFgc = lineNumberColor sty `mplus` defaultColor sty + lineNoBgc = lineNumberBackgroundColor sty `mplus` backgroundColor sty + clv = ansiColorLevel opts + +tokenToANSI :: ANSIColorLevel -> Style -> Token -> Text +tokenToANSI clv sty (tokTy, tokText) = ansiStyleText clv tokFgc tokBgc tokB tokI tokU + <> tokText + <> ansiStyleText clv (defaultColor sty) (backgroundColor sty) False False False + where TokenStyle tokFgcRaw tokBgcRaw tokB tokI tokU = fromMaybe defStyle . Map.lookup tokTy $ tokenStyles sty + tokFgc = tokFgcRaw `mplus` defaultColor sty + tokBgc = tokBgcRaw `mplus` backgroundColor sty + +ansiStyleText :: ANSIColorLevel -- ^ color support level + -> Maybe Color -- ^ foreground + -> Maybe Color -- ^ background + -> Bool -- ^ bold + -> Bool -- ^ italic + -> Bool -- ^ underlined + -> Text +ansiStyleText clv fgc bgc b i u = optReset <> sgrTextFg <> sgrTextBg + <> (Text.pack . ANSI.setSGRCode $ concat [sgrCodeFg, + sgrCodeBg, + sgrCodeBold, + sgrCodeItal, + sgrCodeUndl]) + -- FIXME: the @ansi-terminal@ library should do the 256-color parts more cleanly someday + where (sgrCodeFg, sgrTextFg) = case clv of + ANSITrueColor -> (maybeToList $ fmap (ANSI.SetRGBColor ANSI.Foreground . fromColor) fgc, "") + ANSI256Color -> ([], fromMaybe "" $ fmap (\c -> Text.pack $ ANSI.csi [38, 5, + fromIntegral . getXterm256ColorCode $ fromColor c] "m") fgc) + ANSI16Color -> (maybeToList $ fmap (uncurry (ANSI.SetColor ANSI.Foreground) . fromColor) fgc, "") + (sgrCodeBg, sgrTextBg) = case clv of + ANSITrueColor -> (maybeToList $ fmap (ANSI.SetRGBColor ANSI.Background . fromColor) bgc, "") + ANSI256Color -> ([], fromMaybe "" $ fmap (\c -> Text.pack $ ANSI.csi [48, 5, + fromIntegral . getXterm256ColorCode $ fromColor c] "m") bgc) + ANSI16Color -> (maybeToList $ fmap (uncurry (ANSI.SetColor ANSI.Background) . fromColor) bgc, "") + optReset = if isNothing fgc && isNothing bgc then ansiResetText else "" + sgrCodeBold = [ANSI.SetConsoleIntensity $ if b then ANSI.BoldIntensity else ANSI.NormalIntensity] + sgrCodeItal = [ANSI.SetItalicized i] -- FIXME: Not very widely supported in terminals + sgrCodeUndl = [ANSI.SetUnderlining $ if u then ANSI.SingleUnderline else ANSI.NoUnderline] + +ansiResetText :: Text +ansiResetText = Text.pack $ ANSI.setSGRCode [ANSI.Reset] diff --git a/src/Skylighting/Format/LaTeX.hs b/src/Skylighting/Format/LaTeX.hs --- a/src/Skylighting/Format/LaTeX.hs +++ b/src/Skylighting/Format/LaTeX.hs @@ -7,9 +7,9 @@ ) where import Control.Monad (mplus) -import qualified Data.Map as Map import Data.Char (isSpace) import Data.List (sort) +import qualified Data.Map as Map import Data.Monoid import Data.Text (Text) import qualified Data.Text as Text diff --git a/src/Skylighting/Parser.hs b/src/Skylighting/Parser.hs --- a/src/Skylighting/Parser.hs +++ b/src/Skylighting/Parser.hs @@ -6,7 +6,6 @@ import Data.ByteString.UTF8 (fromString) import Data.Char (isAlphaNum, toUpper) -import Data.List (nub) import qualified Data.Map as Map import Data.Maybe (fromMaybe) import qualified Data.Set as Set @@ -31,12 +30,20 @@ -- This is intended for sanity checks to avoid run-time -- errors. missingIncludes :: [Syntax] -> [(Text, Text)] -missingIncludes syns = nub +missingIncludes syns = ordNub [(sName s, lang) | s <- syns , c <- Map.elems (sContexts s) , IncludeRules (lang, _) <- map rMatcher (cRules c) - , lang `notElem` (map sName syns)] + , not (lang `Set.member` syntaxNames)] + where syntaxNames = Set.fromList $ map sName syns + +ordNub :: (Ord a) => [a] -> [a] +ordNub l = go Set.empty l + where + go _ [] = [] + go s (x:xs) = if x `Set.member` s then go s xs + else x : go (Set.insert x s) xs standardDelims :: Set.Set Char standardDelims = Set.fromList " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" diff --git a/src/Skylighting/Regex.hs b/src/Skylighting/Regex.hs --- a/src/Skylighting/Regex.hs +++ b/src/Skylighting/Regex.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} module Skylighting.Regex ( Regex @@ -13,18 +13,18 @@ ) where import qualified Control.Exception as E +import Data.Aeson +import Data.Binary (Binary) +import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Char8 as BS import Data.ByteString.UTF8 (toString) +import Data.Data +import qualified Data.Text as Text +import qualified Data.Text.Encoding as TE import GHC.Generics (Generic) import System.IO.Unsafe (unsafePerformIO) import Text.Printf import Text.Regex.PCRE.ByteString -import Data.Data -import Data.Binary (Binary) -import Data.Aeson -import qualified Data.Text as Text -import qualified Data.Text.Encoding as TE -import qualified Data.ByteString.Base64 as Base64 -- | An exception in compiling or executing a regex. newtype RegexException = RegexException String diff --git a/src/Skylighting/Styles.hs b/src/Skylighting/Styles.hs --- a/src/Skylighting/Styles.hs +++ b/src/Skylighting/Styles.hs @@ -9,9 +9,9 @@ , monochrome , zenburn) where -import qualified Data.Map as Map import Data.Aeson (eitherDecode) import Data.ByteString.Lazy (ByteString) +import qualified Data.Map as Map import Skylighting.Types -- | Parse a KDE theme JSON document into a skylighting Style. diff --git a/src/Skylighting/Syntax.hs b/src/Skylighting/Syntax.hs --- a/src/Skylighting/Syntax.hs +++ b/src/Skylighting/Syntax.hs @@ -132,127 +132,127 @@ -- | Default mapping from short names to syntax definitions. defaultSyntaxMap :: SyntaxMap defaultSyntaxMap = Map.fromList [ - ("ABC", Skylighting.Syntax.Abc.syntax) - , ("ActionScript 2.0", Skylighting.Syntax.Actionscript.syntax) - , ("Ada", Skylighting.Syntax.Ada.syntax) - , ("Agda", Skylighting.Syntax.Agda.syntax) - , ("Alerts", Skylighting.Syntax.Alert.syntax) - , ("Alerts_indent", Skylighting.Syntax.AlertIndent.syntax) - , ("Apache Configuration", Skylighting.Syntax.Apache.syntax) - , ("ASN.1", Skylighting.Syntax.Asn1.syntax) - , ("ASP", Skylighting.Syntax.Asp.syntax) - , ("ATS", Skylighting.Syntax.Ats.syntax) - , ("AWK", Skylighting.Syntax.Awk.syntax) - , ("Bash", Skylighting.Syntax.Bash.syntax) - , ("BibTeX", Skylighting.Syntax.Bibtex.syntax) - , ("Boo", Skylighting.Syntax.Boo.syntax) - , ("C", Skylighting.Syntax.C.syntax) - , ("ChangeLog", Skylighting.Syntax.Changelog.syntax) - , ("Clojure", Skylighting.Syntax.Clojure.syntax) - , ("CMake", Skylighting.Syntax.Cmake.syntax) - , ("CoffeeScript", Skylighting.Syntax.Coffee.syntax) - , ("ColdFusion", Skylighting.Syntax.Coldfusion.syntax) - , ("Common Lisp", Skylighting.Syntax.Commonlisp.syntax) - , ("C++", Skylighting.Syntax.Cpp.syntax) - , ("C#", Skylighting.Syntax.Cs.syntax) - , ("CSS", Skylighting.Syntax.Css.syntax) - , ("Curry", Skylighting.Syntax.Curry.syntax) - , ("D", Skylighting.Syntax.D.syntax) - , ("Diff", Skylighting.Syntax.Diff.syntax) - , ("Django HTML Template", Skylighting.Syntax.Djangotemplate.syntax) - , ("Dockerfile", Skylighting.Syntax.Dockerfile.syntax) - , ("dot", Skylighting.Syntax.Dot.syntax) - , ("Doxygen", Skylighting.Syntax.Doxygen.syntax) - , ("DoxygenLua", Skylighting.Syntax.Doxygenlua.syntax) - , ("DTD", Skylighting.Syntax.Dtd.syntax) - , ("Eiffel", Skylighting.Syntax.Eiffel.syntax) - , ("Elixir", Skylighting.Syntax.Elixir.syntax) - , ("Email", Skylighting.Syntax.Email.syntax) - , ("Erlang", Skylighting.Syntax.Erlang.syntax) - , ("Intel x86 (FASM)", Skylighting.Syntax.Fasm.syntax) - , ("Fortran", Skylighting.Syntax.Fortran.syntax) - , ("FSharp", Skylighting.Syntax.Fsharp.syntax) - , ("GCCExtensions", Skylighting.Syntax.Gcc.syntax) - , ("GLSL", Skylighting.Syntax.Glsl.syntax) - , ("GNU Assembler", Skylighting.Syntax.Gnuassembler.syntax) - , ("Go", Skylighting.Syntax.Go.syntax) - , ("Hamlet", Skylighting.Syntax.Hamlet.syntax) - , ("Haskell", Skylighting.Syntax.Haskell.syntax) - , ("Haxe", Skylighting.Syntax.Haxe.syntax) - , ("HTML", Skylighting.Syntax.Html.syntax) - , ("Idris", Skylighting.Syntax.Idris.syntax) - , ("INI Files", Skylighting.Syntax.Ini.syntax) - , ("ISO C++", Skylighting.Syntax.Isocpp.syntax) - , ("Java", Skylighting.Syntax.Java.syntax) - , ("Javadoc", Skylighting.Syntax.Javadoc.syntax) - , ("JavaScript", Skylighting.Syntax.Javascript.syntax) - , ("JSON", Skylighting.Syntax.Json.syntax) - , ("JSP", Skylighting.Syntax.Jsp.syntax) - , ("Julia", Skylighting.Syntax.Julia.syntax) - , ("Kotlin", Skylighting.Syntax.Kotlin.syntax) - , ("LaTeX", Skylighting.Syntax.Latex.syntax) - , ("Lex/Flex", Skylighting.Syntax.Lex.syntax) - , ("LilyPond", Skylighting.Syntax.Lilypond.syntax) - , ("Literate Curry", Skylighting.Syntax.LiterateCurry.syntax) - , ("Literate Haskell", Skylighting.Syntax.LiterateHaskell.syntax) - , ("LLVM", Skylighting.Syntax.Llvm.syntax) - , ("Lua", Skylighting.Syntax.Lua.syntax) - , ("GNU M4", Skylighting.Syntax.M4.syntax) - , ("Makefile", Skylighting.Syntax.Makefile.syntax) - , ("Troff Mandoc", Skylighting.Syntax.Mandoc.syntax) - , ("Markdown", Skylighting.Syntax.Markdown.syntax) - , ("Mathematica", Skylighting.Syntax.Mathematica.syntax) - , ("Matlab", Skylighting.Syntax.Matlab.syntax) - , ("Maxima", Skylighting.Syntax.Maxima.syntax) - , ("MediaWiki", Skylighting.Syntax.Mediawiki.syntax) - , ("Metapost/Metafont", Skylighting.Syntax.Metafont.syntax) - , ("MIPS Assembler", Skylighting.Syntax.Mips.syntax) - , ("Modelines", Skylighting.Syntax.Modelines.syntax) - , ("Modula-2", Skylighting.Syntax.Modula2.syntax) - , ("Modula-3", Skylighting.Syntax.Modula3.syntax) - , ("MonoBasic", Skylighting.Syntax.Monobasic.syntax) - , ("Intel x86 (NASM)", Skylighting.Syntax.Nasm.syntax) - , ("noweb", Skylighting.Syntax.Noweb.syntax) - , ("Objective-C", Skylighting.Syntax.Objectivec.syntax) - , ("Objective-C++", Skylighting.Syntax.Objectivecpp.syntax) - , ("Objective Caml", Skylighting.Syntax.Ocaml.syntax) - , ("Octave", Skylighting.Syntax.Octave.syntax) - , ("OpenCL", Skylighting.Syntax.Opencl.syntax) - , ("Pascal", Skylighting.Syntax.Pascal.syntax) - , ("Perl", Skylighting.Syntax.Perl.syntax) - , ("PHP/PHP", Skylighting.Syntax.Php.syntax) - , ("Pike", Skylighting.Syntax.Pike.syntax) - , ("PostScript", Skylighting.Syntax.Postscript.syntax) - , ("PowerShell", Skylighting.Syntax.Powershell.syntax) - , ("Prolog", Skylighting.Syntax.Prolog.syntax) - , ("Pure", Skylighting.Syntax.Pure.syntax) - , ("PureBasic", Skylighting.Syntax.Purebasic.syntax) - , ("Python", Skylighting.Syntax.Python.syntax) - , ("R Script", Skylighting.Syntax.R.syntax) - , ("RELAX NG", Skylighting.Syntax.Relaxng.syntax) - , ("RelaxNG-Compact", Skylighting.Syntax.Relaxngcompact.syntax) - , ("reStructuredText", Skylighting.Syntax.Rest.syntax) - , ("Ruby/Rails/RHTML", Skylighting.Syntax.Rhtml.syntax) - , ("Roff", Skylighting.Syntax.Roff.syntax) - , ("Ruby", Skylighting.Syntax.Ruby.syntax) - , ("Rust", Skylighting.Syntax.Rust.syntax) - , ("Scala", Skylighting.Syntax.Scala.syntax) - , ("Scheme", Skylighting.Syntax.Scheme.syntax) - , ("scilab", Skylighting.Syntax.Sci.syntax) - , ("sed", Skylighting.Syntax.Sed.syntax) - , ("SGML", Skylighting.Syntax.Sgml.syntax) - , ("SQL (MySQL)", Skylighting.Syntax.SqlMysql.syntax) - , ("SQL (PostgreSQL)", Skylighting.Syntax.SqlPostgresql.syntax) - , ("SQL", Skylighting.Syntax.Sql.syntax) - , ("Tcl/Tk", Skylighting.Syntax.Tcl.syntax) - , ("Tcsh", Skylighting.Syntax.Tcsh.syntax) - , ("Texinfo", Skylighting.Syntax.Texinfo.syntax) - , ("Verilog", Skylighting.Syntax.Verilog.syntax) - , ("VHDL", Skylighting.Syntax.Vhdl.syntax) - , ("XML", Skylighting.Syntax.Xml.syntax) - , ("x.org Configuration", Skylighting.Syntax.Xorg.syntax) - , ("xslt", Skylighting.Syntax.Xslt.syntax) - , ("XUL", Skylighting.Syntax.Xul.syntax) - , ("Yacc/Bison", Skylighting.Syntax.Yacc.syntax) - , ("YAML", Skylighting.Syntax.Yaml.syntax) - , ("Zsh", Skylighting.Syntax.Zsh.syntax) ] + ("ABC", Skylighting.Syntax.Abc.syntax `seq` Skylighting.Syntax.Abc.syntax) + , ("ActionScript 2.0", Skylighting.Syntax.Actionscript.syntax `seq` Skylighting.Syntax.Actionscript.syntax) + , ("Ada", Skylighting.Syntax.Ada.syntax `seq` Skylighting.Syntax.Ada.syntax) + , ("Agda", Skylighting.Syntax.Agda.syntax `seq` Skylighting.Syntax.Agda.syntax) + , ("Alerts", Skylighting.Syntax.Alert.syntax `seq` Skylighting.Syntax.Alert.syntax) + , ("Alerts_indent", Skylighting.Syntax.AlertIndent.syntax `seq` Skylighting.Syntax.AlertIndent.syntax) + , ("Apache Configuration", Skylighting.Syntax.Apache.syntax `seq` Skylighting.Syntax.Apache.syntax) + , ("ASN.1", Skylighting.Syntax.Asn1.syntax `seq` Skylighting.Syntax.Asn1.syntax) + , ("ASP", Skylighting.Syntax.Asp.syntax `seq` Skylighting.Syntax.Asp.syntax) + , ("ATS", Skylighting.Syntax.Ats.syntax `seq` Skylighting.Syntax.Ats.syntax) + , ("AWK", Skylighting.Syntax.Awk.syntax `seq` Skylighting.Syntax.Awk.syntax) + , ("Bash", Skylighting.Syntax.Bash.syntax `seq` Skylighting.Syntax.Bash.syntax) + , ("BibTeX", Skylighting.Syntax.Bibtex.syntax `seq` Skylighting.Syntax.Bibtex.syntax) + , ("Boo", Skylighting.Syntax.Boo.syntax `seq` Skylighting.Syntax.Boo.syntax) + , ("C", Skylighting.Syntax.C.syntax `seq` Skylighting.Syntax.C.syntax) + , ("ChangeLog", Skylighting.Syntax.Changelog.syntax `seq` Skylighting.Syntax.Changelog.syntax) + , ("Clojure", Skylighting.Syntax.Clojure.syntax `seq` Skylighting.Syntax.Clojure.syntax) + , ("CMake", Skylighting.Syntax.Cmake.syntax `seq` Skylighting.Syntax.Cmake.syntax) + , ("CoffeeScript", Skylighting.Syntax.Coffee.syntax `seq` Skylighting.Syntax.Coffee.syntax) + , ("ColdFusion", Skylighting.Syntax.Coldfusion.syntax `seq` Skylighting.Syntax.Coldfusion.syntax) + , ("Common Lisp", Skylighting.Syntax.Commonlisp.syntax `seq` Skylighting.Syntax.Commonlisp.syntax) + , ("C++", Skylighting.Syntax.Cpp.syntax `seq` Skylighting.Syntax.Cpp.syntax) + , ("C#", Skylighting.Syntax.Cs.syntax `seq` Skylighting.Syntax.Cs.syntax) + , ("CSS", Skylighting.Syntax.Css.syntax `seq` Skylighting.Syntax.Css.syntax) + , ("Curry", Skylighting.Syntax.Curry.syntax `seq` Skylighting.Syntax.Curry.syntax) + , ("D", Skylighting.Syntax.D.syntax `seq` Skylighting.Syntax.D.syntax) + , ("Diff", Skylighting.Syntax.Diff.syntax `seq` Skylighting.Syntax.Diff.syntax) + , ("Django HTML Template", Skylighting.Syntax.Djangotemplate.syntax `seq` Skylighting.Syntax.Djangotemplate.syntax) + , ("Dockerfile", Skylighting.Syntax.Dockerfile.syntax `seq` Skylighting.Syntax.Dockerfile.syntax) + , ("dot", Skylighting.Syntax.Dot.syntax `seq` Skylighting.Syntax.Dot.syntax) + , ("Doxygen", Skylighting.Syntax.Doxygen.syntax `seq` Skylighting.Syntax.Doxygen.syntax) + , ("DoxygenLua", Skylighting.Syntax.Doxygenlua.syntax `seq` Skylighting.Syntax.Doxygenlua.syntax) + , ("DTD", Skylighting.Syntax.Dtd.syntax `seq` Skylighting.Syntax.Dtd.syntax) + , ("Eiffel", Skylighting.Syntax.Eiffel.syntax `seq` Skylighting.Syntax.Eiffel.syntax) + , ("Elixir", Skylighting.Syntax.Elixir.syntax `seq` Skylighting.Syntax.Elixir.syntax) + , ("Email", Skylighting.Syntax.Email.syntax `seq` Skylighting.Syntax.Email.syntax) + , ("Erlang", Skylighting.Syntax.Erlang.syntax `seq` Skylighting.Syntax.Erlang.syntax) + , ("Intel x86 (FASM)", Skylighting.Syntax.Fasm.syntax `seq` Skylighting.Syntax.Fasm.syntax) + , ("Fortran", Skylighting.Syntax.Fortran.syntax `seq` Skylighting.Syntax.Fortran.syntax) + , ("FSharp", Skylighting.Syntax.Fsharp.syntax `seq` Skylighting.Syntax.Fsharp.syntax) + , ("GCCExtensions", Skylighting.Syntax.Gcc.syntax `seq` Skylighting.Syntax.Gcc.syntax) + , ("GLSL", Skylighting.Syntax.Glsl.syntax `seq` Skylighting.Syntax.Glsl.syntax) + , ("GNU Assembler", Skylighting.Syntax.Gnuassembler.syntax `seq` Skylighting.Syntax.Gnuassembler.syntax) + , ("Go", Skylighting.Syntax.Go.syntax `seq` Skylighting.Syntax.Go.syntax) + , ("Hamlet", Skylighting.Syntax.Hamlet.syntax `seq` Skylighting.Syntax.Hamlet.syntax) + , ("Haskell", Skylighting.Syntax.Haskell.syntax `seq` Skylighting.Syntax.Haskell.syntax) + , ("Haxe", Skylighting.Syntax.Haxe.syntax `seq` Skylighting.Syntax.Haxe.syntax) + , ("HTML", Skylighting.Syntax.Html.syntax `seq` Skylighting.Syntax.Html.syntax) + , ("Idris", Skylighting.Syntax.Idris.syntax `seq` Skylighting.Syntax.Idris.syntax) + , ("INI Files", Skylighting.Syntax.Ini.syntax `seq` Skylighting.Syntax.Ini.syntax) + , ("ISO C++", Skylighting.Syntax.Isocpp.syntax `seq` Skylighting.Syntax.Isocpp.syntax) + , ("Java", Skylighting.Syntax.Java.syntax `seq` Skylighting.Syntax.Java.syntax) + , ("Javadoc", Skylighting.Syntax.Javadoc.syntax `seq` Skylighting.Syntax.Javadoc.syntax) + , ("JavaScript", Skylighting.Syntax.Javascript.syntax `seq` Skylighting.Syntax.Javascript.syntax) + , ("JSON", Skylighting.Syntax.Json.syntax `seq` Skylighting.Syntax.Json.syntax) + , ("JSP", Skylighting.Syntax.Jsp.syntax `seq` Skylighting.Syntax.Jsp.syntax) + , ("Julia", Skylighting.Syntax.Julia.syntax `seq` Skylighting.Syntax.Julia.syntax) + , ("Kotlin", Skylighting.Syntax.Kotlin.syntax `seq` Skylighting.Syntax.Kotlin.syntax) + , ("LaTeX", Skylighting.Syntax.Latex.syntax `seq` Skylighting.Syntax.Latex.syntax) + , ("Lex/Flex", Skylighting.Syntax.Lex.syntax `seq` Skylighting.Syntax.Lex.syntax) + , ("LilyPond", Skylighting.Syntax.Lilypond.syntax `seq` Skylighting.Syntax.Lilypond.syntax) + , ("Literate Curry", Skylighting.Syntax.LiterateCurry.syntax `seq` Skylighting.Syntax.LiterateCurry.syntax) + , ("Literate Haskell", Skylighting.Syntax.LiterateHaskell.syntax `seq` Skylighting.Syntax.LiterateHaskell.syntax) + , ("LLVM", Skylighting.Syntax.Llvm.syntax `seq` Skylighting.Syntax.Llvm.syntax) + , ("Lua", Skylighting.Syntax.Lua.syntax `seq` Skylighting.Syntax.Lua.syntax) + , ("GNU M4", Skylighting.Syntax.M4.syntax `seq` Skylighting.Syntax.M4.syntax) + , ("Makefile", Skylighting.Syntax.Makefile.syntax `seq` Skylighting.Syntax.Makefile.syntax) + , ("Troff Mandoc", Skylighting.Syntax.Mandoc.syntax `seq` Skylighting.Syntax.Mandoc.syntax) + , ("Markdown", Skylighting.Syntax.Markdown.syntax `seq` Skylighting.Syntax.Markdown.syntax) + , ("Mathematica", Skylighting.Syntax.Mathematica.syntax `seq` Skylighting.Syntax.Mathematica.syntax) + , ("Matlab", Skylighting.Syntax.Matlab.syntax `seq` Skylighting.Syntax.Matlab.syntax) + , ("Maxima", Skylighting.Syntax.Maxima.syntax `seq` Skylighting.Syntax.Maxima.syntax) + , ("MediaWiki", Skylighting.Syntax.Mediawiki.syntax `seq` Skylighting.Syntax.Mediawiki.syntax) + , ("Metapost/Metafont", Skylighting.Syntax.Metafont.syntax `seq` Skylighting.Syntax.Metafont.syntax) + , ("MIPS Assembler", Skylighting.Syntax.Mips.syntax `seq` Skylighting.Syntax.Mips.syntax) + , ("Modelines", Skylighting.Syntax.Modelines.syntax `seq` Skylighting.Syntax.Modelines.syntax) + , ("Modula-2", Skylighting.Syntax.Modula2.syntax `seq` Skylighting.Syntax.Modula2.syntax) + , ("Modula-3", Skylighting.Syntax.Modula3.syntax `seq` Skylighting.Syntax.Modula3.syntax) + , ("MonoBasic", Skylighting.Syntax.Monobasic.syntax `seq` Skylighting.Syntax.Monobasic.syntax) + , ("Intel x86 (NASM)", Skylighting.Syntax.Nasm.syntax `seq` Skylighting.Syntax.Nasm.syntax) + , ("noweb", Skylighting.Syntax.Noweb.syntax `seq` Skylighting.Syntax.Noweb.syntax) + , ("Objective-C", Skylighting.Syntax.Objectivec.syntax `seq` Skylighting.Syntax.Objectivec.syntax) + , ("Objective-C++", Skylighting.Syntax.Objectivecpp.syntax `seq` Skylighting.Syntax.Objectivecpp.syntax) + , ("Objective Caml", Skylighting.Syntax.Ocaml.syntax `seq` Skylighting.Syntax.Ocaml.syntax) + , ("Octave", Skylighting.Syntax.Octave.syntax `seq` Skylighting.Syntax.Octave.syntax) + , ("OpenCL", Skylighting.Syntax.Opencl.syntax `seq` Skylighting.Syntax.Opencl.syntax) + , ("Pascal", Skylighting.Syntax.Pascal.syntax `seq` Skylighting.Syntax.Pascal.syntax) + , ("Perl", Skylighting.Syntax.Perl.syntax `seq` Skylighting.Syntax.Perl.syntax) + , ("PHP/PHP", Skylighting.Syntax.Php.syntax `seq` Skylighting.Syntax.Php.syntax) + , ("Pike", Skylighting.Syntax.Pike.syntax `seq` Skylighting.Syntax.Pike.syntax) + , ("PostScript", Skylighting.Syntax.Postscript.syntax `seq` Skylighting.Syntax.Postscript.syntax) + , ("PowerShell", Skylighting.Syntax.Powershell.syntax `seq` Skylighting.Syntax.Powershell.syntax) + , ("Prolog", Skylighting.Syntax.Prolog.syntax `seq` Skylighting.Syntax.Prolog.syntax) + , ("Pure", Skylighting.Syntax.Pure.syntax `seq` Skylighting.Syntax.Pure.syntax) + , ("PureBasic", Skylighting.Syntax.Purebasic.syntax `seq` Skylighting.Syntax.Purebasic.syntax) + , ("Python", Skylighting.Syntax.Python.syntax `seq` Skylighting.Syntax.Python.syntax) + , ("R Script", Skylighting.Syntax.R.syntax `seq` Skylighting.Syntax.R.syntax) + , ("RELAX NG", Skylighting.Syntax.Relaxng.syntax `seq` Skylighting.Syntax.Relaxng.syntax) + , ("RelaxNG-Compact", Skylighting.Syntax.Relaxngcompact.syntax `seq` Skylighting.Syntax.Relaxngcompact.syntax) + , ("reStructuredText", Skylighting.Syntax.Rest.syntax `seq` Skylighting.Syntax.Rest.syntax) + , ("Ruby/Rails/RHTML", Skylighting.Syntax.Rhtml.syntax `seq` Skylighting.Syntax.Rhtml.syntax) + , ("Roff", Skylighting.Syntax.Roff.syntax `seq` Skylighting.Syntax.Roff.syntax) + , ("Ruby", Skylighting.Syntax.Ruby.syntax `seq` Skylighting.Syntax.Ruby.syntax) + , ("Rust", Skylighting.Syntax.Rust.syntax `seq` Skylighting.Syntax.Rust.syntax) + , ("Scala", Skylighting.Syntax.Scala.syntax `seq` Skylighting.Syntax.Scala.syntax) + , ("Scheme", Skylighting.Syntax.Scheme.syntax `seq` Skylighting.Syntax.Scheme.syntax) + , ("scilab", Skylighting.Syntax.Sci.syntax `seq` Skylighting.Syntax.Sci.syntax) + , ("sed", Skylighting.Syntax.Sed.syntax `seq` Skylighting.Syntax.Sed.syntax) + , ("SGML", Skylighting.Syntax.Sgml.syntax `seq` Skylighting.Syntax.Sgml.syntax) + , ("SQL (MySQL)", Skylighting.Syntax.SqlMysql.syntax `seq` Skylighting.Syntax.SqlMysql.syntax) + , ("SQL (PostgreSQL)", Skylighting.Syntax.SqlPostgresql.syntax `seq` Skylighting.Syntax.SqlPostgresql.syntax) + , ("SQL", Skylighting.Syntax.Sql.syntax `seq` Skylighting.Syntax.Sql.syntax) + , ("Tcl/Tk", Skylighting.Syntax.Tcl.syntax `seq` Skylighting.Syntax.Tcl.syntax) + , ("Tcsh", Skylighting.Syntax.Tcsh.syntax `seq` Skylighting.Syntax.Tcsh.syntax) + , ("Texinfo", Skylighting.Syntax.Texinfo.syntax `seq` Skylighting.Syntax.Texinfo.syntax) + , ("Verilog", Skylighting.Syntax.Verilog.syntax `seq` Skylighting.Syntax.Verilog.syntax) + , ("VHDL", Skylighting.Syntax.Vhdl.syntax `seq` Skylighting.Syntax.Vhdl.syntax) + , ("XML", Skylighting.Syntax.Xml.syntax `seq` Skylighting.Syntax.Xml.syntax) + , ("x.org Configuration", Skylighting.Syntax.Xorg.syntax `seq` Skylighting.Syntax.Xorg.syntax) + , ("xslt", Skylighting.Syntax.Xslt.syntax `seq` Skylighting.Syntax.Xslt.syntax) + , ("XUL", Skylighting.Syntax.Xul.syntax `seq` Skylighting.Syntax.Xul.syntax) + , ("Yacc/Bison", Skylighting.Syntax.Yacc.syntax `seq` Skylighting.Syntax.Yacc.syntax) + , ("YAML", Skylighting.Syntax.Yaml.syntax `seq` Skylighting.Syntax.Yaml.syntax) + , ("Zsh", Skylighting.Syntax.Zsh.syntax `seq` Skylighting.Syntax.Zsh.syntax) ] diff --git a/src/Skylighting/Tokenizer.hs b/src/Skylighting/Tokenizer.hs --- a/src/Skylighting/Tokenizer.hs +++ b/src/Skylighting/Tokenizer.hs @@ -1,10 +1,10 @@ {-# OPTIONS_GHC -fno-warn-missing-methods #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeSynonymInstances #-} module Skylighting.Tokenizer ( tokenize , TokenizerConfig(..) @@ -14,19 +14,19 @@ import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State.Strict -import qualified Data.ByteString.Char8 as BS -import qualified Data.Map as Map +import qualified Data.Attoparsec.ByteString.Char8 as A import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.UTF8 as UTF8 import Data.CaseInsensitive (mk) -import Data.Char (isAlphaNum, isAscii, isLetter, isSpace, ord, isPrint) +import Data.Char (isAlphaNum, isAscii, isLetter, isPrint, isSpace, ord) +import qualified Data.Map as Map import Data.Maybe (catMaybes) import Data.Monoid import qualified Data.Set as Set import Data.Text (Text) 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 @@ -123,7 +123,7 @@ throwError e = TM (\_ s -> (s, Error e)) catchError (TM x) f = TM (\c s -> case x c s of (_, Error e) -> let TM y = f e in y c s - z -> z) + z -> z) -- | Tokenize some text using 'Syntax'. tokenize :: TokenizerConfig -> Syntax -> Text -> Either String [SourceLine] @@ -400,14 +400,14 @@ case Map.lookup syn syntaxes >>= lookupContext con of Nothing -> do cur <- currentContext - throwError $ Text.unpack (cSyntax cur) ++ - " tokenizer requires undefined context " ++ + throwError $ "IncludeRules in " ++ Text.unpack (cSyntax cur) ++ + " requires undefined context " ++ Text.unpack con ++ "##" ++ Text.unpack syn Just c -> do mbtok <- msum (map (\r -> tryRule r inp) (cRules c)) return $ case (mbtok, mbattr) of (Just (NormalTok, xs), Just attr) -> Just (attr, xs) - _ -> mbtok + _ -> mbtok checkLineEnd :: Context -> TokenizerM () checkLineEnd c = do @@ -605,7 +605,7 @@ parseCStringChar :: ByteString -> TokenizerM Text parseCStringChar inp = do case A.parseOnly (A.match pCStringChar) inp of - Left _ -> mzero + Left _ -> mzero Right (r,_) -> takeChars (BS.length r) -- assumes ascii pCStringChar :: A.Parser () @@ -621,7 +621,7 @@ parseCChar :: ByteString -> TokenizerM Text parseCChar inp = do case A.parseOnly (A.match pCChar) inp of - Left _ -> mzero + Left _ -> mzero Right (r,_) -> takeChars (BS.length r) -- assumes ascii pCChar :: A.Parser () @@ -634,7 +634,7 @@ parseInt inp = do wordBoundary inp case A.parseOnly (A.match (pHex <|> pOct <|> pDec)) inp of - Left _ -> mzero + Left _ -> mzero Right (r,_) -> takeChars (BS.length r) -- assumes ascii pDec :: A.Parser () @@ -647,7 +647,7 @@ parseOct inp = do wordBoundary inp case A.parseOnly (A.match pHex) inp of - Left _ -> mzero + Left _ -> mzero Right (r,_) -> takeChars (BS.length r) -- assumes ascii pOct :: A.Parser () @@ -662,7 +662,7 @@ parseHex inp = do wordBoundary inp case A.parseOnly (A.match pHex) inp of - Left _ -> mzero + Left _ -> mzero Right (r,_) -> takeChars (BS.length r) -- assumes ascii pHex :: A.Parser () @@ -677,7 +677,7 @@ guardWordBoundary = do mbw <- A.peekChar case mbw of - Just c -> guard $ isWordBoundary '0' c + Just c -> guard $ isWordBoundary '0' c Nothing -> return () mbMinus :: A.Parser () @@ -690,7 +690,7 @@ parseFloat inp = do wordBoundary inp case A.parseOnly (A.match pFloat) inp of - Left _ -> mzero + Left _ -> mzero Right (r,_) -> takeChars (BS.length r) -- assumes all ascii where pFloat :: A.Parser () pFloat = do @@ -703,8 +703,8 @@ mbPlusMinus >> digits) mbnext <- A.peekChar case mbnext of - Nothing -> return () - Just c -> guard (not $ A.inClass "." c) + 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 diff --git a/src/Skylighting/Types.hs b/src/Skylighting/Types.hs --- a/src/Skylighting/Types.hs +++ b/src/Skylighting/Types.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeSynonymInstances #-} -- | Basic types for Skylighting. module Skylighting.Types ( @@ -32,28 +32,36 @@ , ToColor(..) , FromColor(..) , Style(..) + , ANSIColorLevel(..) + , Xterm256ColorCode(..) -- * Format options , FormatOptions(..) , defaultFormatOpts ) where import Control.Monad (mplus) -import Data.Aeson.Types (toJSONKeyText) import Data.Aeson -import Data.Bits -import Data.CaseInsensitive (FoldCase(..)) +import Data.Aeson.Types (toJSONKeyText) import Data.Binary (Binary) +import Data.Bits +import Data.CaseInsensitive (FoldCase (..)) +import Data.Colour.SRGB (Colour, sRGB24, toSRGB24) +import qualified Data.Colour.SRGB as Colour import Data.Data (Data) -import Data.Maybe (fromMaybe) +import Data.Int +import Data.List (minimumBy) import qualified Data.Map as Map +import Data.Maybe (fromMaybe) +import Data.Ord (comparing) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as Text import Data.Typeable (Typeable) -import GHC.Generics (Generic) import Data.Word +import GHC.Generics (Generic) import Safe (readMay) import Skylighting.Regex +import qualified System.Console.ANSI.Types as ANSI import Text.Printf -- | Full name of a context: the first member of the pair is the full @@ -84,7 +92,7 @@ -- | Test for membership in a 'WordSet'. inWordSet :: (FoldCase a, Ord a) => a -> WordSet a -> Bool inWordSet w (CaseInsensitiveWords ws) = foldCase w `Set.member` ws -inWordSet w (CaseSensitiveWords ws) = w `Set.member` ws +inWordSet w (CaseSensitiveWords ws) = w `Set.member` ws -- | Matchers correspond to the element types in a context. data Matcher = @@ -314,6 +322,300 @@ Just $ RGB (floor $ r * 255) (floor $ g * 255) (floor $ b * 255) toColor _ = Nothing +instance (RealFrac a, Floating a) => ToColor (Colour a) where + toColor c = let (Colour.RGB r g b) = toSRGB24 c in toColor (r, g, b) + +instance ToColor (ANSI.ColorIntensity, ANSI.Color) where + toColor = flip lookup ansi16ColorList -- cannot actually fail + +-- | Standard values taken from https://jonasjacek.github.io/colors/ +ansi16ColorList :: [((ANSI.ColorIntensity, ANSI.Color), Color)] +ansi16ColorList = [ ((ANSI.Dull , ANSI.Black ), RGB 0 0 0 ) + , ((ANSI.Dull , ANSI.Red ), RGB 128 0 0 ) + , ((ANSI.Dull , ANSI.Green ), RGB 0 128 0 ) + , ((ANSI.Dull , ANSI.Yellow ), RGB 128 128 0 ) + , ((ANSI.Dull , ANSI.Blue ), RGB 0 0 128) + , ((ANSI.Dull , ANSI.Magenta), RGB 128 0 128) + , ((ANSI.Dull , ANSI.Cyan ), RGB 0 128 128) + , ((ANSI.Dull , ANSI.White ), RGB 192 192 192) + , ((ANSI.Vivid, ANSI.Black ), RGB 128 128 128) + , ((ANSI.Vivid, ANSI.Red ), RGB 255 0 0 ) + , ((ANSI.Vivid, ANSI.Green ), RGB 0 255 0 ) + , ((ANSI.Vivid, ANSI.Yellow ), RGB 255 255 0 ) + , ((ANSI.Vivid, ANSI.Blue ), RGB 0 0 255) + , ((ANSI.Vivid, ANSI.Magenta), RGB 255 0 255) + , ((ANSI.Vivid, ANSI.Cyan ), RGB 0 255 255) + , ((ANSI.Vivid, ANSI.White ), RGB 255 255 255) + ] + +newtype Xterm256ColorCode = Xterm256ColorCode { getXterm256ColorCode :: Word8 } + deriving (Show, Read, Eq, Ord, Enum, Bounded, Data, Typeable, Generic) + +instance Binary Xterm256ColorCode + +-- | Converted from https://jonasjacek.github.io/colors/data.json, then slightly rearranged +ansi256ColorList :: [(Xterm256ColorCode, Color)] +ansi256ColorList = [ (Xterm256ColorCode 232, RGB 8 8 8) -- grayscale colors + , (Xterm256ColorCode 233, RGB 18 18 18) + , (Xterm256ColorCode 234, RGB 28 28 28) + , (Xterm256ColorCode 235, RGB 38 38 38) + , (Xterm256ColorCode 236, RGB 48 48 48) + , (Xterm256ColorCode 237, RGB 58 58 58) + , (Xterm256ColorCode 238, RGB 68 68 68) + , (Xterm256ColorCode 239, RGB 78 78 78) + , (Xterm256ColorCode 240, RGB 88 88 88) + , (Xterm256ColorCode 241, RGB 98 98 98) + , (Xterm256ColorCode 242, RGB 108 108 108) + , (Xterm256ColorCode 243, RGB 118 118 118) + , (Xterm256ColorCode 244, RGB 128 128 128) + , (Xterm256ColorCode 245, RGB 138 138 138) + , (Xterm256ColorCode 246, RGB 148 148 148) + , (Xterm256ColorCode 247, RGB 158 158 158) + , (Xterm256ColorCode 248, RGB 168 168 168) + , (Xterm256ColorCode 249, RGB 178 178 178) + , (Xterm256ColorCode 250, RGB 188 188 188) + , (Xterm256ColorCode 251, RGB 198 198 198) + , (Xterm256ColorCode 252, RGB 208 208 208) + , (Xterm256ColorCode 253, RGB 218 218 218) + , (Xterm256ColorCode 254, RGB 228 228 228) + , (Xterm256ColorCode 255, RGB 238 238 238) + , (Xterm256ColorCode 16, RGB 0 0 0) -- RGB cube colors + , (Xterm256ColorCode 17, RGB 0 0 95) + , (Xterm256ColorCode 18, RGB 0 0 135) + , (Xterm256ColorCode 19, RGB 0 0 175) + , (Xterm256ColorCode 20, RGB 0 0 215) + , (Xterm256ColorCode 21, RGB 0 0 255) + , (Xterm256ColorCode 22, RGB 0 95 0) + , (Xterm256ColorCode 23, RGB 0 95 95) + , (Xterm256ColorCode 24, RGB 0 95 135) + , (Xterm256ColorCode 25, RGB 0 95 175) + , (Xterm256ColorCode 26, RGB 0 95 215) + , (Xterm256ColorCode 27, RGB 0 95 255) + , (Xterm256ColorCode 28, RGB 0 135 0) + , (Xterm256ColorCode 29, RGB 0 135 95) + , (Xterm256ColorCode 30, RGB 0 135 135) + , (Xterm256ColorCode 31, RGB 0 135 175) + , (Xterm256ColorCode 32, RGB 0 135 215) + , (Xterm256ColorCode 33, RGB 0 135 255) + , (Xterm256ColorCode 34, RGB 0 175 0) + , (Xterm256ColorCode 35, RGB 0 175 95) + , (Xterm256ColorCode 36, RGB 0 175 135) + , (Xterm256ColorCode 37, RGB 0 175 175) + , (Xterm256ColorCode 38, RGB 0 175 215) + , (Xterm256ColorCode 39, RGB 0 175 255) + , (Xterm256ColorCode 40, RGB 0 215 0) + , (Xterm256ColorCode 41, RGB 0 215 95) + , (Xterm256ColorCode 42, RGB 0 215 135) + , (Xterm256ColorCode 43, RGB 0 215 175) + , (Xterm256ColorCode 44, RGB 0 215 215) + , (Xterm256ColorCode 45, RGB 0 215 255) + , (Xterm256ColorCode 46, RGB 0 255 0) + , (Xterm256ColorCode 47, RGB 0 255 95) + , (Xterm256ColorCode 48, RGB 0 255 135) + , (Xterm256ColorCode 49, RGB 0 255 175) + , (Xterm256ColorCode 50, RGB 0 255 215) + , (Xterm256ColorCode 51, RGB 0 255 255) + , (Xterm256ColorCode 52, RGB 95 0 0) + , (Xterm256ColorCode 53, RGB 95 0 95) + , (Xterm256ColorCode 54, RGB 95 0 135) + , (Xterm256ColorCode 55, RGB 95 0 175) + , (Xterm256ColorCode 56, RGB 95 0 215) + , (Xterm256ColorCode 57, RGB 95 0 255) + , (Xterm256ColorCode 58, RGB 95 95 0) + , (Xterm256ColorCode 59, RGB 95 95 95) + , (Xterm256ColorCode 60, RGB 95 95 135) + , (Xterm256ColorCode 61, RGB 95 95 175) + , (Xterm256ColorCode 62, RGB 95 95 215) + , (Xterm256ColorCode 63, RGB 95 95 255) + , (Xterm256ColorCode 64, RGB 95 135 0) + , (Xterm256ColorCode 65, RGB 95 135 95) + , (Xterm256ColorCode 66, RGB 95 135 135) + , (Xterm256ColorCode 67, RGB 95 135 175) + , (Xterm256ColorCode 68, RGB 95 135 215) + , (Xterm256ColorCode 69, RGB 95 135 255) + , (Xterm256ColorCode 70, RGB 95 175 0) + , (Xterm256ColorCode 71, RGB 95 175 95) + , (Xterm256ColorCode 72, RGB 95 175 135) + , (Xterm256ColorCode 73, RGB 95 175 175) + , (Xterm256ColorCode 74, RGB 95 175 215) + , (Xterm256ColorCode 75, RGB 95 175 255) + , (Xterm256ColorCode 76, RGB 95 215 0) + , (Xterm256ColorCode 77, RGB 95 215 95) + , (Xterm256ColorCode 78, RGB 95 215 135) + , (Xterm256ColorCode 79, RGB 95 215 175) + , (Xterm256ColorCode 80, RGB 95 215 215) + , (Xterm256ColorCode 81, RGB 95 215 255) + , (Xterm256ColorCode 82, RGB 95 255 0) + , (Xterm256ColorCode 83, RGB 95 255 95) + , (Xterm256ColorCode 84, RGB 95 255 135) + , (Xterm256ColorCode 85, RGB 95 255 175) + , (Xterm256ColorCode 86, RGB 95 255 215) + , (Xterm256ColorCode 87, RGB 95 255 255) + , (Xterm256ColorCode 88, RGB 135 0 0) + , (Xterm256ColorCode 89, RGB 135 0 95) + , (Xterm256ColorCode 90, RGB 135 0 135) + , (Xterm256ColorCode 91, RGB 135 0 175) + , (Xterm256ColorCode 92, RGB 135 0 215) + , (Xterm256ColorCode 93, RGB 135 0 255) + , (Xterm256ColorCode 94, RGB 135 95 0) + , (Xterm256ColorCode 95, RGB 135 95 95) + , (Xterm256ColorCode 96, RGB 135 95 135) + , (Xterm256ColorCode 97, RGB 135 95 175) + , (Xterm256ColorCode 98, RGB 135 95 215) + , (Xterm256ColorCode 99, RGB 135 95 255) + , (Xterm256ColorCode 100, RGB 135 135 0) + , (Xterm256ColorCode 101, RGB 135 135 95) + , (Xterm256ColorCode 102, RGB 135 135 135) + , (Xterm256ColorCode 103, RGB 135 135 175) + , (Xterm256ColorCode 104, RGB 135 135 215) + , (Xterm256ColorCode 105, RGB 135 135 255) + , (Xterm256ColorCode 106, RGB 135 175 0) + , (Xterm256ColorCode 107, RGB 135 175 95) + , (Xterm256ColorCode 108, RGB 135 175 135) + , (Xterm256ColorCode 109, RGB 135 175 175) + , (Xterm256ColorCode 110, RGB 135 175 215) + , (Xterm256ColorCode 111, RGB 135 175 255) + , (Xterm256ColorCode 112, RGB 135 215 0) + , (Xterm256ColorCode 113, RGB 135 215 95) + , (Xterm256ColorCode 114, RGB 135 215 135) + , (Xterm256ColorCode 115, RGB 135 215 175) + , (Xterm256ColorCode 116, RGB 135 215 215) + , (Xterm256ColorCode 117, RGB 135 215 255) + , (Xterm256ColorCode 118, RGB 135 255 0) + , (Xterm256ColorCode 119, RGB 135 255 95) + , (Xterm256ColorCode 120, RGB 135 255 135) + , (Xterm256ColorCode 121, RGB 135 255 175) + , (Xterm256ColorCode 122, RGB 135 255 215) + , (Xterm256ColorCode 123, RGB 135 255 255) + , (Xterm256ColorCode 124, RGB 175 0 0) + , (Xterm256ColorCode 125, RGB 175 0 95) + , (Xterm256ColorCode 126, RGB 175 0 135) + , (Xterm256ColorCode 127, RGB 175 0 175) + , (Xterm256ColorCode 128, RGB 175 0 215) + , (Xterm256ColorCode 129, RGB 175 0 255) + , (Xterm256ColorCode 130, RGB 175 95 0) + , (Xterm256ColorCode 131, RGB 175 95 95) + , (Xterm256ColorCode 132, RGB 175 95 135) + , (Xterm256ColorCode 133, RGB 175 95 175) + , (Xterm256ColorCode 134, RGB 175 95 215) + , (Xterm256ColorCode 135, RGB 175 95 255) + , (Xterm256ColorCode 136, RGB 175 135 0) + , (Xterm256ColorCode 137, RGB 175 135 95) + , (Xterm256ColorCode 138, RGB 175 135 135) + , (Xterm256ColorCode 139, RGB 175 135 175) + , (Xterm256ColorCode 140, RGB 175 135 215) + , (Xterm256ColorCode 141, RGB 175 135 255) + , (Xterm256ColorCode 142, RGB 175 175 0) + , (Xterm256ColorCode 143, RGB 175 175 95) + , (Xterm256ColorCode 144, RGB 175 175 135) + , (Xterm256ColorCode 145, RGB 175 175 175) + , (Xterm256ColorCode 146, RGB 175 175 215) + , (Xterm256ColorCode 147, RGB 175 175 255) + , (Xterm256ColorCode 148, RGB 175 215 0) + , (Xterm256ColorCode 149, RGB 175 215 95) + , (Xterm256ColorCode 150, RGB 175 215 135) + , (Xterm256ColorCode 151, RGB 175 215 175) + , (Xterm256ColorCode 152, RGB 175 215 215) + , (Xterm256ColorCode 153, RGB 175 215 255) + , (Xterm256ColorCode 154, RGB 175 255 0) + , (Xterm256ColorCode 155, RGB 175 255 95) + , (Xterm256ColorCode 156, RGB 175 255 135) + , (Xterm256ColorCode 157, RGB 175 255 175) + , (Xterm256ColorCode 158, RGB 175 255 215) + , (Xterm256ColorCode 159, RGB 175 255 255) + , (Xterm256ColorCode 160, RGB 215 0 0) + , (Xterm256ColorCode 161, RGB 215 0 95) + , (Xterm256ColorCode 162, RGB 215 0 135) + , (Xterm256ColorCode 163, RGB 215 0 175) + , (Xterm256ColorCode 164, RGB 215 0 215) + , (Xterm256ColorCode 165, RGB 215 0 255) + , (Xterm256ColorCode 166, RGB 215 95 0) + , (Xterm256ColorCode 167, RGB 215 95 95) + , (Xterm256ColorCode 168, RGB 215 95 135) + , (Xterm256ColorCode 169, RGB 215 95 175) + , (Xterm256ColorCode 170, RGB 215 95 215) + , (Xterm256ColorCode 171, RGB 215 95 255) + , (Xterm256ColorCode 172, RGB 215 135 0) + , (Xterm256ColorCode 173, RGB 215 135 95) + , (Xterm256ColorCode 174, RGB 215 135 135) + , (Xterm256ColorCode 175, RGB 215 135 175) + , (Xterm256ColorCode 176, RGB 215 135 215) + , (Xterm256ColorCode 177, RGB 215 135 255) + , (Xterm256ColorCode 178, RGB 215 175 0) + , (Xterm256ColorCode 179, RGB 215 175 95) + , (Xterm256ColorCode 180, RGB 215 175 135) + , (Xterm256ColorCode 181, RGB 215 175 175) + , (Xterm256ColorCode 182, RGB 215 175 215) + , (Xterm256ColorCode 183, RGB 215 175 255) + , (Xterm256ColorCode 184, RGB 215 215 0) + , (Xterm256ColorCode 185, RGB 215 215 95) + , (Xterm256ColorCode 186, RGB 215 215 135) + , (Xterm256ColorCode 187, RGB 215 215 175) + , (Xterm256ColorCode 188, RGB 215 215 215) + , (Xterm256ColorCode 189, RGB 215 215 255) + , (Xterm256ColorCode 190, RGB 215 255 0) + , (Xterm256ColorCode 191, RGB 215 255 95) + , (Xterm256ColorCode 192, RGB 215 255 135) + , (Xterm256ColorCode 193, RGB 215 255 175) + , (Xterm256ColorCode 194, RGB 215 255 215) + , (Xterm256ColorCode 195, RGB 215 255 255) + , (Xterm256ColorCode 196, RGB 255 0 0) + , (Xterm256ColorCode 197, RGB 255 0 95) + , (Xterm256ColorCode 198, RGB 255 0 135) + , (Xterm256ColorCode 199, RGB 255 0 175) + , (Xterm256ColorCode 200, RGB 255 0 215) + , (Xterm256ColorCode 201, RGB 255 0 255) + , (Xterm256ColorCode 202, RGB 255 95 0) + , (Xterm256ColorCode 203, RGB 255 95 95) + , (Xterm256ColorCode 204, RGB 255 95 135) + , (Xterm256ColorCode 205, RGB 255 95 175) + , (Xterm256ColorCode 206, RGB 255 95 215) + , (Xterm256ColorCode 207, RGB 255 95 255) + , (Xterm256ColorCode 208, RGB 255 135 0) + , (Xterm256ColorCode 209, RGB 255 135 95) + , (Xterm256ColorCode 210, RGB 255 135 135) + , (Xterm256ColorCode 211, RGB 255 135 175) + , (Xterm256ColorCode 212, RGB 255 135 215) + , (Xterm256ColorCode 213, RGB 255 135 255) + , (Xterm256ColorCode 214, RGB 255 175 0) + , (Xterm256ColorCode 215, RGB 255 175 95) + , (Xterm256ColorCode 216, RGB 255 175 135) + , (Xterm256ColorCode 217, RGB 255 175 175) + , (Xterm256ColorCode 218, RGB 255 175 215) + , (Xterm256ColorCode 219, RGB 255 175 255) + , (Xterm256ColorCode 220, RGB 255 215 0) + , (Xterm256ColorCode 221, RGB 255 215 95) + , (Xterm256ColorCode 222, RGB 255 215 135) + , (Xterm256ColorCode 223, RGB 255 215 175) + , (Xterm256ColorCode 224, RGB 255 215 215) + , (Xterm256ColorCode 225, RGB 255 215 255) + , (Xterm256ColorCode 226, RGB 255 255 0) + , (Xterm256ColorCode 227, RGB 255 255 95) + , (Xterm256ColorCode 228, RGB 255 255 135) + , (Xterm256ColorCode 229, RGB 255 255 175) + , (Xterm256ColorCode 230, RGB 255 255 215) + , (Xterm256ColorCode 231, RGB 255 255 255) + , (Xterm256ColorCode 0, RGB 0 0 0) -- “system” colors + , (Xterm256ColorCode 1, RGB 128 0 0) + , (Xterm256ColorCode 2, RGB 0 128 0) + , (Xterm256ColorCode 3, RGB 128 128 0) + , (Xterm256ColorCode 4, RGB 0 0 128) + , (Xterm256ColorCode 5, RGB 128 0 128) + , (Xterm256ColorCode 6, RGB 0 128 128) + , (Xterm256ColorCode 7, RGB 192 192 192) + , (Xterm256ColorCode 8, RGB 128 128 128) + , (Xterm256ColorCode 9, RGB 255 0 0) + , (Xterm256ColorCode 10, RGB 0 255 0) + , (Xterm256ColorCode 11, RGB 255 255 0) + , (Xterm256ColorCode 12, RGB 0 0 255) + , (Xterm256ColorCode 13, RGB 255 0 255) + , (Xterm256ColorCode 14, RGB 0 255 255) + , (Xterm256ColorCode 15, RGB 255 255 255) + ] + +instance ToColor Xterm256ColorCode where + toColor = flip lookup ansi256ColorList -- cannot actually fail + -- | JSON @"#1aff2b" corresponds to the color @RGB 0x1a 0xff 0x2b@. instance FromJSON Color where parseJSON (String t) = maybe mempty return $ toColor (Text.unpack t) @@ -335,6 +637,29 @@ instance FromColor (Word8, Word8, Word8) where fromColor (RGB r g b) = (r, g, b) +instance (Ord a, Floating a) => FromColor (Colour a) where + fromColor (RGB r g b) = sRGB24 r g b + +-- | Warning: this conversion is extremely approximate! +instance FromColor (ANSI.ColorIntensity, ANSI.Color) where + fromColor = findApproximateColor ansi16ColorList + +-- | Warning: this conversion is noticeably approximate! +instance FromColor Xterm256ColorCode where + -- Same algorithm as above + fromColor = findApproximateColor ansi256ColorList + +colorDistance :: Color -> Color -> Int16 +colorDistance (RGB r1 g1 b1) (RGB r2 g2 b2) = abs (fromIntegral r1 - fromIntegral r2) + + abs (fromIntegral g1 - fromIntegral g2) + + abs (fromIntegral b1 - fromIntegral b2) + +-- This is the most naïve possible nearest-neighbor search; +-- it could almost certainly be optimized, if its speed matters at all. +findApproximateColor :: [(a, Color)] -> Color -> a +findApproximateColor acs c = let ranked = map (\ac -> (ac, colorDistance c $ snd ac)) acs + in fst . fst $ minimumBy (comparing snd) ranked + -- | A rendering style. This determines how each kind of token -- is to be rendered, and sets a default color and background -- color for normal tokens. Line numbers can have a different @@ -385,15 +710,24 @@ toJSON (lineNumberBackgroundColor s) ] +-- | The available levels of color complexity in ANSI terminal output. +data ANSIColorLevel = ANSI16Color -- ^ 16-color mode + | ANSI256Color -- ^ 256-color mode + | ANSITrueColor -- ^ True-color mode + deriving (Show, Read, Eq, Ord, Enum, Bounded, Data, Typeable, Generic) + +instance Binary ANSIColorLevel + -- | Options for formatting source code. data FormatOptions = FormatOptions{ - numberLines :: Bool -- ^ Number lines - , startNumber :: Int -- ^ Number of first line - , lineAnchors :: Bool -- ^ Anchors on each line number - , titleAttributes :: Bool -- ^ Html titles with token types - , codeClasses :: [Text] -- ^ Additional classes for Html code tag - , containerClasses :: [Text] -- ^ Additional classes for Html container tag - , lineIdPrefix :: Text -- ^ Prefix for id attributes on lines + numberLines :: Bool -- ^ Number lines + , startNumber :: Int -- ^ Number of first line + , lineAnchors :: Bool -- ^ Anchors on each line number + , titleAttributes :: Bool -- ^ Html titles with token types + , codeClasses :: [Text] -- ^ Additional classes for Html code tag + , containerClasses :: [Text] -- ^ Additional classes for Html container tag + , lineIdPrefix :: Text -- ^ Prefix for id attributes on lines + , ansiColorLevel :: ANSIColorLevel -- ^ Level of ANSI color support to use } deriving (Show, Read, Eq, Ord, Data, Typeable, Generic) instance Binary FormatOptions @@ -408,4 +742,5 @@ , codeClasses = [] , containerClasses = [] , lineIdPrefix = "" + , ansiColorLevel = ANSI16Color } diff --git a/test/test-skylighting.hs b/test/test-skylighting.hs --- a/test/test-skylighting.hs +++ b/test/test-skylighting.hs @@ -5,9 +5,10 @@ module Main where import qualified Control.Exception as E import Data.Aeson (decode, encode) -import Data.Monoid ((<>)) import Data.Algorithm.Diff import qualified Data.ByteString.Lazy as BL +import qualified Data.Map as Map +import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text @@ -15,13 +16,12 @@ import System.Directory import System.Environment (getArgs) import System.FilePath +import Test.QuickCheck import Test.Tasty import Test.Tasty.Golden.Advanced (goldenTest) import Test.Tasty.HUnit -import Test.Tasty.QuickCheck(testProperty) -import Test.QuickCheck +import Test.Tasty.QuickCheck (testProperty) import Text.Show.Pretty -import qualified Data.Map as Map syntaxes :: [Syntax] syntaxes = Map.elems defaultSyntaxMap