patat 0.8.9.0 → 0.9.0.0

raw patch · 16 files changed

+946/−525 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +277/−182
• README.md +67/−24
• lib/Data/Sequence/Extended.hs +16/−0
• lib/Patat/Eval.hs +5/−4
• lib/Patat/Main.hs +28/−6
• lib/Patat/Presentation.hs +2/−0
• lib/Patat/Presentation/Display.hs +134/−116
• lib/Patat/Presentation/Display/CodeBlock.hs +24/−22
• lib/Patat/Presentation/Display/Internal.hs +27/−0
• lib/Patat/Presentation/Display/Table.hs +14/−22
• lib/Patat/Presentation/Internal.hs +80/−62
• lib/Patat/Presentation/Read.hs +90/−65
• lib/Patat/Presentation/SpeakerNotes.hs +105/−0
• lib/Text/Pandoc/Extended.hs +21/−3
• patat.cabal +5/−1
• tests/haskell/Patat/Presentation/Read/Tests.hs +51/−18

@@ -1,238 +1,333 @@ # Changelog -- 0.8.9.0 (2023-06-27)-    * Apply block quote theming to entire block (#119) (#111)-    * Fix table header theming (#128)-    * Dependency updates:-        - `aeson` to 2.1-        - `optparse-applicative` to 0.18-        - `pandoc` to 3.1-        - `pandoc-types` to 1.23-        - `text` to 2.0-        - `time` to 1.12+## 0.9.0.0 (2023-09-13) -- 0.8.8.0 (2022-10-26)-    * Allow hiding slide number (contribution by Paweł Dybiec)-    * Support additional markdown extensions (contribution by Spreadcat)-    * Dependency updates:-        - `aeson` to 2.0-        - `ansi-terminal` to 0.11-        - `base64-bytestring` to 1.2-        - `bytestring` to 0.11-        - `optparse-applicative` to 1.16-        - `pandoc` to 2.19-        - `skylighting` to 0.13+ *  Add proper support for speaker notes (#142) -- 0.8.7.0 (2021-03-12)-    * Fix alignment and display of CJK characters in presentation title, author-      and tables-    * Add support for showing images in Kitty terminal-    * Search in `$PATH` for `w3mimgdisplay`-    * Bump `pandoc` dependency to 2.11-    * Refactor `Patat.Presentation.Display` module to make it pure+    You can configure `patat` to write the speaker notes for the current slide+    to a file whenever the slide changes: -- 0.8.6.1 (2020-09-18)-    * Fix issue with laziness for evaluted code blocks, they should only be-      evaluated when we actually want to show them-    * Bump stack resolver to `lts-16.9`+        patat:+          speakerNotes:+            file: /tmp/notes.txt -- 0.8.6.0 (2020-09-11)-    * Allow evaluating code blocks (see README for more info)-    * Refactor implementation of fragments-    * Add breadcrumbs to title based on headers-    * Error out when YAML parsing fails+    Then, you can display these in a second terminal (presumably on a second+    monitor) by just displaying this file whenever it changes.  [entr] is one+    way to do that: -- 0.8.5.0 (2020-06-29)-    * Bump `pandoc` dependency to 2.9-    * Switch to `goldplate` for testing+        echo /tmp/notes.txt | entr -s 'clear; cat /tmp/notes.txt' -- 0.8.4.3 (2020-01-21)-    * Fix Haddock syntax in some comments (contribution by Asad Saeeduddin)+    [entr]: http://eradman.com/entrproject/ -- 0.8.4.2 (2020-01-18)-    * Add builds for Mac OS-    * Refactor CircleCI config & Makefile+    Alternatively, just use a second `patat` instance with `--watch` enabled: -- 0.8.4.1 (2019-10-29)-    * Bump CircleCI configuration-    * Bump release script-    * Add slide seeking to `--help` output+        patat -w /tmp/notes.txt -- 0.8.4.0 (2019-10-09)-    * Add slide seeking (enter slide number + `enter`)-    * Fix turning tty echo off/on during presentation-    * Run `w3mimgdisplay` cleanup action, fixing image issues on some terminals+ *  Add support for showing plain text files (#141) -- 0.8.3.0 (2019-09-07)-    * Fix test failure again, and ensure that it works for multiple pandoc-      versions by slightly modifying test input-    * Include pandoc version info in `patat --version`+    This isn't super useful on its own, it's meant to support speaker notes. -- 0.8.2.5 (2019-08-12)-    * Fix test failure caused by slightly different pandoc output for lists+ *  Add syntaxDefinitions to settings (#140) -- 0.8.2.4 (2019-08-12)-    * Bump `optparse-applicative` upper bound to 0.16-    * Bump `skylighting` upper bound to 0.9+    This allows users to add custom kate highlighting XML files in the settings: -- 0.8.2.3 (2019-06-25)-    * Bump upper `pandoc` dependency to 2.8+        ---+        patat:+          syntaxDefinitions:+          - 'impurescript.xml'+        ... -- 0.8.2.2 (2019-02-04)-    * Bump lower `base` dependency to 4.8+        Here is some *im*purescript: -- 0.8.2.1 (2019-02-03)-    * Bump `pandoc` to 2.6-    * Bump `ansi-terminal` to 0.10+        ```impurescript+        ...+        ``` -- 0.8.2.0 (2019-01-24)-    * GHC 7.8 compatibility+## 0.8.9.0 (2023-06-27) -- 0.8.1.3 (2019-01-24)-    * Bump `pandoc` to 2.4-    * Bump `yaml` to 0.11+* Apply block quote theming to entire block (#119) (#111)+* Fix table header theming (#128)+* Dependency updates:+    - `aeson` to 2.1+    - `optparse-applicative` to 0.18+    - `pandoc` to 3.1+    - `pandoc-types` to 1.23+    - `text` to 2.0+    - `time` to 1.12 -- 0.8.1.2 (2018-10-29)-    * Work around test failure caused by slightly different syntax highlighting-      in different pandoc versions+## 0.8.8.0 (2022-10-26) -- 0.8.1.1 (2018-10-26)-    * Tickle CircleCI cache+* Allow hiding slide number (contribution by Paweł Dybiec)+* Support additional markdown extensions (contribution by Spreadcat)+* Dependency updates:+    - `aeson` to 2.0+    - `ansi-terminal` to 0.11+    - `base64-bytestring` to 1.2+    - `bytestring` to 0.11+    - `optparse-applicative` to 1.16+    - `pandoc` to 2.19+    - `skylighting` to 0.13 -- 0.8.1.0 (2018-10-26)-    * Add support for italic ansi code in themes-    * Fix centered titles not being centered (contribution by Hamza Haiken)+## 0.8.7.0 (2021-03-12) -- 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)+* Fix alignment and display of CJK characters in presentation title, author+  and tables+* Add support for showing images in Kitty terminal+* Search in `$PATH` for `w3mimgdisplay`+* Bump `pandoc` dependency to 2.11+* Refactor `Patat.Presentation.Display` module to make it pure -- 0.7.2.0 (2018-05-08)-    * GHC 8.4 compatibility+## 0.8.6.1 (2020-09-18) -- 0.7.1.0 (2018-05-08)-    * GHC 8.4 compatibility+* Fix issue with laziness for evaluted code blocks, they should only be+  evaluated when we actually want to show them+* Bump stack resolver to `lts-16.9` -- 0.7.0.0 (2018-05-04)-    * Support HTML-style comments+## 0.8.6.0 (2020-09-11) -- 0.6.1.2 (2018-04-30)-    * Bump `pandoc` to 2.2+* Allow evaluating code blocks (see README for more info)+* Refactor implementation of fragments+* Add breadcrumbs to title based on headers+* Error out when YAML parsing fails -- 0.6.1.1 (2018-04-27)-    * Bump `aeson` to 1.3-    * Bump `skylighting` to 0.7-    * Bump `time` to 1.9-    * Bump `ansi-terminal` to 0.8+## 0.8.5.0 (2020-06-29) -- 0.6.1.0 (2018-01-28)-    * Bump `skylighting` to 0.6-    * Bump `pandoc` to 2.1-    * Bump `ansi-terminal` to 0.7+* Bump `pandoc` dependency to 2.9+* Switch to `goldplate` for testing -- 0.6.0.1 (2017-12-24)-    * Automatically upload linux binary to GitHub+## 0.8.4.3 (2020-01-21) -- 0.6.0.0 (2017-12-19)-    * Make pandoc extensions customizable in the configuration-    * Bump `pandoc` to 2.0+* Fix Haddock syntax in some comments (contribution by Asad Saeeduddin) -- 0.5.2.2 (2017-06-14)-    * Add `network-uri` dependency to fix travis build+## 0.8.4.2 (2020-01-18) -- 0.5.2.1 (2017-06-14)-    * Bump `optparse-applicative-0.14` dependency+* Add builds for Mac OS+* Refactor CircleCI config & Makefile -- 0.5.2.0 (2017-05-16)-    * Add navigation using `PageUp` and `PageDown`.-    * Use `skylighting` instead of deprecated `highlighting-kate` for syntax-      highlighting.+## 0.8.4.1 (2019-10-29) -- 0.5.1.2 (2017-04-26)-    * Make build reproducible even if timezone changes (patch by Félix Sipma)+* Bump CircleCI configuration+* Bump release script+* Add slide seeking to `--help` output -- 0.5.1.1 (2017-04-23)-    * Include `README` in `Extra-source-files` so it gets displayed on Hackage+## 0.8.4.0 (2019-10-09) -- 0.5.1.0 (2017-04-23)-    * Bump `aeson-1.2` dependency-    * Fix vertical alignment of title slides-    * Fix wrapping issue with inline code at end of line-    * Add bash-completion script generation to Makefile+* Add slide seeking (enter slide number + `enter`)+* Fix turning tty echo off/on during presentation+* Run `w3mimgdisplay` cleanup action, fixing image issues on some terminals -- 0.5.0.0 (2017-02-06)-    * Add a `slideLevel` option & autodetect it.  This changes the way `patat`-      splits slides.  For more information, see the `README` or the `man` page.-      If you just want to get the old behavior back, just add:+## 0.8.3.0 (2019-09-07) -            ----            patat:-              slideLevel: 1-            ...+* Fix test failure again, and ensure that it works for multiple pandoc+  versions by slightly modifying test input+* Include pandoc version info in `patat --version` -        To the top of your presentation.+## 0.8.2.5 (2019-08-12) -    * Clear the screen when finished with the presentation.+* Fix test failure caused by slightly different pandoc output for lists -- 0.4.7.1 (2017-01-22)-    * Bump `directory-1.3` dependency-    * Bump `time-1.7` dependency+## 0.8.2.4 (2019-08-12) -- 0.4.7.0 (2017-01-20)-    * Bump `aeson-1.1` dependency-    * Parse YAML for settings using `yaml` instead of pandoc-    * Clarify watch & autoAdvance combination in documentation.+* Bump `optparse-applicative` upper bound to 0.16+* Bump `skylighting` upper bound to 0.9 -- 0.4.6.0 (2016-12-28)-    * Redraw the screen on unknown commands to prevent accidental typing from-      showing up.-    * Make the cursor invisible during the presentation.-    * Move the footer down one more line to gain some screen real estate.+## 0.8.2.3 (2019-06-25) -- 0.4.5.0 (2016-12-05)-    * Render the date in a locale-independent manner (patch by Daniel-      Shahaf).+* Bump upper `pandoc` dependency to 2.8 -- 0.4.4.0 (2016-12-03)-    * Force the use of UTF-8 when generating the man page.+## 0.8.2.2 (2019-02-04) -- 0.4.3.0 (2016-12-02)-    * Use `SOURCE_DATE_EPOCH` if it is present instead of getting the date from-      `git log`.+* Bump lower `base` dependency to 4.8 -- 0.4.2.0 (2016-12-01)-    * Fix issues with man page generation on Travis.+## 0.8.2.1 (2019-02-03) -- 0.4.1.0 (2016-12-01)-    * Fix compatibility with `pandoc-1.18` and `pandoc-1.19`.-    * Add a man page.+* Bump `pandoc` to 2.6+* Bump `ansi-terminal` to 0.10 -- 0.4.0.0 (2016-11-15)-    * Add configurable auto advancing.-    * Support fragmented slides.+## 0.8.2.0 (2019-01-24) -- 0.3.3.0 (2016-10-31)-    * Add a `--version` flag.-    * Add support for `pandoc-1.18` which includes a new `LineBlock` element.+* GHC 7.8 compatibility -- 0.3.2.0 (2016-10-20)-    * Keep running even if errors are encountered during reload.+## 0.8.1.3 (2019-01-24) -- 0.3.1.0 (2016-10-18)-    * Fix compilation with `lts-6.22`.+* Bump `pandoc` to 2.4+* Bump `yaml` to 0.11 -- 0.3.0.0 (2016-10-17)-    * Add syntax highlighting support.-    * Fixed slide clipping after reload.+## 0.8.1.2 (2018-10-29) -- 0.2.0.0 (2016-10-13)-    * Add theming support.-    * Fix links display.-    * Add support for wrapping.-    * Allow org mode as input format.+* Work around test failure caused by slightly different syntax highlighting+  in different pandoc versions -- 0.1.0.0 (2016-10-02)-    * Upload first version from hotel wifi in Kalaw.+## 0.8.1.1 (2018-10-26)++* Tickle CircleCI cache++## 0.8.1.0 (2018-10-26)++* Add support for italic ansi code in themes+* Fix centered titles not being centered (contribution by Hamza Haiken)++## 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++## 0.7.1.0 (2018-05-08)++* GHC 8.4 compatibility++## 0.7.0.0 (2018-05-04)++* Support HTML-style comments++## 0.6.1.2 (2018-04-30)++* Bump `pandoc` to 2.2++## 0.6.1.1 (2018-04-27)++* Bump `aeson` to 1.3+* Bump `skylighting` to 0.7+* Bump `time` to 1.9+* Bump `ansi-terminal` to 0.8++## 0.6.1.0 (2018-01-28)++* Bump `skylighting` to 0.6+* Bump `pandoc` to 2.1+* Bump `ansi-terminal` to 0.7++## 0.6.0.1 (2017-12-24)++* Automatically upload linux binary to GitHub++## 0.6.0.0 (2017-12-19)++* Make pandoc extensions customizable in the configuration+* Bump `pandoc` to 2.0++## 0.5.2.2 (2017-06-14)++* Add `network-uri` dependency to fix travis build++## 0.5.2.1 (2017-06-14)++* Bump `optparse-applicative-0.14` dependency++## 0.5.2.0 (2017-05-16)++* Add navigation using `PageUp` and `PageDown`.+* Use `skylighting` instead of deprecated `highlighting-kate` for syntax+  highlighting.++## 0.5.1.2 (2017-04-26)++* Make build reproducible even if timezone changes (patch by Félix Sipma)++## 0.5.1.1 (2017-04-23)++* Include `README` in `Extra-source-files` so it gets displayed on Hackage++## 0.5.1.0 (2017-04-23)++* Bump `aeson-1.2` dependency+* Fix vertical alignment of title slides+* Fix wrapping issue with inline code at end of line+* Add bash-completion script generation to Makefile++## 0.5.0.0 (2017-02-06)++* Add a `slideLevel` option & autodetect it.  This changes the way `patat`+  splits slides.  For more information, see the `README` or the `man` page.+  If you just want to get the old behavior back, just add:++        ---+        patat:+          slideLevel: 1+        ...++    To the top of your presentation.++* Clear the screen when finished with the presentation.++## 0.4.7.1 (2017-01-22)++* Bump `directory-1.3` dependency+* Bump `time-1.7` dependency++## 0.4.7.0 (2017-01-20)++* Bump `aeson-1.1` dependency+* Parse YAML for settings using `yaml` instead of pandoc+* Clarify watch & autoAdvance combination in documentation.++## 0.4.6.0 (2016-12-28)++* Redraw the screen on unknown commands to prevent accidental typing from+  showing up.+* Make the cursor invisible during the presentation.+* Move the footer down one more line to gain some screen real estate.++## 0.4.5.0 (2016-12-05)++* Render the date in a locale-independent manner (patch by Daniel+  Shahaf).++## 0.4.4.0 (2016-12-03)++* Force the use of UTF-8 when generating the man page.++## 0.4.3.0 (2016-12-02)++* Use `SOURCE_DATE_EPOCH` if it is present instead of getting the date from+  `git log`.++## 0.4.2.0 (2016-12-01)++* Fix issues with man page generation on Travis.++## 0.4.1.0 (2016-12-01)++* Fix compatibility with `pandoc-1.18` and `pandoc-1.19`.+* Add a man page.++## 0.4.0.0 (2016-11-15)++* Add configurable auto advancing.+* Support fragmented slides.++## 0.3.3.0 (2016-10-31)++* Add a `--version` flag.+* Add support for `pandoc-1.18` which includes a new `LineBlock` element.++## 0.3.2.0 (2016-10-20)++* Keep running even if errors are encountered during reload.++## 0.3.1.0 (2016-10-18)++* Fix compilation with `lts-6.22`.++## 0.3.0.0 (2016-10-17)++* Add syntax highlighting support.+* Fixed slide clipping after reload.++## 0.2.0.0 (2016-10-13)++* Add theming support.+* Fix links display.+* Add support for wrapping.+* Allow org mode as input format.++## 0.1.0.0 (2016-10-02)++* Upload first version from hotel wifi in Kalaw.

