summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasperVanDerJeugt <>2018-08-31 17:14:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-08-31 17:14:00 (GMT)
commit3cbe9ae3b90ae58516b32f24fd017dbeea769592 (patch)
tree2a6cc9ded511988e5947ba3b64c07f1046a8e194
parentc6719628df75bf00aa92d61ac0f0d1da633ae4ee (diff)
version 0.8.0.00.8.0.0
-rw-r--r--CHANGELOG.md7
-rw-r--r--README.md373
-rw-r--r--extra/make-man.hs7
-rw-r--r--patat.cabal15
-rw-r--r--src/Main.hs12
-rw-r--r--src/Patat/Images.hs60
-rw-r--r--src/Patat/Images/ITerm2.hs56
-rw-r--r--src/Patat/Images/Internal.hs36
-rw-r--r--src/Patat/Images/W3m.hs145
-rw-r--r--src/Patat/Presentation/Display.hs87
-rw-r--r--src/Patat/Presentation/Internal.hs70
-rw-r--r--src/Patat/Presentation/Read.hs11
-rw-r--r--src/Patat/PrettyPrint.hs16
-rw-r--r--src/Patat/Theme.hs81
14 files changed, 763 insertions, 213 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index ab57bc6..a56f551 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,12 @@
# Changelog
+- 0.8.0.0 (2018-08-31)
+ * Themed border rendering improvements (contribution by Hamza Haiken)
+ * Add support for margins (contribution by Hamza Haiken)
+ * Add RGB colour support for themes (contribution by Hamza Haiken)
+ * Add experimental images support
+ * Add images support for iTerm2 (contribution by @2mol)
+
- 0.7.2.0 (2018-05-08)
* GHC 8.4 compatibility
diff --git a/README.md b/README.md
index 865024f..df27b38 100644
--- a/README.md
+++ b/README.md
@@ -14,12 +14,13 @@ Features:
- Supports [smart slide splitting](#input-format).
- Slides can be split up into [multiple fragments](#fragmented-slides)
- There is a [live reload](#running) mode.
-- [Theming](#theming) support.
+- [Theming](#theming) support including 24-bit RGB.
- [Auto advancing](#auto-advancing) with configurable delay.
- Optionally [re-wrapping](#line-wrapping) text to terminal width with proper
indentation.
- Syntax highlighting for nearly one hundred languages generated from [Kate]
syntax files.
+- Experimental [images](#images) support.
- Written in [Haskell].
![screenshot](extra/screenshot.png?raw=true)
@@ -47,6 +48,7 @@ Table of Contents
- [Theming](#theming)
- [Syntax Highlighting](#syntax-highlighting)
- [Pandoc Extensions](#pandoc-extensions)
+ - [Images](#images)
- [Trivia](#trivia)
Installation
@@ -54,6 +56,7 @@ Installation
### Pre-built-packages
+- Archlinux: <https://aur.archlinux.org/packages/patat-bin>
- Debian: <https://packages.debian.org/unstable/patat>
- Ubuntu: <https://packages.ubuntu.com/artful/patat>
- openSUSE: <https://build.opensuse.org/package/show/openSUSE:Factory:ARM/patat>
@@ -138,24 +141,26 @@ Input format
The input format can be anything that Pandoc supports. Plain markdown is
usually the most simple solution:
- ---
- title: This is my presentation
- author: Jane Doe
- ...
+```markdown
+---
+title: This is my presentation
+author: Jane Doe
+...
- # This is a slide
+# This is a slide
- Slide contents. Yay.
+Slide contents. Yay.
- ---
+---
- # Important title
+# Important title
- Things I like:
+Things I like:
- - Markdown
- - Haskell
- - Pandoc
+- Markdown
+- Haskell
+- Pandoc
+```
Horizontal rulers (`---`) are used to split slides.
@@ -170,65 +175,70 @@ centered title.
This means the following document is equivalent to the one we saw before:
- ---
- title: This is my presentation
- author: Jane Doe
- ...
+```markdown
+---
+title: This is my presentation
+author: Jane Doe
+...
- # This is a slide
+# This is a slide
- Slide contents. Yay.
+Slide contents. Yay.
- # Important title
+# Important title
- Things I like:
+Things I like:
- - Markdown
- - Haskell
- - Pandoc
+- Markdown
+- Haskell
+- Pandoc
+```
And that following document contains three slides: a title slide, followed by
two content slides.
- ---
- title: This is my presentation
- author: Jane Doe
- ...
+```markdown
+---
+title: This is my presentation
+author: Jane Doe
+...
- # Chapter 1
+# Chapter 1
- ## This is a slide
+## This is a slide
- Slide contents. Yay.
+Slide contents. Yay.
- ## Another slide
+## Another slide
- Things I like:
+Things I like:
- - Markdown
- - Haskell
- - Pandoc
+- Markdown
+- Haskell
+- Pandoc
+```
For more information, see [Advanced slide splitting](#advanced-slide-splitting).
Patat supports comments which can be used as speaker notes.
- ---
- title: This is my presentation
- author: Jane Doe
- ...
+```markdown
+---
+title: This is my presentation
+author: Jane Doe
+...
- # Chapter 1
+# Chapter 1
- <!--
- Note: I should not bore the audience with my thoughts on powerpoint but
- just get straight to the point.
- -->
+<!--
+Note: I should not bore the audience with my thoughts on powerpoint but
+just get straight to the point.
+-->
- Slide contents. Yay.
-
- <!-- TODO: Finish the rest of the presentation. -->
+Slide contents. Yay.
+<!-- TODO: Finish the rest of the presentation. -->
+```
Configuration
-------------
@@ -244,14 +254,16 @@ are two places where you can put your configuration:
For example, we set an option `key` to `val` by using the following file:
- ---
- title: Presentation with options
- author: John Doe
- patat:
- key: val
- ...
+```markdown
+---
+title: Presentation with options
+author: John Doe
+patat:
+ key: val
+...
- Hello world.
+Hello world.
+```
Or we can use a normal presentation and have the following `$HOME/.patat.yaml`:
@@ -262,23 +274,48 @@ Or we can use a normal presentation and have the following `$HOME/.patat.yaml`:
Line wrapping can be enabled by setting `wrap: true` in the configuration. This
will re-wrap all lines to fit the terminal width better.
+### Margins
+
+Margins can be enabled by setting a `margins` entry in the configuration:
+
+```markdown
+---
+title: Presentation with margins
+author: John Doe
+patat:
+ wrap: true
+ margins:
+ left: 10
+ right: 10
+...
+
+Lorem ipsum dolor sit amet, ...
+```
+
+This example configuration will generate slides with a margin of 10 characters on the left,
+and break lines 10 characters before they reach the end of the terminal's width.
+
+It is recommended to enable [line wrapping](#line-wrapping) along with this feature.
+
### Auto advancing
By setting `autoAdvanceDelay` to a number of seconds, `patat` will automatically
advance to the next slide.
- ---
- title: Auto-advance, yes please
- author: John Doe
- patat:
- autoAdvanceDelay: 2
- ...
+```markdown
+---
+title: Auto-advance, yes please
+author: John Doe
+patat:
+ autoAdvanceDelay: 2
+...
- Hello World!
+Hello World!
- ---
+---
- This slide will be shown two seconds after the presentation starts.
+This slide will be shown two seconds after the presentation starts.
+```
Note that changes to `autoAdvanceDelay` are not picked up automatically if you
are running `patat --watch`. This requires restarting `patat`.
@@ -290,26 +327,30 @@ variable. This variable defaults to the least header that occurs before a
non-header, but it can also be explicitly defined. For example, in the
following document, the `slideLevel` defaults to **2**:
- # This is a slide
+```markdown
+# This is a slide
- ## This is a nested header
+## This is a nested header
- This is some content
+This is some content
+```
With `slideLevel` 2, the `h1` will turn into a "title slide", and the `h2` will
be displayed at the top of the second slide. We can customize this by setting
`slideLevel` manually:
- ---
- patat:
- slideLevel: 1
- ...
+```markdown
+---
+patat:
+ slideLevel: 1
+...
- # This is a slide
+# This is a slide
- ## This is a nested header
+## This is a nested header
- This is some content
+This is some content
+```
Now, we will only see one slide, which contains a nested header.
@@ -322,16 +363,18 @@ case is that lists should be displayed incrementally.
This can be configured by settings `incrementalLists` to `true` in the metadata
block:
- ---
- title: Presentation with incremental lists
- author: John Doe
- patat:
- incrementalLists: true
- ...
+```markdown
+---
+title: Presentation with incremental lists
+author: John Doe
+patat:
+ incrementalLists: true
+...
- - This list
- - is displayed
- - item by item
+- This list
+- is displayed
+- item by item
+```
Setting `incrementalLists` works on _all_ lists in the presentation. To flip
the setting for a specific list, wrap it in a block quote. This will make the
@@ -341,57 +384,63 @@ all at once if `incrementalLists` is set to `true`.
This example contains a sublist which is also displayed incrementally, and then
a sublist which is displayed all at once (by merit of the block quote).
- ---
- title: Presentation with incremental lists
- author: John Doe
- patat:
- incrementalLists: true
- ...
+```markdown
+---
+title: Presentation with incremental lists
+author: John Doe
+patat:
+ incrementalLists: true
+...
- - This list
- - is displayed
+- This list
+- is displayed
- * item
- * by item
+ * item
+ * by item
- - Or sometimes
+- Or sometimes
- > * all at
- > * once
+ > * all at
+ > * once
+```
Another way to break up slides is to use a pagraph only containing three dots
separated by spaces. For example, this slide has two pauses:
- Legen
+```markdown
+Legen
- . . .
+. . .
- wait for it
+wait for it
- . . .
+. . .
- Dary!
+Dary!
+```
### Theming
Colors and other properties can also be changed using this configuration. For
example, we can have:
- ---
- author: 'Jasper Van der Jeugt'
- title: 'This is a test'
- patat:
- wrap: true
- theme:
- emph: [vividBlue, onVividBlack, bold]
- imageTarget: [onDullWhite, vividRed]
- ...
+```markdown
+---
+author: 'Jasper Van der Jeugt'
+title: 'This is a test'
+patat:
+ wrap: true
+ theme:
+ emph: [vividBlue, onVividBlack, bold]
+ imageTarget: [onDullWhite, vividRed]
+...
- # This is a presentation
+# This is a presentation
- This is _emph_ text.
+This is _emph_ text.
- ![Hello](foo.png)
+![Hello](foo.png)
+```
The properties that can be given a list of styles are:
@@ -410,19 +459,27 @@ The accepted styles are:
`vividBlue`, `vividCyan`, `vividGreen`, `vividMagenta`, `vividRed`,
`vividWhite`, `vividYellow`
+Also accepted are styles of the form `rgb#RrGgBb` and `onRgb#RrGgBb`, where `Rr`
+`Gg` and `Bb` are hexadecimal bytes (e.g. `rgb#f08000` for an orange foreground,
+and `onRgb#101060` for a deep purple background). Naturally, your terminal
+needs to support 24-bit RGB for this to work. When creating portable
+presentations, it might be better to stick with the named colours listed above.
+
### Syntax Highlighting
As part of theming, syntax highlighting is also configurable. This can be
configured like this:
- ---
- patat:
- theme:
- syntaxHighlighting:
- decVal: [bold, onDullRed]
- ...
+```
+---
+patat:
+ theme:
+ syntaxHighlighting:
+ decVal: [bold, onDullRed]
+...
- ...
+...
+```
`decVal` refers to "decimal values". This is known as a "token type". For a
full list of token types, see [this list] -- the names are derived from there in
@@ -432,42 +489,82 @@ an obvious way.
### Pandoc Extensions
-Pandoc comes with a fair number of extensions on top of markdown:
-
- <https://hackage.haskell.org/package/pandoc-2.0.5/docs/Text-Pandoc-Extensions.html>
+Pandoc comes with a fair number of extensions on top of markdown, listed [here](https://hackage.haskell.org/package/pandoc-2.0.5/docs/Text-Pandoc-Extensions.html).
`patat` enables a number of them by default, but this is also customizable.
In order to enable an additional extensions, e.g. `autolink_bare_uris`, add it
to the `pandocExtensions` field in the YAML metadata:
- ---
- patat:
- pandocExtensions:
- - patat_extensions
- - autolink_bare_uris
- ...
+```markdown
+---
+patat:
+ pandocExtensions:
+ - patat_extensions
+ - autolink_bare_uris
+...
- Document content...
+Document content...
+```
The `patat_extensions` in the above snippet refers to the default set of
extensions enabled by `patat`. If you want to disable those and only use a
select few extensions, simply leave it out and choose your own:
- ---
- patat:
- pandocExtensions:
- - autolink_bare_uris
- - emoji
- ...
+```markdown
+---
+patat:
+ pandocExtensions:
+ - autolink_bare_uris
+ - emoji
+...
- ...
+...
- Document content...
+Document content...
+```
If you don't want to enable any extensions, simply set `pandocExtensions` to the
empty list `[]`.
+
+### Images
+
+`patat-0.8.0.0` and newer include images support for some terminal emulators.
+
+```markdown
+---
+patat:
+ images:
+ backend: auto
+...
+
+# A slide with only an image.
+
+![](matterhorn.jpg)
+```
+
+If `images` is enabled (not by default), `patat` will draw slides that consist
+only of a single image just by drawing the image, centered and resized to fit
+the terminal window.
+
+`patat` supports the following image drawing backends:
+
+- `backend: iterm2`: uses [iTerm2](https://iterm2.com/)'s special escape
+ sequence to render the image. This even works with animated GIFs!
+
+- `backend: w3m`: uses the `w3mimgdisplay` executable to draw directly onto
+ the window. This has been tested in `urxvt` and `xterm`, but is known to
+ produce weird results in `tmux`.
+
+ If `w3mimgdisplay` is in a non-standard location, you can specify that using
+ `path`:
+
+ ```yaml
+ backend: 'w3m
+ path: '/home/jasper/.local/bin/w3mimgdisplay'
+ ```
+
Trivia
------
diff --git a/extra/make-man.hs b/extra/make-man.hs
index 58cb00d..cd14cf0 100644
--- a/extra/make-man.hs
+++ b/extra/make-man.hs
@@ -30,11 +30,6 @@ getPrettySourceDate = do
where
locale = Time.defaultTimeLocale
-removeLinks :: Pandoc.Pandoc -> Pandoc.Pandoc
-removeLinks = Pandoc.bottomUp $ \inline -> case inline of
- Pandoc.Link _ inlines _ -> Pandoc.Emph inlines
- _ -> inline
-
type Sections = [(Int, T.Text, [Pandoc.Block])]
toSections :: Int -> [Pandoc.Block] -> Sections
@@ -120,7 +115,7 @@ main = Pandoc.runIOorExplode $ do
]
}
- let pandoc1 = reorganizeSections $ removeLinks pandoc0
+ let pandoc1 = reorganizeSections $ pandoc0
txt <- Pandoc.writeMan writerOptions pandoc1
liftIO $ do
T.putStr txt
diff --git a/patat.cabal b/patat.cabal
index c33acde..aa93723 100644
--- a/patat.cabal
+++ b/patat.cabal
@@ -1,5 +1,5 @@
Name: patat
-Version: 0.7.2.0
+Version: 0.8.0.0
Synopsis: Terminal-based presentations using Pandoc
Description: Terminal-based presentations using Pandoc
License: GPL-2
@@ -32,23 +32,26 @@ Executable patat
Default-language: Haskell2010
Build-depends:
- aeson >= 0.9 && < 1.4,
+ aeson >= 0.9 && < 1.5,
ansi-terminal >= 0.6 && < 0.9,
ansi-wl-pprint >= 0.6 && < 0.7,
base >= 4.6 && < 5,
+ base64-bytestring >= 1.0 && < 1.1,
bytestring >= 0.10 && < 0.11,
- containers >= 0.5 && < 0.6,
+ colour >= 2.3 && < 2.4,
+ containers >= 0.5 && < 0.7,
directory >= 1.2 && < 1.4,
filepath >= 1.4 && < 1.5,
mtl >= 2.2 && < 2.3,
optparse-applicative >= 0.12 && < 0.15,
pandoc >= 2.0.4 && < 2.3,
+ process >= 1.6 && < 1.7,
skylighting >= 0.1 && < 0.8,
terminal-size >= 0.3 && < 0.4,
text >= 1.2 && < 1.3,
time >= 1.4 && < 1.10,
unordered-containers >= 0.2 && < 0.3,
- yaml >= 0.7 && < 0.9,
+ yaml >= 0.8 && < 0.11,
-- We don't even depend on these packages but they can break cabal install
-- because of the conflicting 'Network.URI' module.
network-uri >= 2.6,
@@ -63,6 +66,10 @@ Executable patat
Data.Aeson.TH.Extended
Data.Data.Extended
Patat.AutoAdvance
+ Patat.Images
+ Patat.Images.Internal
+ Patat.Images.W3m
+ Patat.Images.ITerm2
Patat.Presentation
Patat.Presentation.Display
Patat.Presentation.Display.CodeBlock
diff --git a/src/Main.hs b/src/Main.hs
index 3ba00c6..f45ae35 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -17,6 +17,7 @@ import Data.Time (UTCTime)
import Data.Version (showVersion)
import qualified Options.Applicative as OA
import Patat.AutoAdvance
+import qualified Patat.Images as Images
import Patat.Presentation
import qualified Paths_patat
import Prelude
@@ -127,12 +128,15 @@ main = do
unless (oForce options) assertAnsiFeatures
+ -- (Maybe) initialize images backend.
+ images <- traverse Images.new (psImages $ pSettings pres)
+
if oDump options
then dumpPresentation pres
- else interactiveLoop options pres
+ else interactiveLoop options images pres
where
- interactiveLoop :: Options -> Presentation -> IO ()
- interactiveLoop options pres0 = (`finally` cleanup) $ do
+ interactiveLoop :: Options -> Maybe Images.Handle -> Presentation -> IO ()
+ interactiveLoop options images pres0 = (`finally` cleanup) $ do
IO.hSetBuffering IO.stdin IO.NoBuffering
Ansi.hideCursor
@@ -155,7 +159,7 @@ main = do
let loop :: Presentation -> Maybe String -> IO ()
loop pres mbError = do
case mbError of
- Nothing -> displayPresentation pres
+ Nothing -> displayPresentation images pres
Just err -> displayPresentationError pres err
c <- Chan.readChan commandChan
diff --git a/src/Patat/Images.hs b/src/Patat/Images.hs
new file mode 100644
index 0000000..0d048d0
--- /dev/null
+++ b/src/Patat/Images.hs
@@ -0,0 +1,60 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE OverloadedStrings #-}
+module Patat.Images
+ ( Backend
+ , Handle
+ , new
+ , drawImage
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Exception (catch)
+import qualified Data.Aeson as A
+import qualified Data.Text as T
+import Patat.Images.Internal
+import qualified Patat.Images.ITerm2 as ITerm2
+import qualified Patat.Images.W3m as W3m
+import Patat.Presentation.Internal
+
+
+--------------------------------------------------------------------------------
+new :: ImageSettings -> IO Handle
+new is
+ | isBackend is == "auto" = auto
+ | Just (Backend b) <- lookup (isBackend is) backends =
+ case A.fromJSON (A.Object $ isParams is) of
+ A.Success c -> b (Explicit c)
+ A.Error err -> fail $
+ "Patat.Images.new: Error parsing config for " ++
+ show (isBackend is) ++ " image backend: " ++ err
+new is = fail $
+ "Patat.Images.new: Could not find " ++ show (isBackend is) ++
+ " image backend."
+
+
+--------------------------------------------------------------------------------
+auto :: IO Handle
+auto = go [] backends
+ where
+ go names ((name, Backend b) : bs) = catch
+ (b Auto)
+ (\(BackendNotSupported _) -> go (name : names) bs)
+ go names [] = fail $
+ "Could not find a supported backend, tried: " ++
+ T.unpack (T.intercalate ", " (reverse names))
+
+
+--------------------------------------------------------------------------------
+-- | All supported backends. We can use CPP to include or exclude some
+-- depending on platform availability.
+backends :: [(T.Text, Backend)]
+backends =
+ [ ("iterm2", ITerm2.backend)
+ , ("w3m", W3m.backend)
+ ]
+
+
+--------------------------------------------------------------------------------
+drawImage :: Handle -> FilePath -> IO ()
+drawImage = hDrawImage
diff --git a/src/Patat/Images/ITerm2.hs b/src/Patat/Images/ITerm2.hs
new file mode 100644
index 0000000..2584aed
--- /dev/null
+++ b/src/Patat/Images/ITerm2.hs
@@ -0,0 +1,56 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE TemplateHaskell #-}
+module Patat.Images.ITerm2
+ ( backend
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Exception (throwIO)
+import Control.Monad (unless, when)
+import qualified Data.Aeson as A
+import qualified Data.ByteString.Base64.Lazy as B64
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.List as L
+import qualified Patat.Images.Internal as Internal
+import System.Environment (lookupEnv)
+
+
+--------------------------------------------------------------------------------
+backend :: Internal.Backend
+backend = Internal.Backend new
+
+
+--------------------------------------------------------------------------------
+data Config = Config deriving (Eq)
+instance A.FromJSON Config where parseJSON _ = return Config
+
+
+--------------------------------------------------------------------------------
+new :: Internal.Config Config -> IO Internal.Handle
+new config = do
+ when (config == Internal.Auto) $ do
+ termProgram <- lookupEnv "TERM_PROGRAM"
+ unless (termProgram == Just "iTerm.app") $ throwIO $
+ Internal.BackendNotSupported "TERM_PROGRAM not iTerm.app"
+
+ return Internal.Handle {Internal.hDrawImage = drawImage}
+
+
+--------------------------------------------------------------------------------
+drawImage :: FilePath -> IO ()
+drawImage path = do
+ content <- BL.readFile path
+ withEscapeSequence $ do
+ putStr "1337;File=inline=1;width=100%;height=100%:"
+ BL.putStr (B64.encode content)
+
+
+--------------------------------------------------------------------------------
+withEscapeSequence :: IO () -> IO ()
+withEscapeSequence f = do
+ term <- lookupEnv "TERM"
+ let inScreen = maybe False ("screen" `L.isPrefixOf`) term
+ putStr $ if inScreen then "\ESCPtmux;\ESC\ESC]" else "\ESC]"
+ f
+ putStrLn $ if inScreen then "\a\ESC\\" else "\a"
diff --git a/src/Patat/Images/Internal.hs b/src/Patat/Images/Internal.hs
new file mode 100644
index 0000000..6ad8864
--- /dev/null
+++ b/src/Patat/Images/Internal.hs
@@ -0,0 +1,36 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE ExistentialQuantification #-}
+module Patat.Images.Internal
+ ( Config (..)
+ , Backend (..)
+ , BackendNotSupported (..)
+ , Handle (..)
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Exception (Exception)
+import qualified Data.Aeson as A
+
+
+--------------------------------------------------------------------------------
+data Config a = Auto | Explicit a deriving (Eq)
+
+
+--------------------------------------------------------------------------------
+data Backend = forall a. A.FromJSON a => Backend (Config a -> IO Handle)
+
+
+--------------------------------------------------------------------------------
+data BackendNotSupported = BackendNotSupported String
+ deriving (Show)
+
+
+--------------------------------------------------------------------------------
+instance Exception BackendNotSupported
+
+
+--------------------------------------------------------------------------------
+data Handle = Handle
+ { hDrawImage :: FilePath -> IO ()
+ }
diff --git a/src/Patat/Images/W3m.hs b/src/Patat/Images/W3m.hs
new file mode 100644
index 0000000..d2ae171
--- /dev/null
+++ b/src/Patat/Images/W3m.hs
@@ -0,0 +1,145 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE TemplateHaskell #-}
+module Patat.Images.W3m
+ ( backend
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Exception (throwIO)
+import Control.Monad (unless)
+import qualified Data.Aeson.TH.Extended as A
+import qualified Patat.Images.Internal as Internal
+import qualified System.Directory as Directory
+import qualified System.Process as Process
+import Text.Read (readMaybe)
+
+
+--------------------------------------------------------------------------------
+backend :: Internal.Backend
+backend = Internal.Backend new
+
+
+--------------------------------------------------------------------------------
+data Config = Config
+ { cPath :: Maybe FilePath
+ } deriving (Show)
+
+
+--------------------------------------------------------------------------------
+new :: Internal.Config Config -> IO Internal.Handle
+new config = do
+ w3m <- findW3m $ case config of
+ Internal.Explicit c -> cPath c
+ _ -> Nothing
+
+ return Internal.Handle {Internal.hDrawImage = drawImage w3m}
+
+
+--------------------------------------------------------------------------------
+newtype W3m = W3m FilePath deriving (Show)
+
+
+--------------------------------------------------------------------------------
+findW3m :: Maybe FilePath -> IO W3m
+findW3m mbPath
+ | Just path <- mbPath = do
+ exe <- isExecutable path
+ if exe
+ then return (W3m path)
+ else throwIO $
+ Internal.BackendNotSupported $ path ++ " is not executable"
+ | otherwise = W3m <$> find paths
+ where
+ find [] = throwIO $ Internal.BackendNotSupported
+ "w3mimgdisplay executable not found"
+ find (p : ps) = do
+ exe <- isExecutable p
+ if exe then return p else find ps
+
+ paths =
+ [ "/usr/lib/w3m/w3mimgdisplay"
+ , "/usr/libexec/w3m/w3mimgdisplay"
+ , "/usr/lib64/w3m/w3mimgdisplay"
+ , "/usr/libexec64/w3m/w3mimgdisplay"
+ , "/usr/local/libexec/w3m/w3mimgdisplay"
+ ]
+
+ isExecutable path = do
+ exists <- Directory.doesFileExist path
+ if exists then do
+ perms <- Directory.getPermissions path
+ return (Directory.executable perms)
+ else
+ return False
+
+
+--------------------------------------------------------------------------------
+-- | Parses something of the form "<width> <height>\n".
+parseWidthHeight :: String -> Maybe (Int, Int)
+parseWidthHeight output = case words output of
+ [ws, hs] | Just w <- readMaybe ws, Just h <- readMaybe hs ->
+ return (w, h)
+ _ -> Nothing
+
+
+--------------------------------------------------------------------------------
+getTerminalSize :: W3m -> IO (Int, Int)
+getTerminalSize (W3m w3mPath) = do
+ output <- Process.readProcess w3mPath ["-test"] ""
+ case parseWidthHeight output of
+ Just wh -> return wh
+ _ -> fail $
+ "Patat.Images.W3m.getTerminalSize: " ++
+ "Could not parse `w3mimgdisplay -test` output"
+
+
+--------------------------------------------------------------------------------
+getImageSize :: W3m -> FilePath -> IO (Int, Int)
+getImageSize (W3m w3mPath) path = do
+ output <- Process.readProcess w3mPath [] ("5;" ++ path ++ "\n")
+ case parseWidthHeight output of
+ Just wh -> return wh
+ _ -> fail $
+ "Patat.Images.W3m.getImageSize: " ++
+ "Could not parse image size using `w3mimgdisplay` for " ++
+ path
+
+
+--------------------------------------------------------------------------------
+drawImage :: W3m -> FilePath -> IO ()
+drawImage w3m@(W3m w3mPath) path = do
+ exists <- Directory.doesFileExist path
+ unless exists $ fail $
+ "Patat.Images.W3m.drawImage: file does not exist: " ++ path
+
+ tsize <- getTerminalSize w3m
+ isize <- getImageSize w3m path
+ let (x, y, w, h) = fit tsize isize
+ command =
+ "0;1;" ++
+ show x ++ ";" ++ show y ++ ";" ++ show w ++ ";" ++ show h ++
+ ";;;;;" ++ path ++ "\n4;\n3;\n"
+
+ _ <- Process.readProcess w3mPath [] command
+ return ()
+ where
+ fit :: (Int, Int) -> (Int, Int) -> (Int, Int, Int, Int)
+ fit (tw, th) (iw0, ih0) =
+ -- Scale down to width
+ let iw1 = if iw0 > tw then tw else iw0
+ ih1 = if iw0 > tw then ((ih0 * tw) `div` iw0) else ih0
+
+ -- Scale down to height
+ iw2 = if ih1 > th then ((iw1 * th) `div` ih1) else iw1
+ ih2 = if ih1 > th then th else ih1
+
+ -- Find position
+ x = (tw - iw2) `div` 2
+ y = (th - ih2) `div` 2 in
+
+ (x, y, iw2, ih2)
+
+
+--------------------------------------------------------------------------------
+$(A.deriveFromJSON A.dropPrefixOptions ''Config)
diff --git a/src/Patat/Presentation/Display.hs b/src/Patat/Presentation/Display.hs
index 4347209..f73d6a9 100644
--- a/src/Patat/Presentation/Display.hs
+++ b/src/Patat/Presentation/Display.hs
@@ -19,6 +19,7 @@ import qualified Data.List as L
import Data.Maybe (fromMaybe)
import Data.Monoid (mconcat, mempty, (<>))
import qualified Data.Text as T
+import qualified Patat.Images as Images
import Patat.Presentation.Display.CodeBlock
import Patat.Presentation.Display.Table
import Patat.Presentation.Internal
@@ -40,7 +41,8 @@ data CanvasSize = CanvasSize {csRows :: Int, csCols :: Int} deriving (Show)
--------------------------------------------------------------------------------
-- | Display something within the presentation borders that draw the title and
-- the active slide number and so on.
-displayWithBorders :: Presentation -> (CanvasSize -> Theme -> PP.Doc) -> IO ()
+displayWithBorders
+ :: Presentation -> (CanvasSize -> Theme -> PP.Doc) -> IO ()
displayWithBorders Presentation {..} f = do
Ansi.clearScreen
Ansi.setCursorPosition 0 0
@@ -62,40 +64,72 @@ displayWithBorders Presentation {..} f = do
borders = themed (themeBorders theme)
unless (null title) $ do
- Ansi.setCursorColumn titleOffset
- PP.putDoc $ borders $ PP.string title
+ let titleRemainder = columns - titleWidth - titleOffset
+ wrappedTitle = PP.spaces titleOffset <> PP.string title <> PP.spaces titleRemainder
+ PP.putDoc $ borders wrappedTitle
putStrLn ""
putStrLn ""
let canvasSize = CanvasSize (rows - 2) columns
- PP.putDoc $ withWrapSettings settings $ f canvasSize theme
+ PP.putDoc $ formatWith settings $ f canvasSize theme
putStrLn ""
- let (sidx, _) = pActiveFragment
- active = show (sidx + 1) ++ " / " ++ show (length pSlides)
- activeWidth = length active
+ let (sidx, _) = pActiveFragment
+ active = show (sidx + 1) ++ " / " ++ show (length pSlides)
+ activeWidth = length active
+ author = PP.toString (prettyInlines theme pAuthor)
+ authorWidth = length author
+ middleSpaces = PP.spaces $ columns - activeWidth - authorWidth - 2
Ansi.setCursorPosition (rows - 1) 0
- PP.putDoc $ " " <> borders (prettyInlines theme pAuthor)
- Ansi.setCursorColumn (columns - activeWidth - 1)
- PP.putDoc $ borders $ PP.string active
+ PP.putDoc $ borders $ PP.space <> PP.string author <> middleSpaces <> PP.string active <> PP.space
IO.hFlush IO.stdout
--------------------------------------------------------------------------------
-displayPresentation :: Presentation -> IO ()
-displayPresentation pres@Presentation {..} = displayWithBorders pres $
- \canvasSize theme -> case getActiveFragment pres of
- Nothing -> mempty
- Just (ActiveContent fragment) -> prettyFragment theme fragment
+displayImage :: Images.Handle -> FilePath -> IO ()
+displayImage images path = do
+ Ansi.clearScreen
+ Ansi.setCursorPosition 0 0
+ putStrLn ""
+ IO.hFlush IO.stdout
+ Images.drawImage images path
+
+
+--------------------------------------------------------------------------------
+displayPresentation :: Maybe Images.Handle -> Presentation -> IO ()
+displayPresentation mbImages pres@Presentation {..} =
+ case getActiveFragment pres of
+ Nothing -> displayWithBorders pres mempty
+ Just (ActiveContent fragment)
+ | Just images <- mbImages
+ , Just image <- onlyImage fragment ->
+ displayImage images image
+ Just (ActiveContent fragment) ->
+ displayWithBorders pres $ \_canvasSize theme ->
+ prettyFragment theme fragment
Just (ActiveTitle block) ->
+ displayWithBorders pres $ \canvasSize theme ->
let pblock = prettyBlock theme block
(prows, pcols) = PP.dimensions pblock
offsetRow = (csRows canvasSize `div` 2) - (prows `div` 2)
offsetCol = (csCols canvasSize `div` 2) - (pcols `div` 2)
- spaces = mconcat (replicate offsetCol PP.space) in
+ spaces = PP.NotTrimmable $ PP.spaces offsetCol in
mconcat (replicate (offsetRow - 3) PP.hardline) <$$>
- PP.indent (PP.NotTrimmable spaces) (PP.NotTrimmable spaces) pblock
+ PP.indent spaces spaces pblock
+
+ where
+ -- Check if the fragment consists of just a single image, or a header and
+ -- some image.
+ onlyImage (Fragment blocks)
+ | [Pandoc.Para para] <- filter isVisibleBlock blocks
+ , [Pandoc.Image _ _ (target, _)] <- para =
+ Just target
+ onlyImage (Fragment blocks)
+ | [Pandoc.Header _ _ _, Pandoc.Para para] <- filter isVisibleBlock blocks
+ , [Pandoc.Image _ _ (target, _)] <- para =
+ Just target
+ onlyImage _ = Nothing
--------------------------------------------------------------------------------
@@ -111,8 +145,9 @@ displayPresentationError pres err = displayWithBorders pres $ \_ Theme {..} ->
--------------------------------------------------------------------------------
dumpPresentation :: Presentation -> IO ()
dumpPresentation pres =
- let theme = fromMaybe Theme.defaultTheme (psTheme $ pSettings pres) in
- PP.putDoc $ withWrapSettings (pSettings pres) $
+ let settings = pSettings pres
+ theme = fromMaybe Theme.defaultTheme (psTheme $ settings) in
+ PP.putDoc $ formatWith settings $
PP.vcat $ L.intersperse "----------" $ do
slide <- pSlides pres
return $ case slide of
@@ -123,11 +158,15 @@ dumpPresentation pres =
--------------------------------------------------------------------------------
-withWrapSettings :: PresentationSettings -> PP.Doc -> PP.Doc
-withWrapSettings ps = case (psWrap ps, psColumns ps) of
- (Just True, Just (A.FlexibleNum col)) -> PP.wrapAt (Just col)
- _ -> id
-
+formatWith :: PresentationSettings -> PP.Doc -> PP.Doc
+formatWith ps = wrap . indent
+ where
+ (marginLeft, marginRight) = marginsOf ps
+ wrap = case (psWrap ps, psColumns ps) of
+ (Just True, Just (A.FlexibleNum col)) -> PP.wrapAt (Just $ col - marginRight)
+ _ -> id
+ spaces = PP.NotTrimmable $ PP.spaces marginLeft
+ indent = PP.indent spaces spaces
--------------------------------------------------------------------------------
prettyFragment :: Theme -> Fragment -> PP.Doc
diff --git a/src/Patat/Presentation/Internal.hs b/src/Patat/Presentation/Internal.hs
index a44ae1d..db8d16b 100644
--- a/src/Patat/Presentation/Internal.hs
+++ b/src/Patat/Presentation/Internal.hs
@@ -7,9 +7,14 @@ module Patat.Presentation.Internal
, PresentationSettings (..)
, defaultPresentationSettings
+ , Margins (..)
+ , marginsOf
+
, ExtensionList (..)
, defaultExtensionList
+ , ImageSettings (..)
+
, Slide (..)
, Fragment (..)
, Index
@@ -28,7 +33,7 @@ import qualified Data.Aeson.Extended as A
import qualified Data.Aeson.TH.Extended as A
import qualified Data.Foldable as Foldable
import Data.List (intercalate)
-import Data.Maybe (listToMaybe)
+import Data.Maybe (fromMaybe, listToMaybe)
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..))
import qualified Data.Text as T
@@ -55,12 +60,14 @@ data Presentation = Presentation
data PresentationSettings = PresentationSettings
{ psRows :: !(Maybe (A.FlexibleNum Int))
, psColumns :: !(Maybe (A.FlexibleNum Int))
+ , psMargins :: !(Maybe Margins)
, psWrap :: !(Maybe Bool)
, psTheme :: !(Maybe Theme.Theme)
, psIncrementalLists :: !(Maybe Bool)
, psAutoAdvanceDelay :: !(Maybe (A.FlexibleNum Int))
, psSlideLevel :: !(Maybe Int)
, psPandocExtensions :: !(Maybe ExtensionList)
+ , psImages :: !(Maybe ImageSettings)
} deriving (Show)
@@ -69,20 +76,23 @@ instance Semigroup PresentationSettings where
l <> r = PresentationSettings
{ psRows = psRows l `mplus` psRows r
, psColumns = psColumns l `mplus` psColumns r
+ , psMargins = psMargins l <> psMargins r
, psWrap = psWrap l `mplus` psWrap r
, psTheme = psTheme l <> psTheme r
, psIncrementalLists = psIncrementalLists l `mplus` psIncrementalLists r
, psAutoAdvanceDelay = psAutoAdvanceDelay l `mplus` psAutoAdvanceDelay r
, psSlideLevel = psSlideLevel l `mplus` psSlideLevel r
, psPandocExtensions = psPandocExtensions l `mplus` psPandocExtensions r
+ , psImages = psImages l `mplus` psImages r
}
+
--------------------------------------------------------------------------------
instance Monoid PresentationSettings where
mappend = (<>)
mempty = PresentationSettings
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
- Nothing
+ Nothing Nothing Nothing
--------------------------------------------------------------------------------
@@ -90,16 +100,57 @@ defaultPresentationSettings :: PresentationSettings
defaultPresentationSettings = PresentationSettings
{ psRows = Nothing
, psColumns = Nothing
+ , psMargins = Just defaultMargins
, psWrap = Nothing
, psTheme = Just Theme.defaultTheme
, psIncrementalLists = Nothing
, psAutoAdvanceDelay = Nothing
, psSlideLevel = Nothing
, psPandocExtensions = Nothing
+ , psImages = Nothing
}
--------------------------------------------------------------------------------
+data Margins = Margins
+ { mLeft :: !(Maybe (A.FlexibleNum Int))
+ , mRight :: !(Maybe (A.FlexibleNum Int))
+ } deriving (Show)
+
+
+--------------------------------------------------------------------------------
+instance Semigroup Margins where
+ l <> r = Margins
+ { mLeft = mLeft l `mplus` mLeft r
+ , mRight = mRight l `mplus` mRight r
+ }
+
+
+--------------------------------------------------------------------------------
+instance Monoid Margins where
+ mappend = (<>)
+ mempty = Margins Nothing Nothing
+
+
+--------------------------------------------------------------------------------
+defaultMargins :: Margins
+defaultMargins = Margins
+ { mLeft = Nothing
+ , mRight = Nothing
+ }
+
+
+--------------------------------------------------------------------------------
+marginsOf :: PresentationSettings -> (Int, Int)
+marginsOf presentationSettings =
+ (marginLeft, marginRight)
+ where
+ margins = fromMaybe defaultMargins $ psMargins presentationSettings
+ marginLeft = fromMaybe 0 (A.unFlexibleNum <$> mLeft margins)
+ marginRight = fromMaybe 0 (A.unFlexibleNum <$> mRight margins)
+
+
+--------------------------------------------------------------------------------
newtype ExtensionList = ExtensionList {unExtensionList :: Pandoc.Extensions}
deriving (Show)
@@ -153,6 +204,20 @@ defaultExtensionList = ExtensionList $
--------------------------------------------------------------------------------
+data ImageSettings = ImageSettings
+ { isBackend :: !T.Text
+ , isParams :: !A.Object
+ } deriving (Show)
+
+
+--------------------------------------------------------------------------------
+instance A.FromJSON ImageSettings where
+ parseJSON = A.withObject "FromJSON ImageSettings" $ \o -> do
+ t <- o A..: "backend"
+ return ImageSettings {isBackend = t, isParams = o}
+
+
+--------------------------------------------------------------------------------
data Slide
= ContentSlide [Fragment]
| TitleSlide Pandoc.Block
@@ -198,3 +263,4 @@ getActiveFragment presentation = do
--------------------------------------------------------------------------------
$(A.deriveFromJSON A.dropPrefixOptions ''PresentationSettings)
+$(A.deriveFromJSON A.dropPrefixOptions ''Margins)
diff --git a/src/Patat/Presentation/Read.hs b/src/Patat/Presentation/Read.hs
index 07bc72e..581c31d 100644
--- a/src/Patat/Presentation/Read.hs
+++ b/src/Patat/Presentation/Read.hs
@@ -12,7 +12,6 @@ import Control.Monad.Except (ExceptT (..), runExceptT,
throwError)
import Control.Monad.Trans (liftIO)
import qualified Data.Aeson as A
-import qualified Data.ByteString as B
import qualified Data.HashMap.Strict as HMS
import Data.Maybe (fromMaybe)
import Data.Monoid (mempty, (<>))
@@ -97,8 +96,8 @@ pandocToPresentation pFilePath pSettings pandoc@(Pandoc.Pandoc meta _) = do
-- since those /can/ contain markdown.
parseMetadataBlock :: T.Text -> Maybe A.Value
parseMetadataBlock src = do
- block <- mbBlock
- Yaml.decode $! T.encodeUtf8 block
+ block <- T.encodeUtf8 <$> mbBlock
+ either (const Nothing) Just (Yaml.decodeEither' block)
where
mbBlock :: Maybe T.Text
mbBlock = case T.lines src of
@@ -132,8 +131,10 @@ readHomeSettings = do
if not exists
then return (Right mempty)
else do
- contents <- B.readFile path
- return $! Yaml.decodeEither contents
+ errOrPs <- Yaml.decodeFileEither path
+ return $! case errOrPs of
+ Left err -> Left (show err)
+ Right ps -> Right ps
--------------------------------------------------------------------------------
diff --git a/src/Patat/PrettyPrint.hs b/src/Patat/PrettyPrint.hs
index eb52b02..bffa274 100644
--- a/src/Patat/PrettyPrint.hs
+++ b/src/Patat/PrettyPrint.hs
@@ -17,6 +17,7 @@ module Patat.PrettyPrint
, string
, text
, space
+ , spaces
, softline
, hardline
@@ -319,6 +320,11 @@ space = mkDoc Softspace
--------------------------------------------------------------------------------
+spaces :: Int -> Doc
+spaces n = mconcat $ replicate n space
+
+
+--------------------------------------------------------------------------------
softline :: Doc
softline = mkDoc Softline
@@ -383,15 +389,15 @@ align width alignment doc0 =
alignLine :: [Chunk] -> [Chunk]
alignLine line =
- let actual = lineWidth line
- spaces n = [StringChunk [] (replicate n ' ')] in
+ let actual = lineWidth line
+ chunkSpaces n = [StringChunk [] (replicate n ' ')] in
case alignment of
- AlignLeft -> line <> spaces (width - actual)
- AlignRight -> spaces (width - actual) <> line
+ AlignLeft -> line <> chunkSpaces (width - actual)
+ AlignRight -> chunkSpaces (width - actual) <> line
AlignCenter ->
let r = (width - actual) `div` 2
l = (width - actual) - r in
- spaces l <> line <> spaces r
+ chunkSpaces l <> line <> chunkSpaces r
--------------------------------------------------------------------------------
diff --git a/src/Patat/Theme.hs b/src/Patat/Theme.hs
index 5d383a9..a49b5fb 100644
--- a/src/Patat/Theme.hs
+++ b/src/Patat/Theme.hs
@@ -15,20 +15,22 @@ module Patat.Theme
--------------------------------------------------------------------------------
-import Control.Monad (forM_, mplus)
-import qualified Data.Aeson as A
-import qualified Data.Aeson.TH.Extended as A
-import Data.Char (toLower, toUpper)
-import Data.List (intercalate, isSuffixOf)
-import qualified Data.Map as M
-import Data.Maybe (mapMaybe, maybeToList)
-import Data.Monoid (Monoid (..))
-import Data.Semigroup (Semigroup (..))
-import qualified Data.Text as T
+import Control.Monad (forM_, mplus)
+import qualified Data.Aeson as A
+import qualified Data.Aeson.TH.Extended as A
+import Data.Char (toLower, toUpper)
+import Data.Colour.SRGB (RGB(..), sRGB24reads, toSRGB24)
+import Data.List (intercalate, isPrefixOf, isSuffixOf)
+import qualified Data.Map as M
+import Data.Maybe (mapMaybe, maybeToList)
+import Data.Monoid (Monoid (..))
+import Data.Semigroup (Semigroup (..))
+import qualified Data.Text as T
+import Numeric (showHex)
import Prelude
-import qualified Skylighting as Skylighting
-import qualified System.Console.ANSI as Ansi
-import Text.Read (readMaybe)
+import qualified Skylighting as Skylighting
+import qualified System.Console.ANSI as Ansi
+import Text.Read (readMaybe)
--------------------------------------------------------------------------------
@@ -140,7 +142,7 @@ newtype Style = Style {unStyle :: [Ansi.SGR]}
--------------------------------------------------------------------------------
instance A.ToJSON Style where
- toJSON = A.toJSON . mapMaybe nameForSGR . unStyle
+ toJSON = A.toJSON . mapMaybe sgrToString . unStyle
--------------------------------------------------------------------------------
@@ -150,16 +152,34 @@ instance A.FromJSON Style where
sgrs <- mapM toSgr names
return $! Style sgrs
where
- toSgr name = case M.lookup name sgrsByName of
+ toSgr name = case stringToSgr name of
Just sgr -> return sgr
Nothing -> fail $!
"Unknown style: " ++ show name ++ ". Known styles are: " ++
- intercalate ", " (map show $ M.keys sgrsByName)
+ intercalate ", " (map show $ M.keys namedSgrs) ++
+ ", or \"rgb#RrGgBb\" and \"onRgb#RrGgBb\" where 'Rr', " ++
+ "'Gg' and 'Bb' are hexadecimal bytes (e.g. \"rgb#f08000\")."
--------------------------------------------------------------------------------
-nameForSGR :: Ansi.SGR -> Maybe String
-nameForSGR (Ansi.SetColor layer intensity color) = Just $
+stringToSgr :: String -> Maybe Ansi.SGR
+stringToSgr s
+ | "rgb#" `isPrefixOf` s = rgbToSgr Ansi.Foreground $ drop 4 s
+ | "onRgb#" `isPrefixOf` s = rgbToSgr Ansi.Background $ drop 6 s
+ | otherwise = M.lookup s namedSgrs
+
+
+--------------------------------------------------------------------------------
+rgbToSgr :: Ansi.ConsoleLayer -> String -> Maybe Ansi.SGR
+rgbToSgr layer rgbHex =
+ case sRGB24reads rgbHex of
+ [(color, "")] -> Just $ Ansi.SetRGBColor layer color
+ _ -> Nothing
+
+
+--------------------------------------------------------------------------------
+sgrToString :: Ansi.SGR -> Maybe String
+sgrToString (Ansi.SetColor layer intensity color) = Just $
(\str -> case layer of
Ansi.Foreground -> str
Ansi.Background -> "on" ++ capitalize str) $
@@ -176,23 +196,34 @@ nameForSGR (Ansi.SetColor layer intensity color) = Just $
Ansi.Cyan -> "Cyan"
Ansi.White -> "White")
-nameForSGR (Ansi.SetUnderlining Ansi.SingleUnderline) = Just "underline"
+sgrToString (Ansi.SetUnderlining Ansi.SingleUnderline) = Just "underline"
-nameForSGR (Ansi.SetConsoleIntensity Ansi.BoldIntensity) = Just "bold"
+sgrToString (Ansi.SetConsoleIntensity Ansi.BoldIntensity) = Just "bold"
+
+sgrToString (Ansi.SetRGBColor layer color) = Just $
+ (\str -> case layer of
+ Ansi.Foreground -> str
+ Ansi.Background -> "on" ++ capitalize str) $
+ "rgb#" ++ (toRGBHex $ toSRGB24 color)
+ where
+ toRGBHex (RGB r g b) = concat $ map toHexByte [r, g, b]
+ toHexByte x = showHex2 x ""
+ showHex2 x | x <= 0xf = ("0" ++) . showHex x
+ | otherwise = showHex x
-nameForSGR _ = Nothing
+sgrToString _ = Nothing
--------------------------------------------------------------------------------
-sgrsByName :: M.Map String Ansi.SGR
-sgrsByName = M.fromList
+namedSgrs :: M.Map String Ansi.SGR
+namedSgrs = M.fromList
[ (name, sgr)
| sgr <- knownSgrs
- , name <- maybeToList (nameForSGR sgr)
+ , name <- maybeToList (sgrToString sgr)
]
where
-- | It doesn't really matter if we generate "too much" SGRs here since
- -- 'nameForSGR' will only pick the ones we support.
+ -- 'sgrToString' will only pick the ones we support.
knownSgrs =
[ Ansi.SetColor l i c
| l <- [minBound .. maxBound]