{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Skylighting.Format.ConTeXt
( formatConTeXtInline
, formatConTeXtBlock
, styleToConTeXt
) where
import Control.Monad (mplus)
import Data.Char (isSpace)
import Data.List (sort)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import Skylighting.Types
import Text.Printf
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
formatConTeXt :: [SourceLine] -> Text
formatConTeXt :: [SourceLine] -> Text
formatConTeXt = Text -> [Text] -> Text
Text.intercalate (Char -> Text
Text.singleton Char
'\n')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map SourceLine -> Text
sourceLineToConTeXt
formatConTeXtInline :: FormatOptions -> [SourceLine] -> Text
formatConTeXtInline :: FormatOptions -> [SourceLine] -> Text
formatConTeXtInline FormatOptions
_opts [SourceLine]
ls =
Text
"\\highlight{" forall a. Semigroup a => a -> a -> a
<> [SourceLine] -> Text
formatConTeXt [SourceLine]
ls forall a. Semigroup a => a -> a -> a
<> Text
"}"
sourceLineToConTeXt :: SourceLine -> Text
sourceLineToConTeXt :: SourceLine -> Text
sourceLineToConTeXt =
Text -> Text -> Text -> Text
Text.replace Text
"/ETEX/BTEX" Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text -> Text -> Text
Text.replace Text
"/ETEX /BTEX" Text
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Token -> Text
tokenToConTeXt
tokenToConTeXt :: Token -> Text
tokenToConTeXt :: Token -> Text
tokenToConTeXt (TokenType
NormalTok, Text
txt)
| (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isSpace Text
txt = Text -> Text
escapeConTeXt Text
txt
tokenToConTeXt (TokenType
toktype, Text
txt) = Text
"/BTEX\\" forall a. Semigroup a => a -> a -> a
<>
(String -> Text
Text.pack (forall a. Show a => a -> String
show TokenType
toktype) forall a. Semigroup a => a -> a -> a
<> Text
"{" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeConTeXt Text
txt forall a. Semigroup a => a -> a -> a
<> Text
"}/ETEX")
escapeConTeXt :: Text -> Text
escapeConTeXt :: Text -> Text
escapeConTeXt = (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
escapeConTeXtChar
where escapeConTeXtChar :: Char -> Text
escapeConTeXtChar Char
c =
case Char
c of
Char
'\\' -> Text
"\\letterbackslash "
Char
'{' -> Text
"\\letteropenbrace "
Char
'}' -> Text
"\\letterclosebrace "
Char
'|' -> Text
"\\letterbar "
Char
'$' -> Text
"\\letterdollar "
Char
'_' -> Text
"\\letterunderscore "
Char
'%' -> Text
"\\letterpercent "
Char
'#' -> Text
"\\letterhash "
Char
'/' -> Text
"\\letterslash "
Char
'~' -> Text
"\\lettertilde "
Char
_ -> Char -> Text
Text.singleton Char
c
formatConTeXtBlock :: FormatOptions -> [SourceLine] -> Text
formatConTeXtBlock :: FormatOptions -> [SourceLine] -> Text
formatConTeXtBlock FormatOptions
opts [SourceLine]
ls = [Text] -> Text
Text.unlines
[ Text
"\\starthighlighting" forall a. Semigroup a => a -> a -> a
<>
(if FormatOptions -> Bool
numberLines FormatOptions
opts
then Text
"[numbering=line]"
else Text
Text.empty)
, [SourceLine] -> Text
formatConTeXt [SourceLine]
ls
, Text
"\\stophighlighting"
]
styleToConTeXt :: Style -> Text
styleToConTeXt :: Style -> Text
styleToConTeXt Style
f = [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$
( case Style -> Maybe Color
backgroundColor Style
f of
Maybe Color
Nothing -> forall a. a -> a
id
Just (RGB Word8
r Word8
g Word8
b) -> (:)
(String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"\\definecolor[shadecolor][x=%x%x%x]" Word8
r Word8
g Word8
b)
) forall a b. (a -> b) -> a -> b
$
[ Text
"\\defineframedtext [shaded]"
, Text
" [backgroundcolor=shadecolor,"
, Text
" background=color,"
, Text
" frame=off,"
, Text
" offset=0pt,"
, Text
" width=local]"
, Text
"\\definetyping [highlighting]"
, Text
" [escape=yes,"
, Text
" before={\\startshaded},"
, Text
" after={\\stopshaded}]"
, Text
"\\definetype [highlight]"
, Text
" [escape=yes]"
] forall a. [a] -> [a] -> [a]
++
forall a. Ord a => [a] -> [a]
sort (forall a b. (a -> b) -> [a] -> [b]
map (Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> Text
macrodef (Style -> Maybe Color
defaultColor Style
f) (forall k a. Map k a -> [(k, a)]
Map.toList (Style -> Map TokenType TokenStyle
tokenStyles Style
f)))
(forall a. Enum a => a -> a -> [a]
enumFromTo TokenType
KeywordTok TokenType
NormalTok))
macrodef :: Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> Text
macrodef :: Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> Text
macrodef Maybe Color
defaultcol [(TokenType, TokenStyle)]
tokstyles TokenType
tokt = Text
"\\define[1]\\"
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show TokenType
tokt)
forall a. Semigroup a => a -> a -> a
<> Text
"{"
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall {t}. (PrintfArg t, PrintfType t) => t -> t
co forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Semigroup a, IsString a) => a -> a
ul forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Semigroup a, IsString a) => a -> a
bf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Semigroup a, IsString a) => a -> a
it forall a b. (a -> b) -> a -> b
$ String
"#1")
forall a. Semigroup a => a -> a -> a
<> Text
"}"
where tokf :: TokenStyle
tokf = forall a. a -> Maybe a -> a
fromMaybe TokenStyle
defStyle forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup TokenType
tokt [(TokenType, TokenStyle)]
tokstyles
ul :: a -> a
ul a
x = if TokenStyle -> Bool
tokenUnderline TokenStyle
tokf
then a
"\\underbar{" forall a. Semigroup a => a -> a -> a
<> a
x forall a. Semigroup a => a -> a -> a
<> a
"}"
else a
x
it :: a -> a
it a
x = if TokenStyle -> Bool
tokenItalic TokenStyle
tokf
then a
"\\em " forall a. Semigroup a => a -> a -> a
<> a
x
else a
x
bf :: a -> a
bf a
x = if TokenStyle -> Bool
tokenBold TokenStyle
tokf
then a
"\\bf " forall a. Semigroup a => a -> a -> a
<> a
x
else a
x
col :: Maybe (Double, Double, Double)
col = forall a. FromColor a => Color -> a
fromColor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (TokenStyle -> Maybe Color
tokenColor TokenStyle
tokf forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Color
defaultcol)
:: Maybe (Double, Double, Double)
co :: t -> t
co t
x = case Maybe (Double, Double, Double)
col of
Maybe (Double, Double, Double)
Nothing -> t
x
Just (Double
r, Double
g, Double
b) ->
forall r. PrintfType r => String -> r
printf String
"\\colored[r=%0.2f,g=%0.2f,b=%0.2f]{%s}" Double
r Double
g Double
b t
x