@@ -14,17 +14,18 @@ - 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 including 24-bit RGB.+- Supports [evaluating code snippets and showing the result](#evaluating-code).+- Display [speaker notes](#speaker-notes) in a second window or monitor. - [Auto advancing](#auto-advancing) with configurable delay.+- Experimental [images](#images) support. - 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.-- Supports [evaluating code snippets and showing the result](#evaluating-code).+- [Theming](#theming) support including 24-bit RGB. - Written in [Haskell]. -![screenshot](extra/screenshot.png?raw=true)+![screenshot](extra/demo.gif?raw=true)  [Kate]: https://kate-editor.org/ [Haskell]: http://haskell.org/@@ -53,6 +54,7 @@     -   [Images](#images)     -   [Breadcrumbs](#breadcrumbs)     -   [Evaluating code](#evaluating-code)+    -   [Speaker notes](#speaker-notes) -   [Trivia](#trivia)  Installation@@ -241,26 +243,6 @@  For more information, see [Advanced slide splitting](#advanced-slide-splitting). -Patat supports comments which can be used as speaker notes.--```markdown-----title: This is my presentation-author: Jane Doe-...--# Chapter 1--<!---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. -->-```- Configuration ------------- @@ -489,6 +471,20 @@  ### Syntax Highlighting +`patat` uses [Kate] Syntax Highlighting files.  `patat` ships with support for+nearly one hundred languages thanks to Pandoc.  However, if your language is+not yet available, you can add the highlighting XML file in the settings:++```markdown+---+patat:+  syntaxDefinitions:+  - 'impurescript.xml'+...++...+```+ As part of theming, syntax highlighting is also configurable.  This can be configured like this: @@ -677,6 +673,53 @@ 2.  Write the contents of the code block to the `stdin` of the process 3.  Wait for the process to exit 4.  Render the `stdout` of the process++### Speaker Notes++`patat` supports comments which can be used as speaker notes.++```markdown+---+title: This is my presentation+author: Jane Doe+...++# Chapter 1++<!--+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. -->+```++You can also configure `patat` to write the speaker notes for the current slide+to a file whenever the slide changes:++```yaml+patat:+  speakerNotes:+    file: /tmp/notes.txt+```++Then, you can display these in a second terminal (presumably on a second+monitor) by just displaying this file whenever it changes.  [entr] is one+way to do that:++[entr]: http://eradman.com/entrproject/++```bash+echo /tmp/notes.txt | entr -s 'clear; cat /tmp/notes.txt'+```++Alternatively, just use a second `patat` instance with `--watch` enabled:++```bash+patat -w /tmp/notes.txt+```  Trivia ------

@@ -0,0 +1,16 @@+module Data.Sequence.Extended+    ( module Data.Sequence+    , cons+    , safeIndex+    ) where++import Data.Sequence++cons :: a -> Seq a -> Seq a+cons x xs = singleton x <> xs++safeIndex :: Seq a -> Int -> Maybe a+safeIndex s n+    | n < 0                       = Nothing+    | n >= Data.Sequence.length s = Nothing+    | otherwise                   = Just $ index s n

@@ -10,13 +10,13 @@ import qualified Control.Concurrent.Async       as Async import           Control.Exception              (finally) import qualified Data.HashMap.Strict            as HMS+import           Data.Maybe                     (maybeToList) import qualified Data.Text                      as T import qualified Data.Text.IO                   as T import           Patat.Presentation.Instruction import           Patat.Presentation.Internal import           System.Exit                    (ExitCode (..)) import qualified System.IO                      as IO-import Data.Maybe (maybeToList) import           System.IO.Unsafe               (unsafeInterleaveIO) import qualified System.Process                 as Process import qualified Text.Pandoc.Definition         as Pandoc@@ -40,10 +40,11 @@  -------------------------------------------------------------------------------- evalSlide :: EvalSettingsMap -> Slide -> IO Slide-evalSlide settings slide = case slide of+evalSlide settings slide = case slideContent slide of     TitleSlide _ _ -> pure slide-    ContentSlide instrs -> ContentSlide . fromList . concat <$>-        traverse (evalInstruction settings) (toList instrs)+    ContentSlide instrs0 -> do+        instrs1 <- traverse (evalInstruction settings) (toList instrs0)+        pure slide {slideContent = ContentSlide . fromList $ concat instrs1}   --------------------------------------------------------------------------------

@@ -15,6 +15,7 @@ import           Control.Exception               (bracket) import           Control.Monad                   (forever, unless, when) import qualified Data.Aeson.Extended             as A+import           Data.Foldable                   (for_) import           Data.Functor                    (($>)) import           Data.Time                       (UTCTime) import           Data.Version                    (showVersion)@@ -23,6 +24,7 @@ import           Patat.AutoAdvance import qualified Patat.Images                    as Images import           Patat.Presentation+import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes import qualified Patat.PrettyPrint               as PP import qualified Paths_patat import           Prelude@@ -137,14 +139,20 @@     unless (oForce options) assertAnsiFeatures      -- (Maybe) initialize images backend.-    images <- traverse Images.new (psImages $ pSettings pres)+    images <- traverse Images.new $ psImages $ pSettings pres -    if oDump options-        then dumpPresentation pres-        else interactiveLoop options images pres+    -- (Maybe) initialize speaker notes.+    withMaybeHandle SpeakerNotes.with+        (psSpeakerNotes $ pSettings pres) $ \speakerNotes ->++        if oDump options+            then dumpPresentation pres+            else interactiveLoop options images speakerNotes pres   where-    interactiveLoop :: Options -> Maybe Images.Handle -> Presentation -> IO ()-    interactiveLoop options images pres0 =+    interactiveLoop+        :: Options -> Maybe Images.Handle -> Maybe SpeakerNotes.Handle+        -> Presentation -> IO ()+    interactiveLoop options images speakerNotes pres0 =         interactively readPresentationCommand $ \commandChan0 -> do          -- If an auto delay is set, use 'autoAdvance' to create a new one.@@ -160,6 +168,9 @@          let loop :: Presentation -> Maybe String -> IO ()             loop pres mbError = do+                for_ speakerNotes $ \sn ->+                    SpeakerNotes.write sn $ activeSpeakerNotes pres+                 size <- getDisplaySize pres                 let display = case mbError of                         Nothing  -> displayPresentation size pres@@ -236,3 +247,14 @@     when (mtime1 > mtime0) $ Chan.writeChan chan Reload     threadDelay (200 * 1000)     watcher chan filePath mtime1+++--------------------------------------------------------------------------------+-- | Wrapper for optional handles.+withMaybeHandle+    :: (settings -> (handle -> IO a) -> IO a)+    -> Maybe settings+    -> (Maybe handle -> IO a)+    -> IO a+withMaybeHandle _    Nothing         f = f Nothing+withMaybeHandle impl (Just settings) f = impl settings (f . Just)

@@ -5,6 +5,8 @@     , Presentation (..)     , readPresentation +    , activeSpeakerNotes+     , Size     , getDisplaySize 

@@ -13,17 +13,19 @@   ---------------------------------------------------------------------------------import           Control.Monad                        (mplus)+import           Control.Monad                        (guard, mplus) import qualified Data.Aeson.Extended                  as A import           Data.Char.WCWidth.Extended           (wcstrwidth) import           Data.Data.Extended                   (grecQ) import qualified Data.List                            as L-import           Data.Maybe                           (fromMaybe, listToMaybe,-                                                       maybeToList)+import           Data.Maybe                           (fromMaybe, maybeToList)+import qualified Data.Sequence.Extended               as Seq import qualified Data.Text                            as T import           Patat.Presentation.Display.CodeBlock+import           Patat.Presentation.Display.Internal import           Patat.Presentation.Display.Table import           Patat.Presentation.Internal+import qualified Patat.Presentation.SpeakerNotes      as SpeakerNotes import           Patat.PrettyPrint                    ((<$$>), (<+>)) import qualified Patat.PrettyPrint                    as PP import           Patat.Theme                          (Theme (..))@@ -59,7 +61,7 @@ -- | Display something within the presentation borders that draw the title and -- the active slide number and so on. displayWithBorders-    :: Size -> Presentation -> (Size -> Theme -> PP.Doc) -> PP.Doc+    :: Size -> Presentation -> (Size -> DisplaySettings -> PP.Doc) -> PP.Doc displayWithBorders (Size rows columns) Presentation {..} f =     (if null title         then mempty@@ -67,7 +69,7 @@             let titleRemainder = columns - titleWidth - titleOffset                 wrappedTitle = PP.spaces titleOffset <> PP.string title <> PP.spaces titleRemainder in         borders wrappedTitle <> PP.hardline <> PP.hardline) <>-    formatWith settings (f canvasSize theme) <> PP.hardline <>+    formatWith settings (f canvasSize ds) <> PP.hardline <>     PP.goToLine (rows - 2) <>     borders (PP.space <> PP.string author <> middleSpaces <> PP.string active <> PP.space) <>     PP.hardline@@ -75,14 +77,17 @@     -- Get terminal width/title     (sidx, _)   = pActiveFragment     settings    = pSettings {psColumns = Just $ A.FlexibleNum columns}-    theme       = fromMaybe Theme.defaultTheme (psTheme settings)+    ds          = DisplaySettings+        { dsTheme     = fromMaybe Theme.defaultTheme (psTheme settings)+        , dsSyntaxMap = pSyntaxMap+        }      -- Compute title.-    breadcrumbs = fromMaybe [] . listToMaybe $ drop sidx pBreadcrumbs-    plainTitle  = PP.toString $ prettyInlines theme pTitle+    breadcrumbs = fromMaybe [] $ Seq.safeIndex pBreadcrumbs sidx+    plainTitle  = PP.toString $ prettyInlines ds pTitle     breadTitle  = mappend plainTitle $ mconcat         [ s-        | b <- map (prettyInlines theme . snd) breadcrumbs+        | b <- map (prettyInlines ds . snd) breadcrumbs         , s <- [" > ", PP.toString b]         ]     title@@ -93,7 +98,7 @@     -- Dimensions of title.     titleWidth  = wcstrwidth title     titleOffset = (columns - titleWidth) `div` 2-    borders     = themed (themeBorders theme)+    borders     = themed ds themeBorders      -- Room left for content     canvasSize = Size (rows - 2) columns@@ -103,7 +108,7 @@         | fromMaybe True $ psSlideNumber settings = show (sidx + 1) ++ " / " ++ show (length pSlides)         | otherwise                               = ""     activeWidth  = wcstrwidth active-    author       = PP.toString (prettyInlines theme pAuthor)+    author       = PP.toString (prettyInlines ds pAuthor)     authorWidth  = wcstrwidth author     middleSpaces = PP.spaces $ columns - activeWidth - authorWidth - 2 @@ -111,7 +116,7 @@ -------------------------------------------------------------------------------- displayPresentation :: Size -> Presentation -> Display displayPresentation size pres@Presentation {..} =-     case getActiveFragment pres of+     case activeFragment pres of         Nothing -> DisplayDoc $ displayWithBorders size pres mempty         Just (ActiveContent fragment)                 | Just _ <- psImages pSettings@@ -135,10 +140,10 @@     -- Check if the fragment consists of "just a single image".  Discard     -- headers.     onlyImage (Fragment (Pandoc.Header{} : bs)) = onlyImage (Fragment bs)-    onlyImage (Fragment bs) = case filter isVisibleBlock bs of-        [Pandoc.Figure _ _ bs'] -> onlyImage (Fragment bs')+    onlyImage (Fragment bs) = case bs of+        [Pandoc.Figure _ _ bs']                      -> onlyImage (Fragment bs')         [Pandoc.Para [Pandoc.Image _ _ (target, _)]] -> Just target-        _ -> Nothing+        _                                            -> Nothing   --------------------------------------------------------------------------------@@ -146,8 +151,8 @@ -- want to display an error but keep the presentation running. displayPresentationError :: Size -> Presentation -> String -> PP.Doc displayPresentationError size pres err =-    displayWithBorders size pres $ \_ Theme {..} ->-        themed themeStrong "Error occurred in the presentation:" <$$>+    displayWithBorders size pres $ \_ ds ->+        themed ds themeStrong "Error occurred in the presentation:" <$$>         "" <$$>         (PP.string err) @@ -155,19 +160,35 @@ -------------------------------------------------------------------------------- dumpPresentation :: Presentation -> IO () dumpPresentation pres@Presentation {..} =-    let sRows = fromMaybe 24 $ A.unFlexibleNum <$> psRows pSettings-        sCols = fromMaybe 72 $ A.unFlexibleNum <$> psColumns pSettings-        size  = Size {..} in     PP.putDoc $ PP.removeControls $ formatWith pSettings $-    PP.vcat $ L.intersperse "----------" $ do-        i <- [0 .. length pSlides - 1]+    PP.vcat $ L.intercalate ["{slide}"] $+        map dumpSlide [0 .. length pSlides - 1]+  where+    dumpSlide :: Int -> [PP.Doc]+    dumpSlide i = do         slide <- maybeToList $ getSlide i pres-        j <- [0 .. numFragments slide - 1]-        case displayPresentation size pres {pActiveFragment = (i, j)} of-            DisplayDoc doc -> [doc]-            DisplayImage filepath -> [PP.string $ "image:" ++ filepath]+        dumpSpeakerNotes slide <> L.intercalate ["{fragment}"]+            [ dumpFragment (i, j)+            | j <- [0 .. numFragments slide - 1]+            ] +    dumpSpeakerNotes :: Slide -> [PP.Doc]+    dumpSpeakerNotes slide = do+        guard $ slideSpeakerNotes slide /= mempty+        pure $ PP.text $ "{speakerNotes: " <>+            SpeakerNotes.toText (slideSpeakerNotes slide) <> "}" +    dumpFragment :: Index -> [PP.Doc]+    dumpFragment idx =+        case displayPresentation size pres {pActiveFragment = idx} of+            DisplayDoc doc        -> [doc]+            DisplayImage filepath -> [PP.string $ "{image: " ++ filepath ++ "}"]++    sRows = fromMaybe 24 $ A.unFlexibleNum <$> psRows pSettings+    sCols = fromMaybe 72 $ A.unFlexibleNum <$> psColumns pSettings+    size  = Size {..}++ -------------------------------------------------------------------------------- formatWith :: PresentationSettings -> PP.Doc -> PP.Doc formatWith ps = wrap . indent@@ -181,34 +202,34 @@   ---------------------------------------------------------------------------------prettyFragment :: Theme -> Fragment -> PP.Doc-prettyFragment theme (Fragment blocks) =-    prettyBlocks theme blocks <>-    case prettyReferences theme blocks of+prettyFragment :: DisplaySettings -> Fragment -> PP.Doc+prettyFragment ds (Fragment blocks) =+    prettyBlocks ds blocks <>+    case prettyReferences ds blocks of         []   -> mempty         refs -> PP.hardline <> PP.vcat refs   ---------------------------------------------------------------------------------prettyBlock :: Theme -> Pandoc.Block -> PP.Doc+prettyBlock :: DisplaySettings -> Pandoc.Block -> PP.Doc -prettyBlock theme (Pandoc.Plain inlines) = prettyInlines theme inlines+prettyBlock ds (Pandoc.Plain inlines) = prettyInlines ds inlines -prettyBlock theme (Pandoc.Para inlines) =-    prettyInlines theme inlines <> PP.hardline+prettyBlock ds (Pandoc.Para inlines) =+    prettyInlines ds inlines <> PP.hardline -prettyBlock theme@Theme {..} (Pandoc.Header i _ inlines) =-    themed themeHeader (PP.string (replicate i '#') <+> prettyInlines theme inlines) <>+prettyBlock ds (Pandoc.Header i _ inlines) =+    themed ds themeHeader (PP.string (replicate i '#') <+> prettyInlines ds inlines) <>     PP.hardline -prettyBlock theme (Pandoc.CodeBlock (_, classes, _) txt) =-    prettyCodeBlock theme classes txt+prettyBlock ds (Pandoc.CodeBlock (_, classes, _) txt) =+    prettyCodeBlock ds classes txt -prettyBlock theme (Pandoc.BulletList bss) = PP.vcat+prettyBlock ds (Pandoc.BulletList bss) = PP.vcat     [ PP.indent-        (PP.NotTrimmable $ themed (themeBulletList theme) prefix)+        (PP.NotTrimmable $ themed ds themeBulletList prefix)         (PP.Trimmable "    ")-        (prettyBlocks theme' bs)+        (prettyBlocks ds' bs)     | bs <- bss     ] <> PP.hardline   where@@ -218,16 +239,18 @@         _            -> '-'      -- Cycle the markers.+    theme  = dsTheme ds     theme' = theme         { themeBulletListMarkers =             (\ls -> T.drop 1 ls <> T.take 1 ls) <$> themeBulletListMarkers theme         }+    ds'    = ds {dsTheme = theme'} -prettyBlock theme@Theme {..} (Pandoc.OrderedList _ bss) = PP.vcat+prettyBlock ds (Pandoc.OrderedList _ bss) = PP.vcat     [ PP.indent-        (PP.NotTrimmable $ themed themeOrderedList $ PP.string prefix)+        (PP.NotTrimmable $ themed ds themeOrderedList $ PP.string prefix)         (PP.Trimmable "    ")-        (prettyBlocks theme bs)+        (prettyBlocks ds bs)     | (prefix, bs) <- zip padded bss     ] <> PP.hardline   where@@ -237,34 +260,34 @@         | i <- [1 .. length bss]         ] -prettyBlock _theme (Pandoc.RawBlock _ t) = PP.text t <> PP.hardline+prettyBlock _ds (Pandoc.RawBlock _ t) = PP.text t <> PP.hardline -prettyBlock _theme Pandoc.HorizontalRule = "---"+prettyBlock _ds Pandoc.HorizontalRule = "---" -prettyBlock theme@Theme {..} (Pandoc.BlockQuote bs) =-    let quote = PP.NotTrimmable (themed themeBlockQuote "> ") in-    PP.indent quote quote (themed themeBlockQuote $ prettyBlocks theme bs)+prettyBlock ds (Pandoc.BlockQuote bs) =+    let quote = PP.NotTrimmable (themed ds themeBlockQuote "> ") in+    PP.indent quote quote (themed ds themeBlockQuote $ prettyBlocks ds bs) -prettyBlock theme@Theme {..} (Pandoc.DefinitionList terms) =+prettyBlock ds (Pandoc.DefinitionList terms) =     PP.vcat $ map prettyDefinition terms   where     prettyDefinition (term, definitions) =-        themed themeDefinitionTerm (prettyInlines theme term) <$$>+        themed ds themeDefinitionTerm (prettyInlines ds term) <$$>         PP.hardline <> PP.vcat         [ PP.indent-            (PP.NotTrimmable (themed themeDefinitionList ":   "))+            (PP.NotTrimmable (themed ds themeDefinitionList ":   "))             (PP.Trimmable "    ") $-            prettyBlocks theme (Pandoc.plainToPara definition)+            prettyBlocks ds (Pandoc.plainToPara definition)         | definition <- definitions         ] -prettyBlock theme (Pandoc.Table _ caption specs thead tbodies tfoot) =+prettyBlock ds (Pandoc.Table _ caption specs thead tbodies tfoot) =     PP.wrapAt Nothing $-    prettyTable theme Table-        { tCaption = prettyInlines theme caption'+    prettyTable ds Table+        { tCaption = prettyInlines ds caption'         , tAligns  = map align aligns-        , tHeaders = map (prettyBlocks theme) headers-        , tRows    = map (map (prettyBlocks theme)) rows+        , tHeaders = map (prettyBlocks ds) headers+        , tRows    = map (map (prettyBlocks ds)) rows         }   where     (caption', aligns, _, headers, rows) = Pandoc.toLegacyTable@@ -275,90 +298,91 @@     align Pandoc.AlignDefault = PP.AlignLeft     align Pandoc.AlignRight   = PP.AlignRight -prettyBlock theme (Pandoc.Div _attrs blocks) = prettyBlocks theme blocks+prettyBlock ds (Pandoc.Div _attrs blocks) = prettyBlocks ds blocks -prettyBlock theme@Theme {..} (Pandoc.LineBlock inliness) =-    let ind = PP.NotTrimmable (themed themeLineBlock "| ") in+prettyBlock ds (Pandoc.LineBlock inliness) =+    let ind = PP.NotTrimmable (themed ds themeLineBlock "| ") in     PP.wrapAt Nothing $     PP.indent ind ind $     PP.vcat $-    map (prettyInlines theme) inliness+    map (prettyInlines ds) inliness -prettyBlock theme (Pandoc.Figure _attr _caption blocks) =-    prettyBlocks theme blocks+prettyBlock ds (Pandoc.Figure _attr _caption blocks) =+    prettyBlocks ds blocks + ---------------------------------------------------------------------------------prettyBlocks :: Theme -> [Pandoc.Block] -> PP.Doc-prettyBlocks theme = PP.vcat . map (prettyBlock theme) . filter isVisibleBlock+prettyBlocks :: DisplaySettings -> [Pandoc.Block] -> PP.Doc+prettyBlocks ds = PP.vcat . map (prettyBlock ds)   ---------------------------------------------------------------------------------prettyInline :: Theme -> Pandoc.Inline -> PP.Doc+prettyInline :: DisplaySettings -> Pandoc.Inline -> PP.Doc -prettyInline _theme Pandoc.Space = PP.space+prettyInline _ds Pandoc.Space = PP.space -prettyInline _theme (Pandoc.Str str) = PP.text str+prettyInline _ds (Pandoc.Str str) = PP.text str -prettyInline theme@Theme {..} (Pandoc.Emph inlines) =-    themed themeEmph $-    prettyInlines theme inlines+prettyInline ds (Pandoc.Emph inlines) =+    themed ds themeEmph $+    prettyInlines ds inlines -prettyInline theme@Theme {..} (Pandoc.Strong inlines) =-    themed themeStrong $-    prettyInlines theme inlines+prettyInline ds (Pandoc.Strong inlines) =+    themed ds themeStrong $+    prettyInlines ds inlines -prettyInline theme@Theme {..} (Pandoc.Underline inlines) =-    themed themeUnderline $-    prettyInlines theme inlines+prettyInline ds (Pandoc.Underline inlines) =+    themed ds themeUnderline $+    prettyInlines ds inlines -prettyInline Theme {..} (Pandoc.Code _ txt) =-    themed themeCode $+prettyInline ds (Pandoc.Code _ txt) =+    themed ds themeCode $     PP.text (" " <> txt <> " ") -prettyInline theme@Theme {..} link@(Pandoc.Link _attrs text (target, _title))+prettyInline ds link@(Pandoc.Link _attrs text (target, _title))     | isReferenceLink link =-        "[" <> themed themeLinkText (prettyInlines theme text) <> "]"+        "[" <> themed ds themeLinkText (prettyInlines ds text) <> "]"     | otherwise =-        "<" <> themed themeLinkTarget (PP.text target) <> ">"+        "<" <> themed ds themeLinkTarget (PP.text target) <> ">" -prettyInline _theme Pandoc.SoftBreak = PP.softline+prettyInline _ds Pandoc.SoftBreak = PP.softline -prettyInline _theme Pandoc.LineBreak = PP.hardline+prettyInline _ds Pandoc.LineBreak = PP.hardline -prettyInline theme@Theme {..} (Pandoc.Strikeout t) =-    "~~" <> themed themeStrikeout (prettyInlines theme t) <> "~~"+prettyInline ds (Pandoc.Strikeout t) =+    "~~" <> themed ds themeStrikeout (prettyInlines ds t) <> "~~" -prettyInline theme@Theme {..} (Pandoc.Quoted Pandoc.SingleQuote t) =-    "'" <> themed themeQuoted (prettyInlines theme t) <> "'"-prettyInline theme@Theme {..} (Pandoc.Quoted Pandoc.DoubleQuote t) =-    "'" <> themed themeQuoted (prettyInlines theme t) <> "'"+prettyInline ds (Pandoc.Quoted Pandoc.SingleQuote t) =+    "'" <> themed ds themeQuoted (prettyInlines ds t) <> "'"+prettyInline ds (Pandoc.Quoted Pandoc.DoubleQuote t) =+    "'" <> themed ds themeQuoted (prettyInlines ds t) <> "'" -prettyInline Theme {..} (Pandoc.Math _ t) =-    themed themeMath (PP.text t)+prettyInline ds (Pandoc.Math _ t) =+    themed ds themeMath (PP.text t) -prettyInline theme@Theme {..} (Pandoc.Image _attrs text (target, _title)) =-    "![" <> themed themeImageText (prettyInlines theme text) <> "](" <>-    themed themeImageTarget (PP.text target) <> ")"+prettyInline ds (Pandoc.Image _attrs text (target, _title)) =+    "![" <> themed ds themeImageText (prettyInlines ds text) <> "](" <>+    themed ds themeImageTarget (PP.text target) <> ")"  -- These elements aren't really supported.-prettyInline theme  (Pandoc.Cite      _ t) = prettyInlines theme t-prettyInline theme  (Pandoc.Span      _ t) = prettyInlines theme t-prettyInline _theme (Pandoc.RawInline _ t) = PP.text t-prettyInline theme  (Pandoc.Note        t) = prettyBlocks  theme t-prettyInline theme  (Pandoc.Superscript t) = prettyInlines theme t-prettyInline theme  (Pandoc.Subscript   t) = prettyInlines theme t-prettyInline theme  (Pandoc.SmallCaps   t) = prettyInlines theme t+prettyInline ds  (Pandoc.Cite      _ t) = prettyInlines ds t+prettyInline ds  (Pandoc.Span      _ t) = prettyInlines ds t+prettyInline _ds (Pandoc.RawInline _ t) = PP.text t+prettyInline ds  (Pandoc.Note        t) = prettyBlocks  ds t+prettyInline ds  (Pandoc.Superscript t) = prettyInlines ds t+prettyInline ds  (Pandoc.Subscript   t) = prettyInlines ds t+prettyInline ds  (Pandoc.SmallCaps   t) = prettyInlines ds t -- prettyInline unsupported = PP.ondullred $ PP.string $ show unsupported   ---------------------------------------------------------------------------------prettyInlines :: Theme -> [Pandoc.Inline] -> PP.Doc-prettyInlines theme = mconcat . map (prettyInline theme)+prettyInlines :: DisplaySettings -> [Pandoc.Inline] -> PP.Doc+prettyInlines ds = mconcat . map (prettyInline ds)   ---------------------------------------------------------------------------------prettyReferences :: Theme -> [Pandoc.Block] -> [PP.Doc]-prettyReferences theme@Theme {..} =+prettyReferences :: DisplaySettings -> [Pandoc.Block] -> [PP.Doc]+prettyReferences ds =     map prettyReference . getReferences   where     getReferences :: [Pandoc.Block] -> [Pandoc.Inline]@@ -367,9 +391,10 @@     prettyReference :: Pandoc.Inline -> PP.Doc     prettyReference (Pandoc.Link _attrs text (target, title)) =         "[" <>-        themed themeLinkText (prettyInlines theme $ Pandoc.newlineToSpace text) <>+        themed ds themeLinkText+            (prettyInlines ds $ Pandoc.newlineToSpace text) <>         "](" <>-        themed themeLinkTarget (PP.text target) <>+        themed ds themeLinkTarget (PP.text target) <>         (if T.null title             then mempty             else PP.space <> "\"" <> PP.text title <> "\"")@@ -382,10 +407,3 @@ isReferenceLink (Pandoc.Link _attrs text (target, _)) =     [Pandoc.Str target] /= text isReferenceLink _ = False------------------------------------------------------------------------------------isVisibleBlock :: Pandoc.Block -> Bool-isVisibleBlock (Pandoc.RawBlock (Pandoc.Format "html") t) =-    not ("<!--" `T.isPrefixOf` t && "-->" `T.isSuffixOf` t)-isVisibleBlock _ = True

@@ -1,30 +1,31 @@ -------------------------------------------------------------------------------- -- | Displaying code blocks, optionally with syntax highlighting. {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-} module Patat.Presentation.Display.CodeBlock     ( prettyCodeBlock     ) where   ---------------------------------------------------------------------------------import           Data.Maybe                       (mapMaybe)-import qualified Data.Text                        as T-import           Patat.Presentation.Display.Table (themed)-import qualified Patat.PrettyPrint                as PP+import           Data.Maybe                          (mapMaybe)+import qualified Data.Text                           as T+import           Patat.Presentation.Display.Internal+import qualified Patat.PrettyPrint                   as PP import           Patat.Theme import           Prelude-import qualified Skylighting                      as Skylighting+import qualified Skylighting                         as Skylighting   ---------------------------------------------------------------------------------highlight :: [T.Text] -> T.Text -> [Skylighting.SourceLine]-highlight classes rawCodeBlock = case mapMaybe getSyntax classes of-    []        -> zeroHighlight rawCodeBlock-    (syn : _) ->-        case Skylighting.tokenize config syn rawCodeBlock of-            Left  _  -> zeroHighlight rawCodeBlock-            Right sl -> sl+highlight+    :: Skylighting.SyntaxMap -> [T.Text] -> T.Text -> [Skylighting.SourceLine]+highlight extraSyntaxMap classes rawCodeBlock =+    case mapMaybe getSyntax classes of+        []        -> zeroHighlight rawCodeBlock+        (syn : _) ->+            case Skylighting.tokenize config syn rawCodeBlock of+                Left  _  -> zeroHighlight rawCodeBlock+                Right sl -> sl   where     getSyntax :: T.Text -> Maybe Skylighting.Syntax     getSyntax c = Skylighting.lookupSyntax c syntaxMap@@ -36,7 +37,7 @@         }      syntaxMap :: Skylighting.SyntaxMap-    syntaxMap = Skylighting.defaultSyntaxMap+    syntaxMap = extraSyntaxMap <> Skylighting.defaultSyntaxMap   --------------------------------------------------------------------------------@@ -49,21 +50,22 @@   ---------------------------------------------------------------------------------prettyCodeBlock :: Theme -> [T.Text] -> T.Text -> PP.Doc-prettyCodeBlock theme@Theme {..} classes rawCodeBlock =-    PP.vcat (map blockified sourceLines) <>-    PP.hardline+prettyCodeBlock :: DisplaySettings -> [T.Text] -> T.Text -> PP.Doc+prettyCodeBlock ds classes rawCodeBlock =+    PP.vcat (map blockified sourceLines) <> PP.hardline   where     sourceLines :: [Skylighting.SourceLine]     sourceLines =-        [[]] ++ highlight classes rawCodeBlock ++ [[]]+        [[]] ++ highlight (dsSyntaxMap ds) classes rawCodeBlock ++ [[]]      prettySourceLine :: Skylighting.SourceLine -> PP.Doc     prettySourceLine = mconcat . map prettyToken      prettyToken :: Skylighting.Token -> PP.Doc-    prettyToken (tokenType, str) =-        themed (syntaxHighlight theme tokenType) (PP.string $ T.unpack str)+    prettyToken (tokenType, str) = themed+        ds+        (\theme -> syntaxHighlight theme tokenType)+        (PP.string $ T.unpack str)      sourceLineLength :: Skylighting.SourceLine -> Int     sourceLineLength line = sum [T.length str | (_, str) <- line]@@ -76,7 +78,7 @@         let len    = sourceLineLength line             indent = PP.NotTrimmable "   " in         PP.indent indent indent $-        themed themeCodeBlock $+        themed ds themeCodeBlock $             " " <>             prettySourceLine line <>             PP.string (replicate (blockWidth - len) ' ') <> " "

@@ -0,0 +1,27 @@+--------------------------------------------------------------------------------+module Patat.Presentation.Display.Internal+    ( DisplaySettings (..)+    , themed+    ) where+++--------------------------------------------------------------------------------+import qualified Patat.PrettyPrint as PP+import qualified Patat.Theme       as Theme+import qualified Skylighting       as Skylighting+++--------------------------------------------------------------------------------+data DisplaySettings = DisplaySettings+    { dsTheme     :: !Theme.Theme+    , dsSyntaxMap :: !Skylighting.SyntaxMap+    }+++--------------------------------------------------------------------------------+themed+    :: DisplaySettings -> (Theme.Theme -> Maybe Theme.Style) -> PP.Doc -> PP.Doc+themed ds f = case f (dsTheme ds) of+    Nothing                  -> id+    Just (Theme.Style [])    -> id+    Just (Theme.Style codes) -> PP.ansi codes

@@ -10,11 +10,11 @@   ---------------------------------------------------------------------------------import           Data.List         (intersperse, transpose)-import           Patat.PrettyPrint ((<$$>))-import qualified Patat.PrettyPrint as PP-import           Patat.Theme       (Theme (..))-import qualified Patat.Theme       as Theme+import           Data.List                           (intersperse, transpose)+import           Patat.Presentation.Display.Internal+import           Patat.PrettyPrint                   ((<$$>))+import qualified Patat.PrettyPrint                   as PP+import           Patat.Theme                         (Theme (..)) import           Prelude  @@ -28,15 +28,15 @@   ---------------------------------------------------------------------------------prettyTable-    :: Theme -> Table -> PP.Doc-prettyTable theme@Theme {..} Table {..} =+prettyTable :: DisplaySettings -> Table -> PP.Doc+prettyTable ds Table {..} =     PP.indent (PP.Trimmable "  ") (PP.Trimmable "  ") $         lineIf (not isHeaderLess) (hcat2 headerHeight-            [ themed themeTableHeader (PP.align w a (vpad headerHeight header))+            [ themed ds themeTableHeader $+                PP.align w a (vpad headerHeight header)             | (w, a, header) <- zip3 columnWidths tAligns tHeaders             ]) <>-        dashedHeaderSeparator theme columnWidths <$$>+        dashedHeaderSeparator ds columnWidths <$$>         joinRows             [ hcat2 rowHeight                 [ PP.align w a (vpad rowHeight cell)@@ -44,7 +44,7 @@                 ]             | (rowHeight, row) <- zip rowHeights tRows             ] <$$>-        lineIf isHeaderLess (dashedHeaderSeparator theme columnWidths) <>+        lineIf isHeaderLess (dashedHeaderSeparator ds columnWidths) <>         lineIf             (not $ PP.null tCaption) (PP.hardline <> "Table: " <> tCaption)   where@@ -90,17 +90,9 @@   ---------------------------------------------------------------------------------dashedHeaderSeparator :: Theme -> [Int] -> PP.Doc-dashedHeaderSeparator Theme {..} columnWidths =+dashedHeaderSeparator :: DisplaySettings -> [Int] -> PP.Doc+dashedHeaderSeparator ds columnWidths =     mconcat $ intersperse (PP.string "  ")-        [ themed themeTableSeparator (PP.string (replicate w '-'))+        [ themed ds themeTableSeparator (PP.string (replicate w '-'))         | w <- columnWidths         ]-------------------------------------------------------------------------------------- | This does not really belong in the module.-themed :: Maybe Theme.Style -> PP.Doc -> PP.Doc-themed Nothing                    = id-themed (Just (Theme.Style []))    = id-themed (Just (Theme.Style codes)) = PP.ansi codes

@@ -20,6 +20,7 @@     , EvalSettings (..)      , Slide (..)+    , SlideContent (..)     , Instruction.Fragment (..)     , Index @@ -27,24 +28,30 @@     , numFragments      , ActiveFragment (..)-    , getActiveFragment+    , activeFragment+    , activeSpeakerNotes     ) where   ---------------------------------------------------------------------------------import           Control.Monad                  (mplus)-import qualified Data.Aeson.Extended            as A-import qualified Data.Aeson.TH.Extended         as A-import qualified Data.Foldable                  as Foldable-import qualified Data.HashMap.Strict            as HMS-import           Data.List                      (intercalate)-import           Data.Maybe                     (fromMaybe, listToMaybe)-import qualified Data.Text                      as T-import qualified Patat.Presentation.Instruction as Instruction-import qualified Patat.Theme                    as Theme+import           Control.Monad                   (mplus)+import qualified Data.Aeson.Extended             as A+import qualified Data.Aeson.TH.Extended          as A+import qualified Data.Foldable                   as Foldable+import           Data.Function                   (on)+import qualified Data.HashMap.Strict             as HMS+import           Data.List                       (intercalate)+import           Data.Maybe                      (fromMaybe)+import           Data.Sequence.Extended          (Seq)+import qualified Data.Sequence.Extended          as Seq+import qualified Data.Text                       as T+import qualified Patat.Presentation.Instruction  as Instruction+import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes+import qualified Patat.Theme                     as Theme import           Prelude-import qualified Text.Pandoc                    as Pandoc-import           Text.Read                      (readMaybe)+import qualified Skylighting                     as Skylighting+import qualified Text.Pandoc                     as Pandoc+import           Text.Read                       (readMaybe)   --------------------------------------------------------------------------------@@ -57,9 +64,10 @@     , pTitle          :: ![Pandoc.Inline]     , pAuthor         :: ![Pandoc.Inline]     , pSettings       :: !PresentationSettings-    , pSlides         :: [Slide]-    , pBreadcrumbs    :: [Breadcrumbs]  -- One for each slide.+    , pSlides         :: !(Seq Slide)+    , pBreadcrumbs    :: !(Seq Breadcrumbs)  -- One for each slide.     , pActiveFragment :: !Index+    , pSyntaxMap      :: !Skylighting.SyntaxMap     } deriving (Show)  @@ -67,38 +75,42 @@ -- | These are patat-specific settings.  That is where they differ from more -- general metadata (author, title...) 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)-    , psBreadcrumbs      :: !(Maybe Bool)-    , psEval             :: !(Maybe EvalSettingsMap)-    , psSlideNumber      :: !(Maybe Bool)+    { 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)+    , psBreadcrumbs       :: !(Maybe Bool)+    , psEval              :: !(Maybe EvalSettingsMap)+    , psSlideNumber       :: !(Maybe Bool)+    , psSyntaxDefinitions :: !(Maybe [FilePath])+    , psSpeakerNotes      :: !(Maybe SpeakerNotes.Settings)     } deriving (Show)   -------------------------------------------------------------------------------- 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-        , psBreadcrumbs      = psBreadcrumbs      l `mplus` psBreadcrumbs      r-        , psEval             = psEval             l <>      psEval             r-        , psSlideNumber      = psSlideNumber      l `mplus` psSlideNumber      r+        { psRows              = on mplus psRows              l r+        , psColumns           = on mplus psColumns           l r+        , psMargins           = on (<>)  psMargins           l r+        , psWrap              = on mplus psWrap              l r+        , psTheme             = on (<>)  psTheme             l r+        , psIncrementalLists  = on mplus psIncrementalLists  l r+        , psAutoAdvanceDelay  = on mplus psAutoAdvanceDelay  l r+        , psSlideLevel        = on mplus psSlideLevel        l r+        , psPandocExtensions  = on mplus psPandocExtensions  l r+        , psImages            = on mplus psImages            l r+        , psBreadcrumbs       = on mplus psBreadcrumbs       l r+        , psEval              = on (<>)  psEval              l r+        , psSlideNumber       = on mplus psSlideNumber       l r+        , psSyntaxDefinitions = on (<>)  psSyntaxDefinitions l r+        , psSpeakerNotes      = on mplus psSpeakerNotes      l r         }  @@ -107,25 +119,15 @@     mappend = (<>)     mempty  = PresentationSettings                     Nothing Nothing Nothing Nothing Nothing Nothing Nothing-                    Nothing Nothing Nothing Nothing Nothing Nothing+                    Nothing Nothing Nothing Nothing Nothing Nothing Nothing+                    Nothing   -------------------------------------------------------------------------------- defaultPresentationSettings :: PresentationSettings-defaultPresentationSettings = PresentationSettings-    { psRows             = Nothing-    , psColumns          = Nothing-    , psMargins          = Just defaultMargins-    , psWrap             = Nothing+defaultPresentationSettings = mempty+    { psMargins          = Just defaultMargins     , psTheme            = Just Theme.defaultTheme-    , psIncrementalLists = Nothing-    , psAutoAdvanceDelay = Nothing-    , psSlideLevel       = Nothing-    , psPandocExtensions = Nothing-    , psImages           = Nothing-    , psBreadcrumbs      = Nothing-    , psEval             = Nothing-    , psSlideNumber      = Nothing     }  @@ -258,7 +260,14 @@   ---------------------------------------------------------------------------------data Slide+data Slide = Slide+    { slideSpeakerNotes :: !SpeakerNotes.SpeakerNotes+    , slideContent      :: !SlideContent+    } deriving (Show)+++--------------------------------------------------------------------------------+data SlideContent     = ContentSlide (Instruction.Instructions Pandoc.Block)     | TitleSlide   Int [Pandoc.Inline]     deriving (Show)@@ -271,13 +280,14 @@  -------------------------------------------------------------------------------- getSlide :: Int -> Presentation -> Maybe Slide-getSlide sidx = listToMaybe . drop sidx . pSlides+getSlide sidx = (`Seq.safeIndex` sidx) . pSlides   -------------------------------------------------------------------------------- numFragments :: Slide -> Int-numFragments (ContentSlide instrs) = Instruction.numFragments instrs-numFragments (TitleSlide _ _)      = 1+numFragments slide = case slideContent slide of+    ContentSlide instrs -> Instruction.numFragments instrs+    TitleSlide _ _      -> 1   --------------------------------------------------------------------------------@@ -288,15 +298,23 @@   ---------------------------------------------------------------------------------getActiveFragment :: Presentation -> Maybe ActiveFragment-getActiveFragment presentation = do+activeFragment :: Presentation -> Maybe ActiveFragment+activeFragment presentation = do     let (sidx, fidx) = pActiveFragment presentation     slide <- getSlide sidx presentation-    pure $ case slide of+    pure $ case slideContent slide of         TitleSlide lvl is -> ActiveTitle $             Pandoc.Header lvl Pandoc.nullAttr is         ContentSlide instrs -> ActiveContent $             Instruction.renderFragment fidx instrs+++--------------------------------------------------------------------------------+activeSpeakerNotes :: Presentation -> SpeakerNotes.SpeakerNotes+activeSpeakerNotes presentation = fromMaybe mempty $ do+    let (sidx, _) = pActiveFragment presentation+    slide <- getSlide sidx presentation+    pure $ slideSpeakerNotes slide   --------------------------------------------------------------------------------

@@ -7,33 +7,38 @@     ( readPresentation        -- Exposed for testing mostly.+    , detectSlideLevel     , readMetaSettings     ) where   ---------------------------------------------------------------------------------import           Control.Monad.Except           (ExceptT (..), runExceptT,-                                                 throwError)-import           Control.Monad.Trans            (liftIO)-import qualified Data.Aeson                     as A-import qualified Data.Aeson.KeyMap              as AKM-import           Data.Bifunctor                 (first)-import           Data.Maybe                     (fromMaybe)-import qualified Data.Text                      as T-import qualified Data.Text.Encoding             as T-import qualified Data.Text.IO                   as T-import qualified Data.Yaml                      as Yaml-import           Patat.Eval                     (eval)+import           Control.Monad.Except            (ExceptT (..), runExceptT,+                                                  throwError)+import           Control.Monad.Trans             (liftIO)+import qualified Data.Aeson                      as A+import qualified Data.Aeson.KeyMap               as AKM+import           Data.Bifunctor                  (first)+import           Data.Maybe                      (fromMaybe)+import           Data.Sequence.Extended          (Seq)+import qualified Data.Sequence.Extended          as Seq+import qualified Data.Text                       as T+import qualified Data.Text.Encoding              as T+import qualified Data.Text.IO                    as T+import qualified Data.Yaml                       as Yaml+import           Patat.Eval                      (eval) import           Patat.Presentation.Fragment-import qualified Patat.Presentation.Instruction as Instruction+import qualified Patat.Presentation.Instruction  as Instruction import           Patat.Presentation.Internal+import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes import           Prelude-import           System.Directory               (doesFileExist,-                                                 getHomeDirectory)-import           System.FilePath                (splitFileName, takeExtension,-                                                 (</>))-import qualified Text.Pandoc.Error              as Pandoc-import qualified Text.Pandoc.Extended           as Pandoc+import qualified Skylighting                     as Skylighting+import           System.Directory                (doesFileExist,+                                                  getHomeDirectory)+import           System.FilePath                 (splitFileName, takeExtension,+                                                  (</>))+import qualified Text.Pandoc.Error               as Pandoc+import qualified Text.Pandoc.Extended            as Pandoc   --------------------------------------------------------------------------------@@ -45,6 +50,8 @@     metaSettings <- ExceptT $ return $ readMetaSettings src     let settings = metaSettings <> homeSettings <> defaultPresentationSettings +    syntaxMap <- ExceptT $ readSyntaxMap $ fromMaybe [] $+        psSyntaxDefinitions settings     let pexts = fromMaybe defaultExtensionList (psPandocExtensions settings)     reader <- case readExtension pexts ext of         Nothing -> throwError $ "Unknown file extension: " ++ show ext@@ -53,29 +60,39 @@         Left  e -> throwError $ "Could not parse document: " ++ show e         Right x -> return x -    pres <- ExceptT $ pure $ pandocToPresentation filePath settings doc+    pres <- ExceptT $ pure $+        pandocToPresentation filePath settings syntaxMap doc     liftIO $ eval pres   where     ext = takeExtension filePath   --------------------------------------------------------------------------------+readSyntaxMap :: [FilePath] -> IO (Either String Skylighting.SyntaxMap)+readSyntaxMap =+    runExceptT .+    fmap (foldr Skylighting.addSyntaxDefinition mempty) .+    traverse (ExceptT . Skylighting.loadSyntaxFromFile)+++-------------------------------------------------------------------------------- readExtension     :: ExtensionList -> String     -> Maybe (T.Text -> Either Pandoc.PandocError Pandoc.Pandoc) readExtension (ExtensionList extensions) fileExt = case fileExt of-    ".markdown"  -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts-    ".md"  -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts-    ".mdown"  -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts-    ".mdtext"  -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts-    ".mdtxt"  -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts-    ".mdwn"  -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts-    ".mkd"  -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts-    ".mkdn"  -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts-    ".lhs" -> Just $ Pandoc.runPure . Pandoc.readMarkdown lhsOpts-    ""     -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts-    ".org" -> Just $ Pandoc.runPure . Pandoc.readOrg      readerOpts-    _      -> Nothing+    ".markdown" -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts+    ".md"       -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts+    ".mdown"    -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts+    ".mdtext"   -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts+    ".mdtxt"    -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts+    ".mdwn"     -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts+    ".mkd"      -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts+    ".mkdn"     -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts+    ".lhs"      -> Just $ Pandoc.runPure . Pandoc.readMarkdown lhsOpts+    ""          -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts+    ".org"      -> Just $ Pandoc.runPure . Pandoc.readOrg      readerOpts+    ".txt"      -> Just $ pure . Pandoc.readPlainText+    _           -> Nothing    where     readerOpts = Pandoc.def@@ -95,9 +112,11 @@  -------------------------------------------------------------------------------- pandocToPresentation-    :: FilePath -> PresentationSettings -> Pandoc.Pandoc+    :: FilePath -> PresentationSettings -> Skylighting.SyntaxMap+    -> Pandoc.Pandoc     -> Either String Presentation-pandocToPresentation pFilePath pSettings pandoc@(Pandoc.Pandoc meta _) = do+pandocToPresentation pFilePath pSettings pSyntaxMap+        pandoc@(Pandoc.Pandoc meta _) = do     let !pTitle          = case Pandoc.docTitle meta of             []    -> [Pandoc.Str . T.pack . snd $ splitFileName pFilePath]             title -> title@@ -155,19 +174,19 @@   ---------------------------------------------------------------------------------pandocToSlides :: PresentationSettings -> Pandoc.Pandoc -> [Slide]+pandocToSlides :: PresentationSettings -> Pandoc.Pandoc -> Seq.Seq Slide pandocToSlides settings pandoc =     let slideLevel   = fromMaybe (detectSlideLevel pandoc) (psSlideLevel settings)         unfragmented = splitSlides slideLevel pandoc-        fragmented   =-            [ case slide of-                TitleSlide   _ _        -> slide-                ContentSlide instrs0 -> ContentSlide $-                    fragmentInstructions fragmentSettings instrs0-            | slide <- unfragmented-            ] in-    fragmented+        fragmented   = map fragmentSlide unfragmented in+    Seq.fromList fragmented   where+    fragmentSlide slide = case slideContent slide of+        TitleSlide   _ _     -> slide+        ContentSlide instrs0 ->+            let instrs1 = fragmentInstructions fragmentSettings instrs0 in+            slide {slideContent = ContentSlide instrs1}+     fragmentSettings = FragmentSettings         { fsIncrementalLists = fromMaybe False (psIncrementalLists settings)         }@@ -178,16 +197,16 @@ -- header that occurs before a non-header in the blocks. detectSlideLevel :: Pandoc.Pandoc -> Int detectSlideLevel (Pandoc.Pandoc _meta blocks0) =-    go 6 blocks0+    go 6 $ SpeakerNotes.remove blocks0   where     go level (Pandoc.Header n _ _ : x : xs)-        | n < level && nonHeader x = go n xs-        | otherwise                = go level (x:xs)-    go level (_ : xs)              = go level xs-    go level []                    = level+        | n < level && not (isHeader x) = go n xs+        | otherwise                     = go level (x:xs)+    go level (_ : xs)                   = go level xs+    go level []                         = level -    nonHeader (Pandoc.Header _ _ _) = False-    nonHeader _                     = True+    isHeader (Pandoc.Header _ _ _) = True+    isHeader _                     = False   --------------------------------------------------------------------------------@@ -201,9 +220,10 @@     | otherwise                              = splitAtHeaders [] blocks0   where     mkContentSlide :: [Pandoc.Block] -> [Slide]-    mkContentSlide [] = []  -- Never create empty slides-    mkContentSlide bs =-        [ContentSlide $ Instruction.fromList [Instruction.Append bs]]+    mkContentSlide bs0 = case SpeakerNotes.partition bs0 of+        (_,  [])  -> [] -- Never create empty slides+        (sn, bs1) -> pure . Slide sn . ContentSlide $+            Instruction.fromList [Instruction.Append bs1]      splitAtRules blocks = case break (== Pandoc.HorizontalRule) blocks of         (xs, [])           -> mkContentSlide xs@@ -211,22 +231,27 @@      splitAtHeaders acc [] =         mkContentSlide (reverse acc)-    splitAtHeaders acc (b@(Pandoc.Header i _ txt) : bs)-        | i > slideLevel  = splitAtHeaders (b : acc) bs+    splitAtHeaders acc (b@(Pandoc.Header i _ txt) : bs0)+        | i > slideLevel  = splitAtHeaders (b : acc) bs0         | i == slideLevel =-            mkContentSlide (reverse acc) ++ splitAtHeaders [b] bs+            mkContentSlide (reverse acc) ++ splitAtHeaders [b] bs0         | otherwise       =-            mkContentSlide (reverse acc) ++ [TitleSlide i txt] ++-            splitAtHeaders [] bs+            let (sn, bs1) = SpeakerNotes.split bs0 in+            mkContentSlide (reverse acc) +++            [Slide sn $ TitleSlide i txt] +++            splitAtHeaders [] bs1     splitAtHeaders acc (b : bs) =         splitAtHeaders (b : acc) bs -collectBreadcrumbs :: [Slide] -> [Breadcrumbs]-collectBreadcrumbs = go []++--------------------------------------------------------------------------------+collectBreadcrumbs :: Seq Slide -> Seq Breadcrumbs+collectBreadcrumbs = go [] . fmap slideContent   where-    go breadcrumbs = \case-        [] -> []-        ContentSlide _ : slides -> breadcrumbs : go breadcrumbs slides-        TitleSlide lvl inlines : slides ->+    go breadcrumbs slides0 = case Seq.viewl slides0 of+        Seq.EmptyL -> Seq.empty+        ContentSlide _ Seq.:< slides ->+            breadcrumbs `Seq.cons` go breadcrumbs slides+        TitleSlide lvl inlines Seq.:< slides ->             let parent = filter ((< lvl) . fst) breadcrumbs in-            parent : go (parent ++ [(lvl, inlines)]) slides+            parent `Seq.cons` go (parent ++ [(lvl, inlines)]) slides

@@ -0,0 +1,105 @@+--------------------------------------------------------------------------------+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TemplateHaskell            #-}+module Patat.Presentation.SpeakerNotes+    ( SpeakerNotes+    , parse+    , toText+    , remove+    , split+    , partition++    , Settings+    , Handle+    , with+    , write+    ) where+++--------------------------------------------------------------------------------+import           Control.Exception      (bracket)+import           Control.Monad          (when)+import qualified Data.Aeson.TH.Extended as A+import qualified Data.IORef             as IORef+import           Data.List              (intersperse)+import qualified Data.Text              as T+import qualified Data.Text.IO           as T+import           System.Directory       (removeFile)+import qualified Text.Pandoc            as Pandoc+++--------------------------------------------------------------------------------+newtype SpeakerNotes = SpeakerNotes [T.Text]+    deriving (Eq, Monoid, Semigroup, Show)+++--------------------------------------------------------------------------------+parse :: Pandoc.Block -> Maybe SpeakerNotes+parse (Pandoc.RawBlock "html" t0) = do+    t1 <- T.stripPrefix "<!--" t0+    t2 <- T.stripSuffix "-->" t1+    pure $ SpeakerNotes [T.strip t2]+parse _ = Nothing+++--------------------------------------------------------------------------------+toText :: SpeakerNotes -> T.Text+toText (SpeakerNotes sn) = T.unlines $ intersperse mempty sn+++--------------------------------------------------------------------------------+remove :: [Pandoc.Block] -> [Pandoc.Block]+remove = snd . partition+++--------------------------------------------------------------------------------+-- | Take all speaker notes from the front of the list.  Return those and the+-- remaining blocks.+split :: [Pandoc.Block] -> (SpeakerNotes, [Pandoc.Block])+split = go []+  where+    go sn []                           = (mconcat (reverse sn), [])+    go sn (x : xs) | Just s <- parse x = go (s : sn) xs+    go sn xs                           = (mconcat (reverse sn), xs)+++--------------------------------------------------------------------------------+-- | Partition the list into speaker notes and other blocks.+partition :: [Pandoc.Block] -> (SpeakerNotes, [Pandoc.Block])+partition = go [] []+  where+    go sn bs []                           = (mconcat (reverse sn), reverse bs)+    go sn bs (x : xs) | Just s <- parse x = go (s : sn) bs xs+    go sn bs (x : xs)                     = go sn (x : bs) xs+++--------------------------------------------------------------------------------+data Settings = Settings+    { sFile :: !FilePath+    } deriving (Show)+++--------------------------------------------------------------------------------+data Handle = Handle+    { hSettings :: !Settings+    , hActive   :: !(IORef.IORef SpeakerNotes)+    }+++--------------------------------------------------------------------------------+with :: Settings -> (Handle -> IO a) -> IO a+with settings = bracket+    (Handle settings <$> IORef.newIORef mempty)+    (\_ -> removeFile (sFile settings))+++--------------------------------------------------------------------------------+write :: Handle -> SpeakerNotes -> IO ()+write h sn = do+    change <- IORef.atomicModifyIORef' (hActive h) $ \old -> (sn, old /= sn)+    when change $ T.writeFile (sFile $ hSettings h) $ toText sn+++--------------------------------------------------------------------------------+$(A.deriveFromJSON A.dropPrefixOptions ''Settings)

@@ -1,18 +1,21 @@ ---------------------------------------------------------------------------------{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE LambdaCase   #-}+{-# LANGUAGE LambdaCase #-} module Text.Pandoc.Extended     ( module Text.Pandoc      , plainToPara     , newlineToSpace++    , readPlainText     ) where   --------------------------------------------------------------------------------+import           Data.Char          (isSpace) import           Data.Data.Extended (grecT)-import           Text.Pandoc+import qualified Data.Text          as T import           Prelude+import           Text.Pandoc   --------------------------------------------------------------------------------@@ -28,3 +31,18 @@     SoftBreak -> Space     LineBreak -> Space     inline    -> inline+++--------------------------------------------------------------------------------+-- | A plain-text reader.  Always returns empty metadata.+readPlainText :: T.Text -> Pandoc+readPlainText = Pandoc mempty . pure . Plain . go+  where+    go txt0 = case T.uncons txt0 of+        Nothing           -> []+        Just (' ',  txt1) -> Space : go txt1+        Just ('\r', txt1) -> go txt1+        Just ('\n', txt1) -> SoftBreak : go txt1+        Just (c,    txt1) ->+            let (pre, post) = T.break isSpace txt1 in+            Str (T.cons c pre) : go post

@@ -1,5 +1,5 @@ Name:                patat-Version:             0.8.9.0+Version:             0.9.0.0 Synopsis:            Terminal-based presentations using Pandoc Description:         Terminal-based presentations using Pandoc. License:             GPL-2@@ -76,12 +76,14 @@     Patat.Presentation     Patat.Presentation.Display     Patat.Presentation.Display.CodeBlock+    Patat.Presentation.Display.Internal     Patat.Presentation.Display.Table     Patat.Presentation.Fragment     Patat.Presentation.Instruction     Patat.Presentation.Interactive     Patat.Presentation.Internal     Patat.Presentation.Read+    Patat.Presentation.SpeakerNotes     Patat.PrettyPrint     Patat.Theme @@ -90,6 +92,7 @@     Data.Aeson.TH.Extended     Data.Char.WCWidth.Extended     Data.Data.Extended+    Data.Sequence.Extended     Paths_patat     Text.Pandoc.Extended @@ -135,6 +138,7 @@     patat,     base             >= 4.8  && < 5,     directory        >= 1.2  && < 1.4,+    pandoc           >= 3.1  && < 3.2,     tasty            >= 1.2  && < 1.5,     tasty-hunit      >= 0.10 && < 0.11,     tasty-quickcheck >= 0.10 && < 0.11,

@@ -3,31 +3,64 @@     ( tests     ) where -import qualified Data.Text               as T++-------------------------------------------------------------------------------- import           Patat.Presentation.Read import qualified Test.Tasty              as Tasty import qualified Test.Tasty.HUnit        as Tasty+import qualified Text.Pandoc             as Pandoc ++-------------------------------------------------------------------------------- tests :: Tasty.TestTree tests = Tasty.testGroup "Patat.Presentation.Read.Tests"-    [ Tasty.testCase "readMetaSettings" $+    [ testReadMetaSettings+    , testDetectSlideLevel+    ]+++--------------------------------------------------------------------------------+testReadMetaSettings :: Tasty.TestTree+testReadMetaSettings = Tasty.testCase "readMetaSettings" $         case readMetaSettings invalidMetadata of             Left _  -> pure ()             Right _ -> Tasty.assertFailure "expecting invalid metadata"-    ]+  where+    invalidMetadata =+        "---\n\+        \title: mixing tabs and spaces bad\n\+        \author: thoastbrot\n\+        \patat:\n\+        \    images:\n\+        \            backend: 'w3m'\n\+        \            path: '/usr/lib/w3m/w3mimgdisplay'\n\+        \    theme:\n\+        \\theader: [vividBlue,onDullBlack]\n\+        \        emph: [dullBlue,italic]\n\+        \...\n\+        \\n\+        \Hi!" -invalidMetadata :: T.Text-invalidMetadata =-    "---\n\-    \title: mixing tabs and spaces bad\n\-    \author: thoastbrot\n\-    \patat:\n\-    \    images:\n\-    \            backend: 'w3m'\n\-    \            path: '/usr/lib/w3m/w3mimgdisplay'\n\-    \    theme:\n\-    \\theader: [vividBlue,onDullBlack]\n\-    \        emph: [dullBlue,italic]\n\-    \...\n\-    \\n\-    \Hi!"++--------------------------------------------------------------------------------+testDetectSlideLevel :: Tasty.TestTree+testDetectSlideLevel = Tasty.testGroup "detectSlideLevel"+    [ Tasty.testCase "01" $+        (Tasty.@=?) 1 $ detectSlideLevel $ Pandoc.Pandoc mempty+            [ Pandoc.Header 1 mempty [Pandoc.Str "Intro"]+            , Pandoc.Para [Pandoc.Str "Hi"]+            ]+    , Tasty.testCase "02" $+        (Tasty.@=?) 2 $ detectSlideLevel $ Pandoc.Pandoc mempty+            [ Pandoc.Header 1 mempty [Pandoc.Str "Intro"]+            , Pandoc.Header 2 mempty [Pandoc.Str "Detail"]+            , Pandoc.Para [Pandoc.Str "Hi"]+            ]+    , Tasty.testCase "03" $+        (Tasty.@=?) 2 $ detectSlideLevel $ Pandoc.Pandoc mempty+            [ Pandoc.Header 1 mempty [Pandoc.Str "Intro"]+            , Pandoc.RawBlock "html" "<!-- Some speaker notes -->"+            , Pandoc.Header 2 mempty [Pandoc.Str "Detail"]+            , Pandoc.Para [Pandoc.Str "Hi"]+            ]+    ]