brick-skylighting (empty) → 0.1
raw patch · 7 files changed
+386/−0 lines, 7 filesdep +basedep +brickdep +brick-skylightingsetup-changed
Dependencies added: base, brick, brick-skylighting, containers, skylighting, text, vty
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- README.md +11/−0
- Setup.hs +2/−0
- brick-skylighting.cabal +56/−0
- programs/Demo.hs +94/−0
- src/Brick/Widgets/Skylighting.hs +188/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for brick-skylighting++## 0.1 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, Jonathan Daugherty++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Jonathan Daugherty nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,11 @@++brick-skylighting+=================++This package extends the [brick](https://github.com/jtdaugherty/brick)+library with syntax highlighting support using the+[Skylighting](https://github.com/jgm/skylighting) library.++See the Haddock documentation for `Brick.Widgets.Skylighting` for API+details, and see the demonstration program in `programs` for a complete+working example.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ brick-skylighting.cabal view
@@ -0,0 +1,56 @@+name: brick-skylighting+version: 0.1+synopsis: Show syntax-highlighted text in your Brick UI+description: This package provides a module to use Skylighting to perform+ syntax highlighting and display the results in Brick-based+ interfaces.+license: BSD3+license-file: LICENSE+author: Jonathan Daugherty+maintainer: cygnus@foobox.com+copyright: Jonathan Daugherty 2018+category: Graphics+build-type: Simple+extra-source-files: CHANGELOG.md+cabal-version: >=1.18+Homepage: https://github.com/jtdaugherty/brick-skylighting/+Bug-reports: https://github.com/jtdaugherty/brick-skylighting/issues++extra-doc-files:+ README.md++Source-Repository head+ type: git+ location: git://github.com/jtdaugherty/brick-skylighting.git++Flag demos+ Description: Build demonstration programs+ Default: False++library+ ghc-options: -Wall+ hs-source-dirs: src+ default-language: Haskell2010+ exposed-modules: + Brick.Widgets.Skylighting++ build-depends: base <= 5,+ brick,+ vty,+ skylighting >= 0.6,+ text,+ containers++executable brick-skylighting-demo+ if !flag(demos)+ Buildable: False+ main-is: Demo.hs+ ghc-options: -threaded -Wall+ hs-source-dirs: programs+ default-language: Haskell2010+ build-depends: base <= 5,+ brick,+ brick-skylighting,+ vty,+ skylighting >= 0.6,+ text
+ programs/Demo.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad (void)+import Data.Monoid ((<>))+import qualified Data.Text as T+import qualified Graphics.Vty as V+import qualified Skylighting as S++import Brick+import Brick.Widgets.Center (hCenter)+import Brick.Widgets.Border (borderWithLabel, hBorder)++import Brick.Widgets.Skylighting (simpleHighlight, attrMappingsForStyle)++haskellProgram :: T.Text+haskellProgram = T.unlines+ [ "module Main where"+ , ""+ , "data FooBar = Foo | Bar deriving (Eq, Read, Show)"+ , ""+ , "main :: IO ()"+ , "main = do"+ , " let f x = x * x"+ , " return ()"+ ]++pythonProgram :: T.Text+pythonProgram = T.unlines+ [ "import os.path"+ , ""+ , "if __name__ == \"__main__\":"+ , " print('hello, world!')"+ ]++bashProgram :: T.Text+bashProgram = T.unlines+ [ "FOO=1"+ , ""+ , "function print_foo {"+ , " echo $FOO"+ , "}"+ , ""+ , "print_foo"+ ]++programs :: [(T.Text, T.Text)]+programs =+ [ (haskellProgram, "Haskell")+ , (pythonProgram, "Python")+ , (bashProgram, "Bash")+ ]++ui :: Int -> [Widget ()]+ui styleIndex =+ [vBox $ usage : hBorder : header : progs]+ where+ usage = hCenter $ txt "q/esc:quit up/down:change theme"+ header = hCenter $ txt $ "Theme: " <> (fst $ styles !! styleIndex)+ progs = showProg <$> programs+ showProg (progSrc, langName) =+ (borderWithLabel (txt langName) $ simpleHighlight langName progSrc)++styles :: [(T.Text, S.Style)]+styles =+ [ ("espresso", S.espresso)+ , ("kate", S.kate)+ , ("breezeDark", S.breezeDark)+ , ("pygments", S.pygments)+ , ("tango", S.tango)+ , ("haddock", S.haddock)+ , ("monochrome", S.monochrome)+ , ("zenburn", S.zenburn)+ ]++handleEvent :: Int -> BrickEvent () e -> EventM () (Next Int)+handleEvent i (VtyEvent (V.EvKey V.KUp [])) = continue $ (i + 1) `mod` length styles+handleEvent i (VtyEvent (V.EvKey V.KDown [])) = continue $ (i - 1) `mod` length styles+handleEvent i (VtyEvent (V.EvKey V.KEsc [])) = halt i+handleEvent i (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt i+handleEvent i _ = continue i++app :: App Int e ()+app =+ App { appDraw = ui+ , appAttrMap = \i -> attrMap V.defAttr $+ attrMappingsForStyle $ snd $ styles !! i+ , appHandleEvent = handleEvent+ , appChooseCursor = neverShowCursor+ , appStartEvent = return+ }++main :: IO ()+main = void $ defaultMain app 0
+ src/Brick/Widgets/Skylighting.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE OverloadedStrings #-}+-- | This module provides an API for building Brick widgets to display+-- syntax-highlighted text using the Skylighting library.+--+-- To use this module, you'll need to:+--+-- * have some 'Text' you want to syntax-highlight.+-- * know the language in which the 'Text' is expressed.+-- * have a Skylighting 'Style' you'd like to use to determine the+-- colors, either from the Skylighting package or one of your own.+--+-- To highlight some text in your user interface, use one of+-- the (increasingly finer-grained) highlighting functions+-- 'simpleHighlight', 'highlight', 'highlight'', or 'renderRawSource'.+--+-- To actually see pretty colors, you'll need to update your+-- application's 'AttrMap' with name-to-color mappings. Those can be+-- built from a Skylighting 'Style' with 'attrMappingsForStyle' and then+-- appended to your 'attrMap' mapping list.+--+-- The highlighted code widget produced by this module uses+-- 'highlightedCodeBlockAttr' as its base attribute and then uses+-- a specific attribute for each kind of Skylighting token as per+-- 'attrNameForTokenType'.+--+-- See the @programs/Demo.hs@ program in this package for an example of a+-- complete program that uses this module.+module Brick.Widgets.Skylighting+ ( -- * Highlighting functions+ simpleHighlight+ , highlight+ , highlight'+ , renderRawSource++ -- * Attributes+ , attrMappingsForStyle+ , attrNameForTokenType+ , highlightedCodeBlockAttr+ )+where++import Data.Monoid ((<>))+import qualified Data.Text as T+import qualified Data.Map as M+import qualified Graphics.Vty as V++import Brick++import qualified Skylighting as Sky+import Skylighting (TokenType(..))++-- | The simplest way to highlight some text. If the specified language+-- does not have a corresponding Skylighting parser or if a parser is+-- found but fails to parse the input, the text is rendered as-is and+-- tab characters are converted to eight spaces.+simpleHighlight :: T.Text+ -- ^ The Skylighting name of the language in which the+ -- input text is written.+ -> T.Text+ -- ^ The text to be syntax-highlighted.+ -> Widget n+simpleHighlight langName body =+ case Sky.syntaxByName Sky.defaultSyntaxMap langName of+ Nothing -> txt $ expandTabs body+ Just syntax -> highlight syntax body++-- | If you already have a 'Syntax' handy, this provides more control+-- than 'simpleHighlight'.+highlight :: Sky.Syntax+ -- ^ The syntax to use to parse the input text.+ -> T.Text+ -- ^ The text to be syntax-highlighted.+ -> Widget n+highlight = highlight' txt++-- | If you already have a 'Syntax' handy and want to have control over+-- how each 'Text' token in the Skylighting AST gets converted to a+-- 'Widget', this provides more control than 'highlight', which just+-- defaults the text widget constructor to 'txt'. If the specified+-- parser fails to parse the input, the text is displayed as-is and tab+-- characters are converted to eight spaces.+highlight' :: (T.Text -> Widget n)+ -- ^ The token widget constructor.+ -> Sky.Syntax+ -- ^ The syntax to use to parse the input text.+ -> T.Text+ -- ^ The text to be syntax-highlighted.+ -> Widget n+highlight' renderToken syntax tx =+ let cfg = Sky.TokenizerConfig (M.fromList [(Sky.sName syntax, syntax)]) False+ expanded = expandTabs tx+ result = Sky.tokenize cfg syntax tx+ in case result of+ Left _ -> txt expanded+ Right tokLines -> renderRawSource renderToken tokLines++expandTabs :: T.Text -> T.Text+expandTabs = T.replace "\t" (T.replicate 8 " ")++-- | If you have already parsed your input text into Skylighting tokens,+-- this function is the best one to use.+renderRawSource :: (T.Text -> Widget n)+ -- ^ The token widget constructor.+ -> [Sky.SourceLine]+ -- ^ The parsed input.+ -> Widget n+renderRawSource renderToken ls =+ withDefAttr highlightedCodeBlockAttr $+ vBox $ renderTokenLine renderToken <$> ls++renderTokenLine :: (T.Text -> Widget n) -> Sky.SourceLine -> Widget n+renderTokenLine _ [] = str " "+renderTokenLine renderToken toks =+ let renderSingle (ty, tx) = withDefAttr (attrNameForTokenType ty) $ renderToken tx+ in hBox $ renderSingle <$> toks++-- | The base attribute name for all syntax-highlighted renderings.+highlightedCodeBlockAttr :: AttrName+highlightedCodeBlockAttr = "highlightedCodeBlock"++-- | The constructor for attribute names for each 'TokenType' in+-- Skylighting.+attrNameForTokenType :: TokenType -> AttrName+attrNameForTokenType ty = highlightedCodeBlockAttr <> attrName s+ where+ s = case ty of+ KeywordTok -> "keyword"+ DataTypeTok -> "dataType"+ DecValTok -> "declaration"+ BaseNTok -> "baseN"+ FloatTok -> "float"+ ConstantTok -> "constant"+ CharTok -> "char"+ SpecialCharTok -> "specialChar"+ StringTok -> "string"+ VerbatimStringTok -> "verbatimString"+ SpecialStringTok -> "specialString"+ ImportTok -> "import"+ CommentTok -> "comment"+ DocumentationTok -> "documentation"+ AnnotationTok -> "annotation"+ CommentVarTok -> "comment"+ OtherTok -> "other"+ FunctionTok -> "function"+ VariableTok -> "variable"+ ControlFlowTok -> "controlFlow"+ OperatorTok -> "operator"+ BuiltInTok -> "builtIn"+ ExtensionTok -> "extension"+ PreprocessorTok -> "preprocessor"+ AttributeTok -> "attribute"+ RegionMarkerTok -> "regionMarker"+ InformationTok -> "information"+ WarningTok -> "warning"+ AlertTok -> "alert"+ ErrorTok -> "error"+ NormalTok -> "normal"++-- | Given a Skylighting 'Style', build an equivalent list of+-- Brick-compatible 'AttrMap' entries. This will usually return+-- 256-color entries.+attrMappingsForStyle :: Sky.Style -> [(AttrName, V.Attr)]+attrMappingsForStyle sty =+ (highlightedCodeBlockAttr, baseAttrFromPair (Sky.defaultColor sty, Sky.backgroundColor sty)) :+ (mkTokenTypeEntry <$> (M.toList $ Sky.tokenStyles sty))++baseAttrFromPair :: (Maybe Sky.Color, Maybe Sky.Color) -> V.Attr+baseAttrFromPair (mf, mb) =+ case (mf, mb) of+ (Nothing, Nothing) -> V.defAttr+ (Just f, Nothing) -> fg (tokenColorToVtyColor f)+ (Nothing, Just b) -> bg (tokenColorToVtyColor b)+ (Just f, Just b) -> (tokenColorToVtyColor f) `on`+ (tokenColorToVtyColor b)++tokenColorToVtyColor :: Sky.Color -> V.Color+tokenColorToVtyColor (Sky.RGB r g b) = V.rgbColor r g b++mkTokenTypeEntry :: (Sky.TokenType, Sky.TokenStyle) -> (AttrName, V.Attr)+mkTokenTypeEntry (ty, tSty) =+ let a = setStyle baseAttr+ baseAttr = baseAttrFromPair (Sky.tokenColor tSty, Sky.tokenBackground tSty)+ setStyle =+ if Sky.tokenBold tSty then flip V.withStyle V.bold else id .+ if Sky.tokenItalic tSty then flip V.withStyle V.standout else id .+ if Sky.tokenUnderline tSty then flip V.withStyle V.underline else id++ in (attrNameForTokenType ty, a)