--- /dev/null
+version: 2
+
+workflows:
+ version: 2
+ build-workflow:
+ jobs:
+ - build:
+ filters:
+ tags:
+ only: /.*/
+
+jobs:
+ build:
+ # This image has most Haskell stuff preinstalled.
+ docker:
+ - image: 'fpco/stack-build:latest'
+
+ steps:
+ - checkout
+ - restore_cache:
+ key: 'v3-patat-{{ arch }}-{{ .Branch }}'
+ - run:
+ name: 'Update cabal indices'
+ command: 'cabal update'
+ - run:
+ # We set jobs to 1 here because that prevents Out-Of-Memory exceptions
+ # while compiling dependencies.
+ name: 'Install dependencies'
+ command: '.circleci/tickle.sh cabal install --only-dependencies --jobs=1'
+ - run:
+ name: 'Build and install'
+ command: 'cabal install --flags="patat-make-man"'
+ - run:
+ name: 'Run tests'
+ command: 'make test'
+ - save_cache:
+ key: 'v3-patat-{{ arch }}-{{ .Branch }}-{{ .Revision }}'
+ paths:
+ - '~/.cabal'
+ - '~/.ghc'
+ - run:
+ name: 'Upload release'
+ command: '.circleci/release.sh "$CIRCLE_TAG"'
--- /dev/null
+#!/bin/bash
+set -o nounset -o errexit -o pipefail
+
+TAG="$1"
+SUFFIX="linux-$(uname -m)"
+USER="jaspervdj"
+REPOSITORY="$(basename -- *.cabal ".cabal")"
+BINARY="$REPOSITORY"
+
+echo "Tag: $TAG"
+echo "Suffix: $SUFFIX"
+echo "Repository: $REPOSITORY"
+
+$BINARY --version
+
+if [[ -z "$TAG" ]]; then
+ echo "Not a tagged build, skipping release..."
+ exit 0
+fi
+
+# Install ghr
+GHR_VERSION="v0.5.4"
+wget --quiet \
+ "https://github.com/tcnksm/ghr/releases/download/${GHR_VERSION}/ghr_${GHR_VERSION}_linux_386.zip"
+unzip ghr_${GHR_VERSION}_linux_386.zip
+
+# Install upx
+UPX_VERSION="3.94"
+wget --quiet \
+ "https://github.com/upx/upx/releases/download/v${UPX_VERSION}/upx-${UPX_VERSION}-amd64_linux.tar.xz"
+tar xf upx-${UPX_VERSION}-amd64_linux.tar.xz
+mv upx-${UPX_VERSION}-amd64_linux/upx .
+
+# Create tarball
+PACKAGE="$REPOSITORY-$TAG-$SUFFIX"
+mkdir -p "$PACKAGE"
+cp "$(which "$BINARY")" "$PACKAGE"
+./upx -q "$PACKAGE/$BINARY"
+cp README.* "$PACKAGE"
+cp CHANGELOG.* "$PACKAGE"
+cp extra/patat.1 "$PACKAGE"
+tar -czf "$PACKAGE.tar.gz" "$PACKAGE"
+rm -r "$PACKAGE"
+
+# Actually upload
+./ghr -u "$USER" -r "$REPOSITORY" "$TAG" "$PACKAGE.tar.gz"
--- /dev/null
+#!/bin/bash
+set -o nounset -o errexit -o pipefail
+
+function tickle() {
+ while [ true ]; do
+ echo "[$(date +%H:%M:%S)] Tickling..."
+ sleep 60
+ done
+}
+
+echo "Forking tickle process..."
+tickle &
+TICKLE_PID=$!
+
+echo "Forking build process..."
+eval $@ &
+BUILD_PID=$!
+
+echo "Waiting for build thread ($BUILD_PID)..."
+wait $BUILD_PID
+
+echo "Killing tickle thread ($TICKLE_PID)..."
+kill $TICKLE_PID
+echo "All done!"
--- /dev/null
+*.o
+*.hi
+extra/make-man
+extra/patat.1
+.stack-work
+dist
+tags
--- /dev/null
+# Changelog
+
+- 0.8.1.2 (2018-10-29)
+ * Work around test failure caused by slightly different syntax highlighting
+ in different pandoc versions
+
+- 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.
--- /dev/null
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Lesser General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License along
+ with this program; if not, write to the Free Software Foundation, Inc.,
+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.
--- /dev/null
+# We use `?=` to set SOURCE_DATE_EPOCH only if it is not present. Unfortunately
+# we can't use `git --date=unix` since only very recent git versions support
+# that, so we need to make a round trip through `date`.
+SOURCE_DATE_EPOCH?=$(shell date '+%s' \
+ --date="$(shell git log -1 --format=%cd --date=rfc)")
+
+extra/patat.1: README.md
+ SOURCE_DATE_EPOCH="$(SOURCE_DATE_EPOCH)" patat-make-man >$@
+
+extra/patat.bash-completion:
+ patat --bash-completion-script patat >$@
+
+completion: extra/patat.bash-completion
+
+man: extra/patat.1
+
+# Also check if we can generate the manual.
+test: man
+ bash test.sh
+
+clean:
+ rm -f extra/patat.1
+ rm -f extra/make-man
+ rm -f extra/patat.bash-completion
+
+.PHONY: man completion test clean
--- /dev/null
+patat
+=====
+
+[](https://circleci.com/gh/jaspervdj/patat) [](https://hackage.haskell.org/package/patat) []()
+
+`patat` (**P**resentations **A**top **T**he **A**NSI **T**erminal) is a small
+tool that allows you to show presentations using only an ANSI terminal. It does
+not require `ncurses`.
+
+Features:
+
+- Leverages the great [Pandoc] library to support many input formats including
+ [Literate Haskell].
+- 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.
+- [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].
+
+
+
+[Kate]: https://kate-editor.org/
+[Haskell]: http://haskell.org/
+[Pandoc]: http://pandoc.org/
+
+Table of Contents
+-----------------
+
+- [Table of Contents](#table-of-contents)
+- [Installation](#installation)
+ - [Pre-built-packages](#pre-built-packages)
+ - [From source](#from-source)
+- [Running](#running)
+- [Options](#options)
+- [Controls](#controls)
+- [Input format](#input-format)
+- [Configuration](#configuration)
+ - [Line wrapping](#line-wrapping)
+ - [Auto advancing](#auto-advancing)
+ - [Advanced slide splitting](#advanced-slide-splitting)
+ - [Fragmented slides](#fragmented-slides)
+ - [Theming](#theming)
+ - [Syntax Highlighting](#syntax-highlighting)
+ - [Pandoc Extensions](#pandoc-extensions)
+ - [Images](#images)
+- [Trivia](#trivia)
+
+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>
+
+You can also find generic linux binaries here:
+<https://github.com/jaspervdj/patat/releases>.
+
+### From source
+
+Installation from source is very easy. You can build from source using `stack
+install` or `cabal install`. `patat` is also available from [Hackage].
+
+[Hackage]: https://hackage.haskell.org/package/patat
+
+For people unfamiliar with the Haskell ecosystem, this means you can do either
+of the following:
+
+#### Using stack
+
+1. Install [stack] for your platform.
+2. Clone this repository.
+3. Run `stack setup` (if you're running stack for the first time) and
+ `stack install`.
+4. Make sure `$HOME/.local/bin` is in your `$PATH`.
+
+[stack]: https://docs.haskellstack.org/en/stable/README/
+
+#### Using cabal
+
+1. Install [cabal] for your platform.
+2. Run `cabal install patat`.
+3. Make sure `$HOME/.cabal/bin` is in your `$PATH`.
+
+[cabal]: https://www.haskell.org/cabal/
+
+Running
+-------
+
+`patat [*options*] file`
+
+Options
+-------
+
+`-w`, `--watch`
+
+: If you provide the `--watch` flag, `patat` will watch the presentation file
+ for changes and reload automatically. This is very useful when you are
+ writing the presentation.
+
+`-f`, `--force`
+
+: Run the presentation even if the terminal claims it does not support ANSI
+ features.
+
+`-d`, `--dump`
+
+: Just dump all the slides to stdout. This is useful for debugging.
+
+`--version`
+
+: Display version information.
+
+Controls
+--------
+
+- **Next slide**: `space`, `enter`, `l`, `→`, `PageDown`
+- **Previous slide**: `backspace`, `h`, `←`, `PageUp`
+- **Go forward 10 slides**: `j`, `↓`
+- **Go backward 10 slides**: `k`, `↑`
+- **First slide**: `0`
+- **Last slide**: `G`
+- **Reload file**: `r`
+- **Quit**: `q`
+
+The `r` key is very useful since it allows you to preview your slides while you
+are writing them. You can also use this to fix artifacts when the terminal is
+resized.
+
+Input format
+------------
+
+The input format can be anything that Pandoc supports. Plain markdown is
+usually the most simple solution:
+
+```markdown
+---
+title: This is my presentation
+author: Jane Doe
+...
+
+# This is a slide
+
+Slide contents. Yay.
+
+---
+
+# Important title
+
+Things I like:
+
+- Markdown
+- Haskell
+- Pandoc
+```
+
+Horizontal rulers (`---`) are used to split slides.
+
+However, if you prefer not use these since they are a bit intrusive in the
+markdown, you can also start every slide with a header. In that case, the file
+should not contain a single horizontal ruler.
+
+`patat` will pick the most deeply nested header (e.g. `h2`) as the marker for a
+new slide. Headers _above_ the most deeply nested header (e.g. `h1`) will turn
+into title slides, which are displayed as as a slide containing only the
+centered title.
+
+This means the following document is equivalent to the one we saw before:
+
+```markdown
+---
+title: This is my presentation
+author: Jane Doe
+...
+
+# This is a slide
+
+Slide contents. Yay.
+
+# Important title
+
+Things I like:
+
+- Markdown
+- Haskell
+- Pandoc
+```
+
+And that following document contains three slides: a title slide, followed by
+two content slides.
+
+```markdown
+---
+title: This is my presentation
+author: Jane Doe
+...
+
+# Chapter 1
+
+## This is a slide
+
+Slide contents. Yay.
+
+## Another slide
+
+Things I like:
+
+- Markdown
+- Haskell
+- Pandoc
+```
+
+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
+-------------
+
+`patat` is fairly configurable. The configuration is done using [YAML]. There
+are two places where you can put your configuration:
+
+1. In the presentation file itself, using the [Pandoc metadata header].
+2. In `$HOME/.patat.yaml`
+
+[YAML]: http://yaml.org/
+[Pandoc metadata header]: http://pandoc.org/MANUAL.html#extension-yaml_metadata_block
+
+For example, we set an option `key` to `val` by using the following file:
+
+```markdown
+---
+title: Presentation with options
+author: John Doe
+patat:
+ key: val
+...
+
+Hello world.
+```
+
+Or we can use a normal presentation and have the following `$HOME/.patat.yaml`:
+
+ key: val
+
+### Line wrapping
+
+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.
+
+```markdown
+---
+title: Auto-advance, yes please
+author: John Doe
+patat:
+ autoAdvanceDelay: 2
+...
+
+Hello World!
+
+---
+
+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`.
+
+### Advanced slide splitting
+
+You can control the way slide splitting works by setting the `slideLevel`
+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**:
+
+```markdown
+# This is a slide
+
+## This is a nested header
+
+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:
+
+```markdown
+---
+patat:
+ slideLevel: 1
+...
+
+# This is a slide
+
+## This is a nested header
+
+This is some content
+```
+
+Now, we will only see one slide, which contains a nested header.
+
+### Fragmented slides
+
+By default, slides are always displayed "all at once". If you want to display
+them fragment by fragment, there are two ways to do that. The most common
+case is that lists should be displayed incrementally.
+
+This can be configured by settings `incrementalLists` to `true` in the metadata
+block:
+
+```markdown
+---
+title: Presentation with incremental lists
+author: John Doe
+patat:
+ incrementalLists: true
+...
+
+- 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
+list incremental if `incrementalLists` is not set, and it will display the list
+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).
+
+```markdown
+---
+title: Presentation with incremental lists
+author: John Doe
+patat:
+ incrementalLists: true
+...
+
+- This list
+- is displayed
+
+ * item
+ * by item
+
+- Or sometimes
+
+ > * 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:
+
+```markdown
+Legen
+
+. . .
+
+wait for it
+
+. . .
+
+Dary!
+```
+
+### Theming
+
+Colors and other properties can also be changed using this configuration. For
+example, we can have:
+
+```markdown
+---
+author: 'Jasper Van der Jeugt'
+title: 'This is a test'
+patat:
+ wrap: true
+ theme:
+ emph: [vividBlue, onVividBlack, italic]
+ strong: [bold]
+ imageTarget: [onDullWhite, vividRed]
+...
+
+# This is a presentation
+
+This is _emph_ text.
+
+
+```
+
+The properties that can be given a list of styles are:
+
+`blockQuote`, `borders`, `bulletList`, `codeBlock`, `code`, `definitionList`,
+`definitionTerm`, `emph`, `header`, `imageTarget`, `imageText`, `linkTarget`,
+`linkText`, `math`, `orderedList`, `quoted`, `strikeout`, `strong`,
+`tableHeader`, `tableSeparator`
+
+The accepted styles are:
+
+`bold`, `italic`, `dullBlack`, `dullBlue`, `dullCyan`, `dullGreen`,
+`dullMagenta`, `dullRed`, `dullWhite`, `dullYellow`, `onDullBlack`,
+`onDullBlue`, `onDullCyan`, `onDullGreen`, `onDullMagenta`, `onDullRed`,
+`onDullWhite`, `onDullYellow`, `onVividBlack`, `onVividBlue`, `onVividCyan`,
+`onVividGreen`, `onVividMagenta`, `onVividRed`, `onVividWhite`, `onVividYellow`,
+`underline`, `vividBlack`, `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:
+
+```markdown
+---
+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
+an obvious way.
+
+[this list]: https://hackage.haskell.org/package/highlighting-kate-0.6.3/docs/Text-Highlighting-Kate-Types.html#t:TokenType
+
+### Pandoc Extensions
+
+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:
+
+```markdown
+---
+patat:
+ pandocExtensions:
+ - patat_extensions
+ - autolink_bare_uris
+...
+
+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:
+
+```markdown
+---
+patat:
+ pandocExtensions:
+ - autolink_bare_uris
+ - emoji
+...
+
+...
+
+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.
+
+
+```
+
+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
+------
+
+_"Patat"_ is the Flemish word for a simple potato. Dutch people also use it to
+refer to French Fries but I don't really do that -- in Belgium we just call
+fries _"Frieten"_.
+
+The idea of `patat` is largely based upon [MDP] which is in turn based upon
+[VTMC]. I wanted to write a clone using Pandoc because I ran into a markdown
+parsing bug in MDP which I could not work around. A second reason to do a
+Pandoc-based tool was that I would be able to use [Literate Haskell] as well.
+Lastly, I also prefer not to install Node.js on my machine if I can avoid it.
+
+[MDP]: https://github.com/visit1985/mdp
+[VTMC]: https://github.com/jclulow/vtmc
+[Literate Haskell]: https://wiki.haskell.org/Literate_programming
--- /dev/null
+import Distribution.Simple
+main = defaultMain
--- /dev/null
+-- | This script generates a man page for patat.
+{-# LANGUAGE OverloadedStrings #-}
+import Control.Applicative ((<$>))
+import Control.Exception (throw)
+import Control.Monad (guard)
+import Control.Monad.Trans (liftIO)
+import Data.Char (isSpace, toLower)
+import Data.List (isPrefixOf)
+import Data.Maybe (isJust)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import qualified GHC.IO.Encoding as Encoding
+import Prelude
+import System.Environment (getEnv)
+import qualified System.IO as IO
+import qualified Data.Time as Time
+import qualified Text.Pandoc as Pandoc
+
+getVersion :: IO String
+getVersion =
+ dropWhile isSpace . drop 1 . dropWhile (/= ':') . head .
+ filter (\l -> "version:" `isPrefixOf` map toLower l) .
+ map (dropWhile isSpace) . lines <$> readFile "patat.cabal"
+
+getPrettySourceDate :: IO String
+getPrettySourceDate = do
+ epoch <- getEnv "SOURCE_DATE_EPOCH"
+ utc <- Time.parseTimeM True locale "%s" epoch :: IO Time.UTCTime
+ return $ Time.formatTime locale "%B %d, %Y" utc
+ where
+ locale = Time.defaultTimeLocale
+
+type Sections = [(Int, T.Text, [Pandoc.Block])]
+
+toSections :: Int -> [Pandoc.Block] -> Sections
+toSections level = go
+ where
+ go [] = []
+ go (h : xs) = case toSectionHeader h of
+ Nothing -> go xs
+ Just (l, title) ->
+ let (section, cont) = break (isJust . toSectionHeader) xs in
+ (l, title, section) : go cont
+
+ toSectionHeader :: Pandoc.Block -> Maybe (Int, T.Text)
+ toSectionHeader (Pandoc.Header l _ inlines) = do
+ guard (l <= level)
+ let doc = Pandoc.Pandoc Pandoc.nullMeta [Pandoc.Plain inlines]
+ txt = case Pandoc.runPure (Pandoc.writeMarkdown Pandoc.def doc) of
+ Left err -> throw err -- Bad!
+ Right x -> x
+ return (l, txt)
+ toSectionHeader _ = Nothing
+
+fromSections :: Sections -> [Pandoc.Block]
+fromSections = concatMap $ \(level, title, blocks) ->
+ Pandoc.Header level ("", [], []) [Pandoc.Str $ T.unpack title] : blocks
+
+reorganizeSections :: Pandoc.Pandoc -> Pandoc.Pandoc
+reorganizeSections (Pandoc.Pandoc meta0 blocks0) =
+ let sections0 = toSections 2 blocks0 in
+ Pandoc.Pandoc meta0 $ fromSections $
+ [ (1, "NAME", nameSection)
+ ] ++
+ [ (1, "SYNOPSIS", s)
+ | (_, _, s) <- lookupSection "Running" sections0
+ ] ++
+ [ (1, "DESCRIPTION", [])
+ ] ++
+ [ (2, n, s)
+ | (_, n, s) <- lookupSection "Controls" sections0
+ ] ++
+ [ (2, n, s)
+ | (_, n, s) <- lookupSection "Input format" sections0
+ ] ++
+ [ (2, n, s)
+ | (_, n, s) <- lookupSection "Configuration" sections0
+ ] ++
+ [ (1, "OPTIONS", s)
+ | (_, _, s) <- lookupSection "Options" sections0
+ ] ++
+ [ (1, "SEE ALSO", seeAlsoSection)
+ ]
+ where
+ nameSection = mkPara "patat - Presentations Atop The ANSI Terminal"
+ seeAlsoSection = mkPara "pandoc(1)"
+ mkPara str = [Pandoc.Para [Pandoc.Str str]]
+
+ lookupSection name sections =
+ [section | section@(_, n, _) <- sections, name == n]
+
+main :: IO ()
+main = Pandoc.runIOorExplode $ do
+ liftIO $ Encoding.setLocaleEncoding Encoding.utf8
+
+ let readerOptions = Pandoc.def
+ { Pandoc.readerExtensions = Pandoc.pandocExtensions
+ }
+
+ source <- liftIO $ T.readFile "README.md"
+ pandoc0 <- Pandoc.readMarkdown readerOptions source
+ template <- Pandoc.getDefaultTemplate "man"
+
+ version <- liftIO getVersion
+ date <- liftIO getPrettySourceDate
+
+ let writerOptions = Pandoc.def
+ { Pandoc.writerTemplate = Just template
+ , Pandoc.writerVariables =
+ [ ("author", "Jasper Van der Jeugt")
+ , ("title", "patat manual")
+ , ("date", date)
+ , ("footer", "patat v" ++ version)
+ , ("section", "1")
+ ]
+ }
+
+ let pandoc1 = reorganizeSections $ pandoc0
+ txt <- Pandoc.writeMan writerOptions pandoc1
+ liftIO $ do
+ T.putStr txt
+ IO.hPutStrLn IO.stderr "Wrote man page."
--- /dev/null
+Name: patat
+Version: 0.8.1.2
+Synopsis: Terminal-based presentations using Pandoc
+Description: Terminal-based presentations using Pandoc
+License: GPL-2
+License-file: LICENSE
+Author: Jasper Van der Jeugt <m@jaspervdj.be>
+Maintainer: Jasper Van der Jeugt <m@jaspervdj.be>
+Homepage: http://github.com/jaspervdj/patat
+Copyright: 2016 Jasper Van der Jeugt
+Category: Text
+Build-type: Simple
+Cabal-version: >=1.10
+
+Extra-source-files:
+ CHANGELOG.md
+ README.md
+
+Source-repository head
+ Type: git
+ Location: git://github.com/jaspervdj/patat.git
+
+Flag patat-make-man
+ Description: Build the executable to generate the man page
+ Default: False
+ Manual: True
+
+Executable patat
+ Main-is: Main.hs
+ Ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N"
+ Hs-source-dirs: src
+ Default-language: Haskell2010
+
+ Build-depends:
+ 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,
+ 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.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,
+ network >= 2.6
+
+ If impl(ghc < 8.0)
+ Build-depends:
+ semigroups >= 0.16 && < 0.19
+
+ Other-modules:
+ Data.Aeson.Extended
+ 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
+ Patat.Presentation.Display.Table
+ Patat.Presentation.Fragment
+ Patat.Presentation.Interactive
+ Patat.Presentation.Internal
+ Patat.Presentation.Read
+ Patat.PrettyPrint
+ Patat.Theme
+ Paths_patat
+ Text.Pandoc.Extended
+
+Executable patat-make-man
+ Main-is: make-man.hs
+ Ghc-options: -Wall
+ Hs-source-dirs: extra
+ Default-language: Haskell2010
+
+ If flag(patat-make-man)
+ Buildable: True
+ Else
+ Buildable: False
+
+ Build-depends:
+ base >= 4.6 && < 5,
+ mtl >= 2.2 && < 2.3,
+ pandoc >= 2.0 && < 2.3,
+ text >= 1.2 && < 1.3,
+ time >= 1.6 && < 1.10
--- /dev/null
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Data.Aeson.Extended
+ ( module Data.Aeson
+
+ , FlexibleNum (..)
+ ) where
+
+import Control.Applicative ((<$>))
+import Data.Aeson
+import qualified Data.Text as T
+import Text.Read (readMaybe)
+import Prelude
+
+-- | This can be parsed from a JSON string in addition to a JSON number.
+newtype FlexibleNum a = FlexibleNum {unFlexibleNum :: a}
+ deriving (Show, ToJSON)
+
+instance (FromJSON a, Read a) => FromJSON (FlexibleNum a) where
+ parseJSON (String str) = case readMaybe (T.unpack str) of
+ Nothing -> fail $ "Could not parse " ++ T.unpack str ++ " as a number"
+ Just x -> return (FlexibleNum x)
+ parseJSON val = FlexibleNum <$> parseJSON val
--- /dev/null
+--------------------------------------------------------------------------------
+module Data.Aeson.TH.Extended
+ ( module Data.Aeson.TH
+ , dropPrefixOptions
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Data.Aeson.TH
+import Data.Char (isUpper, toLower)
+
+
+--------------------------------------------------------------------------------
+dropPrefixOptions :: Options
+dropPrefixOptions = defaultOptions
+ { fieldLabelModifier = dropPrefix
+ }
+ where
+ dropPrefix str = case break isUpper str of
+ (_, (y : ys)) -> toLower y : ys
+ _ -> str
--- /dev/null
+module Data.Data.Extended
+ ( module Data.Data
+
+ , grecQ
+ , grecT
+ ) where
+
+import Data.Data
+
+-- | Recursively find all values of a certain type.
+grecQ :: (Data a, Data b) => a -> [b]
+grecQ = concat . gmapQ (\x -> maybe id (:) (cast x) $ grecQ x)
+
+-- | Recursively apply an update to a certain type.
+grecT :: (Data a, Data b) => (a -> a) -> b -> b
+grecT f x = gmapT (grecT f) (castMap f x)
+
+castMap :: (Typeable a, Typeable b) => (a -> a) -> b -> b
+castMap f x = case cast x of
+ Nothing -> x
+ Just y -> case cast (f y) of
+ Nothing -> x
+ Just z -> z
--- /dev/null
+--------------------------------------------------------------------------------
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Main where
+
+
+--------------------------------------------------------------------------------
+import Control.Applicative ((<$>), (<*>))
+import Control.Concurrent (forkIO, threadDelay)
+import qualified Control.Concurrent.Chan as Chan
+import Control.Exception (finally)
+import Control.Monad (forever, unless, when)
+import qualified Data.Aeson.Extended as A
+import Data.Monoid (mempty, (<>))
+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
+import qualified System.Console.ANSI as Ansi
+import System.Directory (doesFileExist,
+ getModificationTime)
+import System.Exit (exitFailure, exitSuccess)
+import qualified System.IO as IO
+import qualified Text.PrettyPrint.ANSI.Leijen as PP
+
+
+--------------------------------------------------------------------------------
+data Options = Options
+ { oFilePath :: !(Maybe FilePath)
+ , oForce :: !Bool
+ , oDump :: !Bool
+ , oWatch :: !Bool
+ , oVersion :: !Bool
+ } deriving (Show)
+
+
+--------------------------------------------------------------------------------
+parseOptions :: OA.Parser Options
+parseOptions = Options
+ <$> (OA.optional $ OA.strArgument $
+ OA.metavar "FILENAME" <>
+ OA.help "Input file")
+ <*> (OA.switch $
+ OA.long "force" <>
+ OA.short 'f' <>
+ OA.help "Force ANSI terminal" <>
+ OA.hidden)
+ <*> (OA.switch $
+ OA.long "dump" <>
+ OA.short 'd' <>
+ OA.help "Just dump all slides and exit" <>
+ OA.hidden)
+ <*> (OA.switch $
+ OA.long "watch" <>
+ OA.short 'w' <>
+ OA.help "Watch file for changes")
+ <*> (OA.switch $
+ OA.long "version" <>
+ OA.help "Display version info and exit" <>
+ OA.hidden)
+
+
+--------------------------------------------------------------------------------
+parserInfo :: OA.ParserInfo Options
+parserInfo = OA.info (OA.helper <*> parseOptions) $
+ OA.fullDesc <>
+ OA.header ("patat v" <> showVersion Paths_patat.version) <>
+ OA.progDescDoc (Just desc)
+ where
+ desc = PP.vcat
+ [ "Terminal-based presentations using Pandoc"
+ , ""
+ , "Controls:"
+ , "- Next slide: space, enter, l, right, pagedown"
+ , "- Previous slide: backspace, h, left, pageup"
+ , "- Go forward 10 slides: j, down"
+ , "- Go backward 10 slides: k, up"
+ , "- First slide: 0"
+ , "- Last slide: G"
+ , "- Reload file: r"
+ , "- Quit: q"
+ ]
+
+
+--------------------------------------------------------------------------------
+parserPrefs :: OA.ParserPrefs
+parserPrefs = OA.prefs OA.showHelpOnError
+
+
+--------------------------------------------------------------------------------
+errorAndExit :: [String] -> IO a
+errorAndExit msg = do
+ mapM_ (IO.hPutStrLn IO.stderr) msg
+ exitFailure
+
+
+--------------------------------------------------------------------------------
+assertAnsiFeatures :: IO ()
+assertAnsiFeatures = do
+ supports <- Ansi.hSupportsANSI IO.stdout
+ unless supports $ errorAndExit
+ [ "It looks like your terminal does not support ANSI codes."
+ , "If you still want to run the presentation, use `--force`."
+ ]
+
+
+--------------------------------------------------------------------------------
+main :: IO ()
+main = do
+ options <- OA.customExecParser parserPrefs parserInfo
+
+ when (oVersion options) $ do
+ putStrLn (showVersion Paths_patat.version)
+ exitSuccess
+
+ filePath <- case oFilePath options of
+ Just fp -> return fp
+ Nothing -> OA.handleParseResult $ OA.Failure $
+ OA.parserFailure parserPrefs parserInfo OA.ShowHelpText mempty
+
+ errOrPres <- readPresentation filePath
+ pres <- either (errorAndExit . return) return errOrPres
+
+ unless (oForce options) assertAnsiFeatures
+
+ -- (Maybe) initialize images backend.
+ images <- traverse Images.new (psImages $ pSettings pres)
+
+ if oDump options
+ then dumpPresentation pres
+ else interactiveLoop options images pres
+ where
+ interactiveLoop :: Options -> Maybe Images.Handle -> Presentation -> IO ()
+ interactiveLoop options images pres0 = (`finally` cleanup) $ do
+ IO.hSetBuffering IO.stdin IO.NoBuffering
+ Ansi.hideCursor
+
+ -- Spawn the initial channel that gives us commands based on user input.
+ commandChan0 <- Chan.newChan
+ _ <- forkIO $ forever $
+ readPresentationCommand >>= Chan.writeChan commandChan0
+
+ -- If an auto delay is set, use 'autoAdvance' to create a new one.
+ commandChan <- case psAutoAdvanceDelay (pSettings pres0) of
+ Nothing -> return commandChan0
+ Just (A.FlexibleNum delay) -> autoAdvance delay commandChan0
+
+ -- Spawn a thread that adds 'Reload' commands based on the file time.
+ mtime0 <- getModificationTime (pFilePath pres0)
+ when (oWatch options) $ do
+ _ <- forkIO $ watcher commandChan (pFilePath pres0) mtime0
+ return ()
+
+ let loop :: Presentation -> Maybe String -> IO ()
+ loop pres mbError = do
+ case mbError of
+ Nothing -> displayPresentation images pres
+ Just err -> displayPresentationError pres err
+
+ c <- Chan.readChan commandChan
+ update <- updatePresentation c pres
+ case update of
+ ExitedPresentation -> return ()
+ UpdatedPresentation pres' -> loop pres' Nothing
+ ErroredPresentation err -> loop pres (Just err)
+
+ loop pres0 Nothing
+
+ cleanup :: IO ()
+ cleanup = do
+ Ansi.showCursor
+ Ansi.clearScreen
+ Ansi.setCursorPosition 0 0
+
+
+--------------------------------------------------------------------------------
+watcher :: Chan.Chan PresentationCommand -> FilePath -> UTCTime -> IO a
+watcher chan filePath mtime0 = do
+ -- The extra exists check helps because some editors temporarily make the
+ -- file disappear while writing.
+ exists <- doesFileExist filePath
+ mtime1 <- if exists then getModificationTime filePath else return mtime0
+
+ when (mtime1 > mtime0) $ Chan.writeChan chan Reload
+ threadDelay (200 * 1000)
+ watcher chan filePath mtime1
--- /dev/null
+--------------------------------------------------------------------------------
+module Patat.AutoAdvance
+ ( autoAdvance
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Concurrent (forkIO, threadDelay)
+import qualified Control.Concurrent.Chan as Chan
+import Control.Monad (forever)
+import qualified Data.IORef as IORef
+import Data.Time (diffUTCTime, getCurrentTime)
+import Patat.Presentation (PresentationCommand (..))
+
+
+--------------------------------------------------------------------------------
+-- | This function takes an existing channel for presentation commands
+-- (presumably coming from human input) and creates a new one that /also/ sends
+-- a 'Forward' command if nothing happens for N seconds.
+autoAdvance
+ :: Int
+ -> Chan.Chan PresentationCommand
+ -> IO (Chan.Chan PresentationCommand)
+autoAdvance delaySeconds existingChan = do
+ let delay = delaySeconds * 1000 -- We are working with ms in this function
+
+ newChan <- Chan.newChan
+ latestCommandAt <- IORef.newIORef =<< getCurrentTime
+
+ -- This is a thread that copies 'existingChan' to 'newChan', and writes
+ -- whenever the latest command was to 'latestCommandAt'.
+ _ <- forkIO $ forever $ do
+ cmd <- Chan.readChan existingChan
+ getCurrentTime >>= IORef.writeIORef latestCommandAt
+ Chan.writeChan newChan cmd
+
+ -- This is a thread that waits around 'delay' seconds and then checks if
+ -- there's been a more recent command. If not, we write a 'Forward'.
+ _ <- forkIO $ forever $ do
+ current <- getCurrentTime
+ latest <- IORef.readIORef latestCommandAt
+ let elapsed = floor $ 1000 * (current `diffUTCTime` latest) :: Int
+ if elapsed >= delay
+ then do
+ Chan.writeChan newChan Forward
+ IORef.writeIORef latestCommandAt current
+ threadDelay (delay * 1000)
+ else do
+ let wait = delay - elapsed
+ threadDelay (wait * 1000)
+
+ return newChan
--- /dev/null
+--------------------------------------------------------------------------------
+{-# 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
--- /dev/null
+--------------------------------------------------------------------------------
+{-# 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"
--- /dev/null
+--------------------------------------------------------------------------------
+{-# 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 ()
+ }
--- /dev/null
+--------------------------------------------------------------------------------
+{-# 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)
--- /dev/null
+module Patat.Presentation
+ ( PresentationSettings (..)
+ , defaultPresentationSettings
+
+ , Presentation (..)
+ , readPresentation
+ , displayPresentation
+ , displayPresentationError
+ , dumpPresentation
+
+ , PresentationCommand (..)
+ , readPresentationCommand
+ , UpdatedPresentation (..)
+ , updatePresentation
+ ) where
+
+import Patat.Presentation.Display
+import Patat.Presentation.Interactive
+import Patat.Presentation.Internal
+import Patat.Presentation.Read
--- /dev/null
+--------------------------------------------------------------------------------
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Patat.Presentation.Display
+ ( displayPresentation
+ , displayPresentationError
+ , dumpPresentation
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Applicative ((<$>))
+import Control.Monad (mplus, unless)
+import qualified Data.Aeson.Extended as A
+import Data.Data.Extended (grecQ)
+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
+import Patat.PrettyPrint ((<$$>), (<+>))
+import qualified Patat.PrettyPrint as PP
+import Patat.Theme (Theme (..))
+import qualified Patat.Theme as Theme
+import Prelude
+import qualified System.Console.ANSI as Ansi
+import qualified System.Console.Terminal.Size as Terminal
+import qualified System.IO as IO
+import qualified Text.Pandoc.Extended as Pandoc
+
+
+--------------------------------------------------------------------------------
+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 {..} f = do
+ Ansi.clearScreen
+ Ansi.setCursorPosition 0 0
+
+ -- Get terminal width/title
+ mbWindow <- Terminal.size
+ let columns = fromMaybe 72 $
+ (A.unFlexibleNum <$> psColumns pSettings) `mplus`
+ (Terminal.width <$> mbWindow)
+ rows = fromMaybe 24 $
+ (A.unFlexibleNum <$> psRows pSettings) `mplus`
+ (Terminal.height <$> mbWindow)
+
+ let settings = pSettings {psColumns = Just $ A.FlexibleNum columns}
+ theme = fromMaybe Theme.defaultTheme (psTheme settings)
+ title = PP.toString (prettyInlines theme pTitle)
+ titleWidth = length title
+ titleOffset = (columns - titleWidth) `div` 2
+ borders = themed (themeBorders theme)
+
+ unless (null title) $ do
+ 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 $ formatWith settings $ f canvasSize theme
+ putStrLn ""
+
+ 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 $ PP.space <> PP.string author <> middleSpaces <> PP.string active <> PP.space
+ IO.hFlush IO.stdout
+
+
+--------------------------------------------------------------------------------
+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
+ (mLeft, mRight) = marginsOf pSettings
+ offsetRow = (csRows canvasSize `div` 2) - (prows `div` 2)
+ offsetCol = ((csCols canvasSize - mLeft - mRight) `div` 2) - (pcols `div` 2)
+ spaces = PP.NotTrimmable $ PP.spaces offsetCol in
+ mconcat (replicate (offsetRow - 3) PP.hardline) <$$>
+ 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
+
+
+--------------------------------------------------------------------------------
+-- | Displays an error in the place of the presentation. This is useful if we
+-- want to display an error but keep the presentation running.
+displayPresentationError :: Presentation -> String -> IO ()
+displayPresentationError pres err = displayWithBorders pres $ \_ Theme {..} ->
+ themed themeStrong "Error occurred in the presentation:" <$$>
+ "" <$$>
+ (PP.string err)
+
+
+--------------------------------------------------------------------------------
+dumpPresentation :: Presentation -> IO ()
+dumpPresentation 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
+ TitleSlide block -> "~~~title" <$$> prettyBlock theme block
+ ContentSlide fragments -> PP.vcat $ L.intersperse "~~~frag" $ do
+ fragment <- fragments
+ return $ prettyFragment theme fragment
+
+
+--------------------------------------------------------------------------------
+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
+prettyFragment theme fragment@(Fragment blocks) =
+ prettyBlocks theme blocks <>
+ case prettyReferences theme fragment of
+ [] -> mempty
+ refs -> PP.hardline <> PP.vcat refs
+
+
+--------------------------------------------------------------------------------
+prettyBlock :: Theme -> Pandoc.Block -> PP.Doc
+
+prettyBlock theme (Pandoc.Plain inlines) = prettyInlines theme inlines
+
+prettyBlock theme (Pandoc.Para inlines) =
+ prettyInlines theme inlines <> PP.hardline
+
+prettyBlock theme@Theme {..} (Pandoc.Header i _ inlines) =
+ themed themeHeader (PP.string (replicate i '#') <+> prettyInlines theme inlines) <>
+ PP.hardline
+
+prettyBlock theme (Pandoc.CodeBlock (_, classes, _) txt) =
+ prettyCodeBlock theme classes txt
+
+prettyBlock theme (Pandoc.BulletList bss) = PP.vcat
+ [ PP.indent
+ (PP.NotTrimmable $ themed (themeBulletList theme) prefix)
+ (PP.Trimmable " ")
+ (prettyBlocks theme' bs)
+ | bs <- bss
+ ] <> PP.hardline
+ where
+ prefix = " " <> PP.string [marker] <> " "
+ marker = case T.unpack <$> themeBulletListMarkers theme of
+ Just (x : _) -> x
+ _ -> '-'
+
+ -- Cycle the markers.
+ theme' = theme
+ { themeBulletListMarkers =
+ (\ls -> T.drop 1 ls <> T.take 1 ls) <$> themeBulletListMarkers theme
+ }
+
+prettyBlock theme@Theme {..} (Pandoc.OrderedList _ bss) = PP.vcat
+ [ PP.indent
+ (PP.NotTrimmable $ themed themeOrderedList $ PP.string prefix)
+ (PP.Trimmable " ")
+ (prettyBlocks theme bs)
+ | (prefix, bs) <- zip padded bss
+ ] <> PP.hardline
+ where
+ padded = [n ++ replicate (4 - length n) ' ' | n <- numbers]
+ numbers =
+ [ show i ++ "."
+ | i <- [1 .. length bss]
+ ]
+
+prettyBlock _theme (Pandoc.RawBlock _ t) = PP.string t <> PP.hardline
+
+prettyBlock _theme Pandoc.HorizontalRule = "---"
+
+prettyBlock theme@Theme {..} (Pandoc.BlockQuote bs) =
+ let quote = PP.NotTrimmable (themed themeBlockQuote "> ") in
+ PP.indent quote quote (prettyBlocks theme bs)
+
+prettyBlock theme@Theme {..} (Pandoc.DefinitionList terms) =
+ PP.vcat $ map prettyDefinition terms
+ where
+ prettyDefinition (term, definitions) =
+ themed themeDefinitionTerm (prettyInlines theme term) <$$>
+ PP.hardline <> PP.vcat
+ [ PP.indent
+ (PP.NotTrimmable (themed themeDefinitionList ": "))
+ (PP.Trimmable " ") $
+ prettyBlocks theme (Pandoc.plainToPara definition)
+ | definition <- definitions
+ ]
+
+prettyBlock theme (Pandoc.Table caption aligns _ headers rows) =
+ PP.wrapAt Nothing $
+ prettyTable theme Table
+ { tCaption = prettyInlines theme caption
+ , tAligns = map align aligns
+ , tHeaders = map (prettyBlocks theme) headers
+ , tRows = map (map (prettyBlocks theme)) rows
+ }
+ where
+ align Pandoc.AlignLeft = PP.AlignLeft
+ align Pandoc.AlignCenter = PP.AlignCenter
+ align Pandoc.AlignDefault = PP.AlignLeft
+ align Pandoc.AlignRight = PP.AlignRight
+
+prettyBlock theme (Pandoc.Div _attrs blocks) = prettyBlocks theme blocks
+
+prettyBlock _theme Pandoc.Null = mempty
+
+#if MIN_VERSION_pandoc(1,18,0)
+-- 'LineBlock' elements are new in pandoc-1.18
+prettyBlock theme@Theme {..} (Pandoc.LineBlock inliness) =
+ let ind = PP.NotTrimmable (themed themeLineBlock "| ") in
+ PP.wrapAt Nothing $
+ PP.indent ind ind $
+ PP.vcat $
+ map (prettyInlines theme) inliness
+#endif
+
+
+--------------------------------------------------------------------------------
+prettyBlocks :: Theme -> [Pandoc.Block] -> PP.Doc
+prettyBlocks theme = PP.vcat . map (prettyBlock theme) . filter isVisibleBlock
+
+
+--------------------------------------------------------------------------------
+prettyInline :: Theme -> Pandoc.Inline -> PP.Doc
+
+prettyInline _theme Pandoc.Space = PP.space
+
+prettyInline _theme (Pandoc.Str str) = PP.string str
+
+prettyInline theme@Theme {..} (Pandoc.Emph inlines) =
+ themed themeEmph $
+ prettyInlines theme inlines
+
+prettyInline theme@Theme {..} (Pandoc.Strong inlines) =
+ themed themeStrong $
+ prettyInlines theme inlines
+
+prettyInline Theme {..} (Pandoc.Code _ txt) =
+ themed themeCode $
+ PP.string (" " <> txt <> " ")
+
+prettyInline theme@Theme {..} link@(Pandoc.Link _attrs text (target, _title))
+ | isReferenceLink link =
+ "[" <> themed themeLinkText (prettyInlines theme text) <> "]"
+ | otherwise =
+ "<" <> themed themeLinkTarget (PP.string target) <> ">"
+
+prettyInline _theme Pandoc.SoftBreak = PP.softline
+
+prettyInline _theme Pandoc.LineBreak = PP.hardline
+
+prettyInline theme@Theme {..} (Pandoc.Strikeout t) =
+ "~~" <> themed themeStrikeout (prettyInlines theme 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 Theme {..} (Pandoc.Math _ t) =
+ themed themeMath (PP.string t)
+
+prettyInline theme@Theme {..} (Pandoc.Image _attrs text (target, _title)) =
+ "![" <> themed themeImageText (prettyInlines theme text) <> "](" <>
+ themed themeImageTarget (PP.string 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.string 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 unsupported = PP.ondullred $ PP.string $ show unsupported
+
+
+--------------------------------------------------------------------------------
+prettyInlines :: Theme -> [Pandoc.Inline] -> PP.Doc
+prettyInlines theme = mconcat . map (prettyInline theme)
+
+
+--------------------------------------------------------------------------------
+prettyReferences :: Theme -> Fragment -> [PP.Doc]
+prettyReferences theme@Theme {..} =
+ map prettyReference . getReferences . unFragment
+ where
+ getReferences :: [Pandoc.Block] -> [Pandoc.Inline]
+ getReferences = filter isReferenceLink . grecQ
+
+ prettyReference :: Pandoc.Inline -> PP.Doc
+ prettyReference (Pandoc.Link _attrs text (target, title)) =
+ "[" <>
+ themed themeLinkText (prettyInlines theme $ Pandoc.newlineToSpace text) <>
+ "](" <>
+ themed themeLinkTarget (PP.string target) <>
+ (if null title
+ then mempty
+ else PP.space <> "\"" <> PP.string title <> "\"")
+ <> ")"
+ prettyReference _ = mempty
+
+
+--------------------------------------------------------------------------------
+isReferenceLink :: Pandoc.Inline -> Bool
+isReferenceLink (Pandoc.Link _attrs text (target, _)) =
+ [Pandoc.Str target] /= text
+isReferenceLink _ = False
+
+
+--------------------------------------------------------------------------------
+isVisibleBlock :: Pandoc.Block -> Bool
+isVisibleBlock Pandoc.Null = False
+isVisibleBlock (Pandoc.RawBlock (Pandoc.Format "html") t) =
+ not ("<!--" `L.isPrefixOf` t && "-->" `L.isSuffixOf` t)
+isVisibleBlock _ = True
--- /dev/null
+--------------------------------------------------------------------------------
+-- | Displaying code blocks, optionally with syntax highlighting.
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Patat.Presentation.Display.CodeBlock
+ ( prettyCodeBlock
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Data.Maybe (mapMaybe)
+import Data.Monoid (mconcat, (<>))
+import qualified Data.Text as T
+import Patat.Presentation.Display.Table (themed)
+import qualified Patat.PrettyPrint as PP
+import Patat.Theme
+import Prelude
+import qualified Skylighting as Skylighting
+
+
+--------------------------------------------------------------------------------
+highlight :: [String] -> String -> [Skylighting.SourceLine]
+highlight classes rawCodeBlock = case mapMaybe getSyntax classes of
+ [] -> zeroHighlight rawCodeBlock
+ (syn : _) ->
+ case Skylighting.tokenize config syn (T.pack rawCodeBlock) of
+ Left _ -> zeroHighlight rawCodeBlock
+ Right sl -> sl
+ where
+ getSyntax :: String -> Maybe Skylighting.Syntax
+ getSyntax c = Skylighting.lookupSyntax (T.pack c) syntaxMap
+
+ config :: Skylighting.TokenizerConfig
+ config = Skylighting.TokenizerConfig
+ { Skylighting.syntaxMap = syntaxMap
+ , Skylighting.traceOutput = False
+ }
+
+ syntaxMap :: Skylighting.SyntaxMap
+ syntaxMap = Skylighting.defaultSyntaxMap
+
+
+--------------------------------------------------------------------------------
+-- | This does fake highlighting, everything becomes a normal token. That makes
+-- things a bit easier, since we only need to deal with one cases in the
+-- renderer.
+zeroHighlight :: String -> [Skylighting.SourceLine]
+zeroHighlight str =
+ [[(Skylighting.NormalTok, T.pack line)] | line <- lines str]
+
+
+--------------------------------------------------------------------------------
+prettyCodeBlock :: Theme -> [String] -> String -> PP.Doc
+prettyCodeBlock theme@Theme {..} classes rawCodeBlock =
+ PP.vcat (map blockified sourceLines) <>
+ PP.hardline
+ where
+ sourceLines :: [Skylighting.SourceLine]
+ sourceLines =
+ [[]] ++ highlight 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)
+
+ sourceLineLength :: Skylighting.SourceLine -> Int
+ sourceLineLength line = sum [T.length str | (_, str) <- line]
+
+ blockWidth :: Int
+ blockWidth = foldr max 0 (map sourceLineLength sourceLines)
+
+ blockified :: Skylighting.SourceLine -> PP.Doc
+ blockified line =
+ let len = sourceLineLength line
+ indent = PP.NotTrimmable " " in
+ PP.indent indent indent $
+ themed themeCodeBlock $
+ " " <>
+ prettySourceLine line <>
+ PP.string (replicate (blockWidth - len) ' ') <> " "
--- /dev/null
+--------------------------------------------------------------------------------
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Patat.Presentation.Display.Table
+ ( Table (..)
+ , prettyTable
+
+ , themed
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Data.List (intersperse, transpose)
+import Data.Monoid (mconcat, mempty, (<>))
+import Patat.PrettyPrint ((<$$>))
+import qualified Patat.PrettyPrint as PP
+import Patat.Theme (Theme (..))
+import qualified Patat.Theme as Theme
+import Prelude
+
+
+--------------------------------------------------------------------------------
+data Table = Table
+ { tCaption :: PP.Doc
+ , tAligns :: [PP.Alignment]
+ , tHeaders :: [PP.Doc]
+ , tRows :: [[PP.Doc]]
+ }
+
+
+--------------------------------------------------------------------------------
+prettyTable
+ :: Theme -> Table -> PP.Doc
+prettyTable theme@Theme {..} Table {..} =
+ PP.indent (PP.Trimmable " ") (PP.Trimmable " ") $
+ lineIf (not isHeaderLess) (hcat2 headerHeight
+ [ themed themeTableHeader (PP.align w a (vpad headerHeight header))
+ | (w, a, header) <- zip3 columnWidths tAligns tHeaders
+ ]) <>
+ dashedHeaderSeparator theme columnWidths <$$>
+ joinRows
+ [ hcat2 rowHeight
+ [ PP.align w a (vpad rowHeight cell)
+ | (w, a, cell) <- zip3 columnWidths tAligns row
+ ]
+ | (rowHeight, row) <- zip rowHeights tRows
+ ] <$$>
+ lineIf isHeaderLess (dashedHeaderSeparator theme columnWidths) <>
+ lineIf
+ (not $ PP.null tCaption) (PP.hardline <> "Table: " <> tCaption)
+ where
+ lineIf cond line = if cond then line <> PP.hardline else mempty
+
+ joinRows
+ | all (all isSimpleCell) tRows = PP.vcat
+ | otherwise = PP.vcat . intersperse ""
+
+ isHeaderLess = all PP.null tHeaders
+
+ headerDimensions = map PP.dimensions tHeaders :: [(Int, Int)]
+ rowDimensions = map (map PP.dimensions) tRows :: [[(Int, Int)]]
+
+ columnWidths :: [Int]
+ columnWidths =
+ [ safeMax (map snd col)
+ | col <- transpose (headerDimensions : rowDimensions)
+ ]
+
+ rowHeights = map (safeMax . map fst) rowDimensions :: [Int]
+ headerHeight = safeMax (map fst headerDimensions) :: Int
+
+ vpad :: Int -> PP.Doc -> PP.Doc
+ vpad height doc =
+ let (actual, _) = PP.dimensions doc in
+ doc <> mconcat (replicate (height - actual) PP.hardline)
+
+ safeMax = foldr max 0
+
+ hcat2 :: Int -> [PP.Doc] -> PP.Doc
+ hcat2 rowHeight = PP.paste . intersperse (spaces2 rowHeight)
+
+ spaces2 :: Int -> PP.Doc
+ spaces2 rowHeight =
+ mconcat $ intersperse PP.hardline $
+ replicate rowHeight (PP.string " ")
+
+
+--------------------------------------------------------------------------------
+isSimpleCell :: PP.Doc -> Bool
+isSimpleCell = (<= 1) . fst . PP.dimensions
+
+
+--------------------------------------------------------------------------------
+dashedHeaderSeparator :: Theme -> [Int] -> PP.Doc
+dashedHeaderSeparator Theme {..} columnWidths =
+ mconcat $ intersperse (PP.string " ")
+ [ themed 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
--- /dev/null
+-- | For background info on the spec, see the "Incremental lists" section of the
+-- the pandoc manual.
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
+module Patat.Presentation.Fragment
+ ( FragmentSettings (..)
+ , fragmentBlocks
+ , fragmentBlock
+ ) where
+
+import Data.Foldable (Foldable)
+import Data.List (foldl', intersperse)
+import Data.Maybe (fromMaybe)
+import Data.Traversable (Traversable)
+import Prelude
+import qualified Text.Pandoc as Pandoc
+
+data FragmentSettings = FragmentSettings
+ { fsIncrementalLists :: !Bool
+ } deriving (Show)
+
+-- fragmentBlocks :: [Pandoc.Block] -> [[Pandoc.Block]]
+-- fragmentBlocks = NonEmpty.toList . joinFragmentedBlocks . map fragmentBlock
+fragmentBlocks :: FragmentSettings -> [Pandoc.Block] -> [[Pandoc.Block]]
+fragmentBlocks fs blocks0 =
+ case joinFragmentedBlocks (map (fragmentBlock fs) blocks0) of
+ Unfragmented bs -> [bs]
+ Fragmented xs bs -> map (fromMaybe []) xs ++ [fromMaybe [] bs]
+
+-- | This is all the ways we can "present" a block, after splitting in
+-- fragments.
+--
+-- In the simplest (and most common case) a block can only be presented in a
+-- single way ('Unfragmented').
+--
+-- Alternatively, we might want to show different (partial) versions of the
+-- block first before showing the final complete one. These partial or complete
+-- versions can be empty, hence the 'Maybe'.
+--
+-- For example, imagine that we display the following bullet list incrementally:
+--
+-- > [1, 2, 3]
+--
+-- Then we would get something like:
+--
+-- > Fragmented [Nothing, Just [1], Just [1, 2]] (Just [1, 2, 3])
+data Fragmented a
+ = Unfragmented a
+ | Fragmented [Maybe a] (Maybe a)
+ deriving (Functor, Foldable, Show, Traversable)
+
+fragmentBlock :: FragmentSettings -> Pandoc.Block -> Fragmented Pandoc.Block
+fragmentBlock _fs block@(Pandoc.Para inlines)
+ | inlines == threeDots = Fragmented [Nothing] Nothing
+ | otherwise = Unfragmented block
+ where
+ threeDots = intersperse Pandoc.Space $ replicate 3 (Pandoc.Str ".")
+
+fragmentBlock fs (Pandoc.BulletList bs0) =
+ fragmentList fs (fsIncrementalLists fs) Pandoc.BulletList bs0
+
+fragmentBlock fs (Pandoc.OrderedList attr bs0) =
+ fragmentList fs (fsIncrementalLists fs) (Pandoc.OrderedList attr) bs0
+
+fragmentBlock fs (Pandoc.BlockQuote [Pandoc.BulletList bs0]) =
+ fragmentList fs (not $ fsIncrementalLists fs) Pandoc.BulletList bs0
+
+fragmentBlock fs (Pandoc.BlockQuote [Pandoc.OrderedList attr bs0]) =
+ fragmentList fs (not $ fsIncrementalLists fs) (Pandoc.OrderedList attr) bs0
+
+fragmentBlock _ block@(Pandoc.BlockQuote _) = Unfragmented block
+
+fragmentBlock _ block@(Pandoc.Header _ _ _) = Unfragmented block
+fragmentBlock _ block@(Pandoc.Plain _) = Unfragmented block
+fragmentBlock _ block@(Pandoc.CodeBlock _ _) = Unfragmented block
+fragmentBlock _ block@(Pandoc.RawBlock _ _) = Unfragmented block
+fragmentBlock _ block@(Pandoc.DefinitionList _) = Unfragmented block
+fragmentBlock _ block@(Pandoc.Table _ _ _ _ _) = Unfragmented block
+fragmentBlock _ block@(Pandoc.Div _ _) = Unfragmented block
+fragmentBlock _ block@Pandoc.HorizontalRule = Unfragmented block
+fragmentBlock _ block@Pandoc.Null = Unfragmented block
+
+#if MIN_VERSION_pandoc(1,18,0)
+fragmentBlock _ block@(Pandoc.LineBlock _) = Unfragmented block
+#endif
+
+joinFragmentedBlocks :: [Fragmented block] -> Fragmented [block]
+joinFragmentedBlocks =
+ foldl' append (Unfragmented [])
+ where
+ append (Unfragmented xs) (Unfragmented y) =
+ Unfragmented (xs ++ [y])
+
+ append (Fragmented xs x) (Unfragmented y) =
+ Fragmented xs (appendMaybe x (Just y))
+
+ append (Unfragmented x) (Fragmented ys y) =
+ Fragmented
+ [appendMaybe (Just x) y' | y' <- ys]
+ (appendMaybe (Just x) y)
+
+ append (Fragmented xs x) (Fragmented ys y) =
+ Fragmented
+ (xs ++ [appendMaybe x y' | y' <- ys])
+ (appendMaybe x y)
+
+ appendMaybe :: Maybe [a] -> Maybe a -> Maybe [a]
+ appendMaybe Nothing Nothing = Nothing
+ appendMaybe Nothing (Just x) = Just [x]
+ appendMaybe (Just xs) Nothing = Just xs
+ appendMaybe (Just xs) (Just x) = Just (xs ++ [x])
+
+fragmentList
+ :: FragmentSettings -- ^ Global settings
+ -> Bool -- ^ Fragment THIS list?
+ -> ([[Pandoc.Block]] -> Pandoc.Block) -- ^ List constructor
+ -> [[Pandoc.Block]] -- ^ List items
+ -> Fragmented Pandoc.Block -- ^ Resulting list
+fragmentList fs fragmentThisList constructor blocks0 =
+ fmap constructor fragmented
+ where
+ -- The fragmented list per list item.
+ items :: [Fragmented [Pandoc.Block]]
+ items = map (joinFragmentedBlocks . map (fragmentBlock fs)) blocks0
+
+ fragmented :: Fragmented [[Pandoc.Block]]
+ fragmented = joinFragmentedBlocks $
+ map (if fragmentThisList then insertPause else id) items
+
+ insertPause :: Fragmented a -> Fragmented a
+ insertPause (Unfragmented x) = Fragmented [Nothing] (Just x)
+ insertPause (Fragmented xs x) = Fragmented (Nothing : xs) x
--- /dev/null
+--------------------------------------------------------------------------------
+-- | Module that allows the user to interact with the presentation
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Patat.Presentation.Interactive
+ ( PresentationCommand (..)
+ , readPresentationCommand
+
+ , UpdatedPresentation (..)
+ , updatePresentation
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Patat.Presentation.Internal
+import Patat.Presentation.Read
+
+
+--------------------------------------------------------------------------------
+data PresentationCommand
+ = Exit
+ | Forward
+ | Backward
+ | SkipForward
+ | SkipBackward
+ | First
+ | Last
+ | Reload
+ | UnknownCommand String
+
+
+--------------------------------------------------------------------------------
+readPresentationCommand :: IO PresentationCommand
+readPresentationCommand = do
+ k <- readKey
+ case k of
+ "q" -> return Exit
+ "\n" -> return Forward
+ "\DEL" -> return Backward
+ "h" -> return Backward
+ "j" -> return SkipForward
+ "k" -> return SkipBackward
+ "l" -> return Forward
+ -- Arrow keys
+ "\ESC[C" -> return Forward
+ "\ESC[D" -> return Backward
+ "\ESC[B" -> return SkipForward
+ "\ESC[A" -> return SkipBackward
+ -- PageUp and PageDown
+ "\ESC[6" -> return Forward
+ "\ESC[5" -> return Backward
+ "0" -> return First
+ "G" -> return Last
+ "r" -> return Reload
+ _ -> return (UnknownCommand k)
+ where
+ readKey :: IO String
+ readKey = do
+ c0 <- getChar
+ case c0 of
+ '\ESC' -> do
+ c1 <- getChar
+ case c1 of
+ '[' -> do
+ c2 <- getChar
+ return [c0, c1, c2]
+ _ -> return [c0, c1]
+ _ -> return [c0]
+
+
+--------------------------------------------------------------------------------
+data UpdatedPresentation
+ = UpdatedPresentation !Presentation
+ | ExitedPresentation
+ | ErroredPresentation String
+ deriving (Show)
+
+
+--------------------------------------------------------------------------------
+updatePresentation
+ :: PresentationCommand -> Presentation -> IO UpdatedPresentation
+
+updatePresentation cmd presentation = case cmd of
+ Exit -> return ExitedPresentation
+ Forward -> return $ goToSlide $ \(s, f) -> (s, f + 1)
+ Backward -> return $ goToSlide $ \(s, f) -> (s, f - 1)
+ SkipForward -> return $ goToSlide $ \(s, _) -> (s + 10, 0)
+ SkipBackward -> return $ goToSlide $ \(s, _) -> (s - 10, 0)
+ First -> return $ goToSlide $ \_ -> (0, 0)
+ Last -> return $ goToSlide $ \_ -> (numSlides presentation, 0)
+ Reload -> reloadPresentation
+ UnknownCommand _ -> return (UpdatedPresentation presentation)
+ where
+ numSlides :: Presentation -> Int
+ numSlides pres = length (pSlides pres)
+
+ clip :: Index -> Presentation -> Index
+ clip (slide, fragment) pres
+ | slide >= numSlides pres = (numSlides pres - 1, lastFragments - 1)
+ | slide < 0 = (0, 0)
+ | fragment >= numFragments' slide =
+ if slide + 1 >= numSlides pres
+ then (slide, lastFragments - 1)
+ else (slide + 1, 0)
+ | fragment < 0 =
+ if slide - 1 >= 0
+ then (slide - 1, numFragments' (slide - 1) - 1)
+ else (slide, 0)
+ | otherwise = (slide, fragment)
+ where
+ numFragments' s = maybe 1 numFragments (getSlide s pres)
+ lastFragments = numFragments' (numSlides pres - 1)
+
+ goToSlide :: (Index -> Index) -> UpdatedPresentation
+ goToSlide f = UpdatedPresentation $ presentation
+ { pActiveFragment = clip (f $ pActiveFragment presentation) presentation
+ }
+
+ reloadPresentation = do
+ errOrPres <- readPresentation (pFilePath presentation)
+ return $ case errOrPres of
+ Left err -> ErroredPresentation err
+ Right pres -> UpdatedPresentation $ pres
+ { pActiveFragment = clip (pActiveFragment presentation) pres
+ }
--- /dev/null
+--------------------------------------------------------------------------------
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Patat.Presentation.Internal
+ ( Presentation (..)
+ , PresentationSettings (..)
+ , defaultPresentationSettings
+
+ , Margins (..)
+ , marginsOf
+
+ , ExtensionList (..)
+ , defaultExtensionList
+
+ , ImageSettings (..)
+
+ , Slide (..)
+ , Fragment (..)
+ , Index
+
+ , getSlide
+ , numFragments
+
+ , ActiveFragment (..)
+ , getActiveFragment
+ ) 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 Data.List (intercalate)
+import Data.Maybe (fromMaybe, listToMaybe)
+import Data.Monoid (Monoid (..))
+import Data.Semigroup (Semigroup (..))
+import qualified Data.Text as T
+import qualified Patat.Theme as Theme
+import Prelude
+import qualified Text.Pandoc as Pandoc
+import Text.Read (readMaybe)
+
+
+--------------------------------------------------------------------------------
+data Presentation = Presentation
+ { pFilePath :: !FilePath
+ , pTitle :: ![Pandoc.Inline]
+ , pAuthor :: ![Pandoc.Inline]
+ , pSettings :: !PresentationSettings
+ , pSlides :: [Slide]
+ , pActiveFragment :: !Index
+ } deriving (Show)
+
+
+--------------------------------------------------------------------------------
+-- | 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)
+ } 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
+ }
+
+
+--------------------------------------------------------------------------------
+instance Monoid PresentationSettings where
+ mappend = (<>)
+ mempty = PresentationSettings
+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+ Nothing Nothing Nothing
+
+
+--------------------------------------------------------------------------------
+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)
+
+
+--------------------------------------------------------------------------------
+instance A.FromJSON ExtensionList where
+ parseJSON = A.withArray "FromJSON ExtensionList" $
+ fmap (ExtensionList . mconcat) . mapM parseExt . Foldable.toList
+ where
+ parseExt = A.withText "FromJSON ExtensionList" $ \txt -> case txt of
+ -- Our default extensions
+ "patat_extensions" -> return (unExtensionList defaultExtensionList)
+
+ -- Individuals
+ _ -> case readMaybe ("Ext_" ++ T.unpack txt) of
+ Just e -> return $ Pandoc.extensionsFromList [e]
+ Nothing -> fail $
+ "Unknown extension: " ++ show txt ++
+ ", known extensions are: " ++
+ intercalate ", "
+ [ show (drop 4 (show e))
+ | e <- [minBound .. maxBound] :: [Pandoc.Extension]
+ ]
+
+
+--------------------------------------------------------------------------------
+defaultExtensionList :: ExtensionList
+defaultExtensionList = ExtensionList $
+ Pandoc.readerExtensions Pandoc.def `mappend` Pandoc.extensionsFromList
+ [ Pandoc.Ext_yaml_metadata_block
+ , Pandoc.Ext_table_captions
+ , Pandoc.Ext_simple_tables
+ , Pandoc.Ext_multiline_tables
+ , Pandoc.Ext_grid_tables
+ , Pandoc.Ext_pipe_tables
+ , Pandoc.Ext_raw_html
+ , Pandoc.Ext_tex_math_dollars
+ , Pandoc.Ext_fenced_code_blocks
+ , Pandoc.Ext_fenced_code_attributes
+ , Pandoc.Ext_backtick_code_blocks
+ , Pandoc.Ext_inline_code_attributes
+ , Pandoc.Ext_fancy_lists
+ , Pandoc.Ext_four_space_rule
+ , Pandoc.Ext_definition_lists
+ , Pandoc.Ext_compact_definition_lists
+ , Pandoc.Ext_example_lists
+ , Pandoc.Ext_strikeout
+ , Pandoc.Ext_superscript
+ , Pandoc.Ext_subscript
+ ]
+
+
+--------------------------------------------------------------------------------
+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
+ deriving (Show)
+
+
+--------------------------------------------------------------------------------
+newtype Fragment = Fragment {unFragment :: [Pandoc.Block]}
+ deriving (Monoid, Semigroup, Show)
+
+
+--------------------------------------------------------------------------------
+-- | Active slide, active fragment.
+type Index = (Int, Int)
+
+
+--------------------------------------------------------------------------------
+getSlide :: Int -> Presentation -> Maybe Slide
+getSlide sidx = listToMaybe . drop sidx . pSlides
+
+
+--------------------------------------------------------------------------------
+numFragments :: Slide -> Int
+numFragments (ContentSlide fragments) = length fragments
+numFragments (TitleSlide _) = 1
+
+
+--------------------------------------------------------------------------------
+data ActiveFragment = ActiveContent Fragment | ActiveTitle Pandoc.Block
+ deriving (Show)
+
+
+--------------------------------------------------------------------------------
+getActiveFragment :: Presentation -> Maybe ActiveFragment
+getActiveFragment presentation = do
+ let (sidx, fidx) = pActiveFragment presentation
+ slide <- getSlide sidx presentation
+ case slide of
+ TitleSlide block -> return (ActiveTitle block)
+ ContentSlide fragments ->
+ fmap ActiveContent . listToMaybe $ drop fidx fragments
+
+
+--------------------------------------------------------------------------------
+$(A.deriveFromJSON A.dropPrefixOptions ''PresentationSettings)
+$(A.deriveFromJSON A.dropPrefixOptions ''Margins)
--- /dev/null
+-- | Read a presentation from disk.
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Patat.Presentation.Read
+ ( readPresentation
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Monad.Except (ExceptT (..), runExceptT,
+ throwError)
+import Control.Monad.Trans (liftIO)
+import qualified Data.Aeson as A
+import qualified Data.HashMap.Strict as HMS
+import Data.Maybe (fromMaybe)
+import Data.Monoid (mempty, (<>))
+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.Presentation.Fragment
+import Patat.Presentation.Internal
+import Prelude
+import System.Directory (doesFileExist, getHomeDirectory)
+import System.FilePath (takeExtension, (</>))
+import qualified Text.Pandoc.Error as Pandoc
+import qualified Text.Pandoc.Extended as Pandoc
+
+
+--------------------------------------------------------------------------------
+readPresentation :: FilePath -> IO (Either String Presentation)
+readPresentation filePath = runExceptT $ do
+ -- We need to read the settings first.
+ src <- liftIO $ T.readFile filePath
+ homeSettings <- ExceptT readHomeSettings
+ metaSettings <- ExceptT $ return $ readMetaSettings src
+ let settings = metaSettings <> homeSettings <> defaultPresentationSettings
+
+ let pexts = fromMaybe defaultExtensionList (psPandocExtensions settings)
+ reader <- case readExtension pexts ext of
+ Nothing -> throwError $ "Unknown file extension: " ++ show ext
+ Just x -> return x
+ doc <- case reader src of
+ Left e -> throwError $ "Could not parse document: " ++ show e
+ Right x -> return x
+
+ ExceptT $ return $ pandocToPresentation filePath settings doc
+ where
+ ext = takeExtension filePath
+
+
+--------------------------------------------------------------------------------
+readExtension
+ :: ExtensionList -> String
+ -> Maybe (T.Text -> Either Pandoc.PandocError Pandoc.Pandoc)
+readExtension (ExtensionList extensions) fileExt = case fileExt of
+ ".md" -> 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
+
+ where
+ readerOpts = Pandoc.def
+ { Pandoc.readerExtensions =
+ extensions <> absolutelyRequiredExtensions
+ }
+
+ lhsOpts = readerOpts
+ { Pandoc.readerExtensions =
+ Pandoc.readerExtensions readerOpts <>
+ Pandoc.extensionsFromList [Pandoc.Ext_literate_haskell]
+ }
+
+ absolutelyRequiredExtensions =
+ Pandoc.extensionsFromList [Pandoc.Ext_yaml_metadata_block]
+
+
+--------------------------------------------------------------------------------
+pandocToPresentation
+ :: FilePath -> PresentationSettings -> Pandoc.Pandoc
+ -> Either String Presentation
+pandocToPresentation pFilePath pSettings pandoc@(Pandoc.Pandoc meta _) = do
+ let !pTitle = Pandoc.docTitle meta
+ !pSlides = pandocToSlides pSettings pandoc
+ !pActiveFragment = (0, 0)
+ !pAuthor = concat (Pandoc.docAuthors meta)
+ return Presentation {..}
+
+
+--------------------------------------------------------------------------------
+-- | This re-parses the pandoc metadata block using the YAML library. This
+-- avoids the problems caused by pandoc involving rendering Markdown. This
+-- should only be used for settings though, not things like title / authors
+-- since those /can/ contain markdown.
+parseMetadataBlock :: T.Text -> Maybe A.Value
+parseMetadataBlock src = do
+ block <- T.encodeUtf8 <$> mbBlock
+ either (const Nothing) Just (Yaml.decodeEither' block)
+ where
+ mbBlock :: Maybe T.Text
+ mbBlock = case T.lines src of
+ ("---" : ls) -> case break (`elem` ["---", "..."]) ls of
+ (_, []) -> Nothing
+ (block, (_ : _)) -> Just (T.unlines block)
+ _ -> Nothing
+
+
+--------------------------------------------------------------------------------
+-- | Read settings from the metadata block in the Pandoc document.
+readMetaSettings :: T.Text -> Either String PresentationSettings
+readMetaSettings src = fromMaybe (Right mempty) $ do
+ A.Object obj <- parseMetadataBlock src
+ val <- HMS.lookup "patat" obj
+ return $! resultToEither $! A.fromJSON val
+ where
+ resultToEither :: A.Result a -> Either String a
+ resultToEither (A.Success x) = Right x
+ resultToEither (A.Error e) = Left $!
+ "Error parsing patat settings from metadata: " ++ e
+
+
+--------------------------------------------------------------------------------
+-- | Read settings from "$HOME/.patat.yaml".
+readHomeSettings :: IO (Either String PresentationSettings)
+readHomeSettings = do
+ home <- getHomeDirectory
+ let path = home </> ".patat.yaml"
+ exists <- doesFileExist path
+ if not exists
+ then return (Right mempty)
+ else do
+ errOrPs <- Yaml.decodeFileEither path
+ return $! case errOrPs of
+ Left err -> Left (show err)
+ Right ps -> Right ps
+
+
+--------------------------------------------------------------------------------
+pandocToSlides :: PresentationSettings -> Pandoc.Pandoc -> [Slide]
+pandocToSlides settings pandoc =
+ let slideLevel = fromMaybe (detectSlideLevel pandoc) (psSlideLevel settings)
+ unfragmented = splitSlides slideLevel pandoc
+ fragmented =
+ [ case slide of
+ TitleSlide _ -> slide
+ ContentSlide fragments0 ->
+ let blocks = concatMap unFragment fragments0
+ blockss = fragmentBlocks fragmentSettings blocks in
+ ContentSlide (map Fragment blockss)
+ | slide <- unfragmented
+ ] in
+ fragmented
+ where
+ fragmentSettings = FragmentSettings
+ { fsIncrementalLists = fromMaybe False (psIncrementalLists settings)
+ }
+
+
+--------------------------------------------------------------------------------
+-- | Find level of header that starts slides. This is defined as the least
+-- header that occurs before a non-header in the blocks.
+detectSlideLevel :: Pandoc.Pandoc -> Int
+detectSlideLevel (Pandoc.Pandoc _meta blocks0) =
+ go 6 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
+
+ nonHeader (Pandoc.Header _ _ _) = False
+ nonHeader _ = True
+
+
+--------------------------------------------------------------------------------
+-- | Split a pandoc document into slides. If the document contains horizonal
+-- rules, we use those as slide delimiters. If there are no horizontal rules,
+-- we split using headers, determined by the slide level (see
+-- 'detectSlideLevel').
+splitSlides :: Int -> Pandoc.Pandoc -> [Slide]
+splitSlides slideLevel (Pandoc.Pandoc _meta blocks0)
+ | any (== Pandoc.HorizontalRule) blocks0 = splitAtRules blocks0
+ | otherwise = splitAtHeaders [] blocks0
+ where
+ mkContentSlide :: [Pandoc.Block] -> [Slide]
+ mkContentSlide [] = [] -- Never create empty slides
+ mkContentSlide bs = [ContentSlide [Fragment bs]]
+
+ splitAtRules blocks = case break (== Pandoc.HorizontalRule) blocks of
+ (xs, []) -> mkContentSlide xs
+ (xs, (_rule : ys)) -> mkContentSlide xs ++ splitAtRules ys
+
+ splitAtHeaders acc [] =
+ mkContentSlide (reverse acc)
+ splitAtHeaders acc (b@(Pandoc.Header i _ _) : bs)
+ | i > slideLevel = splitAtHeaders (b : acc) bs
+ | i == slideLevel =
+ mkContentSlide (reverse acc) ++ splitAtHeaders [b] bs
+ | otherwise =
+ mkContentSlide (reverse acc) ++ [TitleSlide b] ++ splitAtHeaders [] bs
+ splitAtHeaders acc (b : bs) =
+ splitAtHeaders (b : acc) bs
--- /dev/null
+--------------------------------------------------------------------------------
+-- | This is a small pretty-printing library.
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+module Patat.PrettyPrint
+ ( Doc
+ , toString
+ , dimensions
+ , null
+
+ , hPutDoc
+ , putDoc
+
+ , string
+ , text
+ , space
+ , spaces
+ , softline
+ , hardline
+
+ , wrapAt
+
+ , Trimmable (..)
+ , indent
+
+ , ansi
+
+ , (<+>)
+ , (<$$>)
+ , vcat
+
+ -- * Exotic combinators
+ , Alignment (..)
+ , align
+ , paste
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Monad.Reader (asks, local)
+import Control.Monad.RWS (RWS, runRWS)
+import Control.Monad.State (get, gets, modify)
+import Control.Monad.Writer (tell)
+import Data.Foldable (Foldable)
+import qualified Data.List as L
+import Data.Monoid (Monoid, mconcat, mempty)
+import Data.Semigroup (Semigroup (..))
+import Data.String (IsString (..))
+import qualified Data.Text as T
+import Data.Traversable (Traversable, traverse)
+import Prelude hiding (null)
+import qualified System.Console.ANSI as Ansi
+import qualified System.IO as IO
+
+
+--------------------------------------------------------------------------------
+-- | A simple chunk of text. All ANSI codes are "reset" after printing.
+data Chunk
+ = StringChunk [Ansi.SGR] String
+ | NewlineChunk
+ deriving (Eq)
+
+
+--------------------------------------------------------------------------------
+type Chunks = [Chunk]
+
+
+--------------------------------------------------------------------------------
+hPutChunk :: IO.Handle -> Chunk -> IO ()
+hPutChunk h NewlineChunk = IO.hPutStrLn h ""
+hPutChunk h (StringChunk codes str) = do
+ Ansi.hSetSGR h (reverse codes)
+ IO.hPutStr h str
+ Ansi.hSetSGR h [Ansi.Reset]
+
+
+--------------------------------------------------------------------------------
+chunkToString :: Chunk -> String
+chunkToString NewlineChunk = "\n"
+chunkToString (StringChunk _ str) = str
+
+
+--------------------------------------------------------------------------------
+-- | If two neighboring chunks have the same set of ANSI codes, we can group
+-- them together.
+optimizeChunks :: Chunks -> Chunks
+optimizeChunks (StringChunk c1 s1 : StringChunk c2 s2 : chunks)
+ | c1 == c2 = optimizeChunks (StringChunk c1 (s1 <> s2) : chunks)
+ | otherwise =
+ StringChunk c1 s1 : optimizeChunks (StringChunk c2 s2 : chunks)
+optimizeChunks (x : chunks) = x : optimizeChunks chunks
+optimizeChunks [] = []
+
+
+--------------------------------------------------------------------------------
+chunkLines :: Chunks -> [Chunks]
+chunkLines chunks = case break (== NewlineChunk) chunks of
+ (xs, _newline : ys) -> xs : chunkLines ys
+ (xs, []) -> [xs]
+
+
+--------------------------------------------------------------------------------
+data DocE
+ = String String
+ | Softspace
+ | Hardspace
+ | Softline
+ | Hardline
+ | WrapAt
+ { wrapAtCol :: Maybe Int
+ , wrapDoc :: Doc
+ }
+ | Ansi
+ { ansiCode :: [Ansi.SGR] -> [Ansi.SGR] -- ^ Modifies current codes.
+ , ansiDoc :: Doc
+ }
+ | Indent
+ { indentFirstLine :: LineBuffer
+ , indentOtherLines :: LineBuffer
+ , indentDoc :: Doc
+ }
+
+
+--------------------------------------------------------------------------------
+chunkToDocE :: Chunk -> DocE
+chunkToDocE NewlineChunk = Hardline
+chunkToDocE (StringChunk codes str) = Ansi (\_ -> codes) (Doc [String str])
+
+
+--------------------------------------------------------------------------------
+newtype Doc = Doc {unDoc :: [DocE]}
+ deriving (Monoid, Semigroup)
+
+
+--------------------------------------------------------------------------------
+instance IsString Doc where
+ fromString = string
+
+
+--------------------------------------------------------------------------------
+instance Show Doc where
+ show = toString
+
+
+--------------------------------------------------------------------------------
+data DocEnv = DocEnv
+ { deCodes :: [Ansi.SGR] -- ^ Most recent ones first in the list
+ , deIndent :: LineBuffer -- ^ Don't need to store first-line indent
+ , deWrap :: Maybe Int -- ^ Wrap at columns
+ }
+
+
+--------------------------------------------------------------------------------
+type DocM = RWS DocEnv Chunks LineBuffer
+
+
+--------------------------------------------------------------------------------
+data Trimmable a
+ = NotTrimmable !a
+ | Trimmable !a
+ deriving (Foldable, Functor, Traversable)
+
+
+--------------------------------------------------------------------------------
+-- | Note that this is reversed so we have fast append
+type LineBuffer = [Trimmable Chunk]
+
+
+--------------------------------------------------------------------------------
+bufferToChunks :: LineBuffer -> Chunks
+bufferToChunks = map trimmableToChunk . reverse . dropWhile isTrimmable
+ where
+ isTrimmable (NotTrimmable _) = False
+ isTrimmable (Trimmable _) = True
+
+ trimmableToChunk (NotTrimmable c) = c
+ trimmableToChunk (Trimmable c) = c
+
+
+--------------------------------------------------------------------------------
+docToChunks :: Doc -> Chunks
+docToChunks doc0 =
+ let env0 = DocEnv [] [] Nothing
+ ((), b, cs) = runRWS (go $ unDoc doc0) env0 mempty in
+ optimizeChunks (cs <> bufferToChunks b)
+ where
+ go :: [DocE] -> DocM ()
+
+ go [] = return ()
+
+ go (String str : docs) = do
+ chunk <- makeChunk str
+ modify (NotTrimmable chunk :)
+ go docs
+
+ go (Softspace : docs) = do
+ hard <- softConversion Softspace docs
+ go (hard : docs)
+
+ go (Hardspace : docs) = do
+ chunk <- makeChunk " "
+ modify (NotTrimmable chunk :)
+ go docs
+
+ go (Softline : docs) = do
+ hard <- softConversion Softline docs
+ go (hard : docs)
+
+ go (Hardline : docs) = do
+ buffer <- get
+ tell $ bufferToChunks buffer <> [NewlineChunk]
+ indentation <- asks deIndent
+ modify $ \_ -> if L.null docs then [] else indentation
+ go docs
+
+ go (WrapAt {..} : docs) = do
+ local (\env -> env {deWrap = wrapAtCol}) $ go (unDoc wrapDoc)
+ go docs
+
+ go (Ansi {..} : docs) = do
+ local (\env -> env {deCodes = ansiCode (deCodes env)}) $
+ go (unDoc ansiDoc)
+ go docs
+
+ go (Indent {..} : docs) = do
+ local (\env -> env {deIndent = indentOtherLines ++ deIndent env}) $ do
+ modify (indentFirstLine ++)
+ go (unDoc indentDoc)
+ go docs
+
+ makeChunk :: String -> DocM Chunk
+ makeChunk str = do
+ codes <- asks deCodes
+ return $ StringChunk codes str
+
+ -- Convert 'Softspace' or 'Softline' to 'Hardspace' or 'Hardline'
+ softConversion :: DocE -> [DocE] -> DocM DocE
+ softConversion soft docs = do
+ mbWrapCol <- asks deWrap
+ case mbWrapCol of
+ Nothing -> return hard
+ Just maxCol -> do
+ -- Slow.
+ currentLine <- gets (concatMap chunkToString . bufferToChunks)
+ let currentCol = length currentLine
+ case nextWordLength docs of
+ Nothing -> return hard
+ Just l
+ | currentCol + 1 + l <= maxCol -> return Hardspace
+ | otherwise -> return Hardline
+ where
+ hard = case soft of
+ Softspace -> Hardspace
+ Softline -> Hardline
+ _ -> soft
+
+ nextWordLength :: [DocE] -> Maybe Int
+ nextWordLength [] = Nothing
+ nextWordLength (String x : xs)
+ | L.null x = nextWordLength xs
+ | otherwise = Just (length x)
+ nextWordLength (Softspace : xs) = nextWordLength xs
+ nextWordLength (Hardspace : xs) = nextWordLength xs
+ nextWordLength (Softline : xs) = nextWordLength xs
+ nextWordLength (Hardline : _) = Nothing
+ nextWordLength (WrapAt {..} : xs) = nextWordLength (unDoc wrapDoc ++ xs)
+ nextWordLength (Ansi {..} : xs) = nextWordLength (unDoc ansiDoc ++ xs)
+ nextWordLength (Indent {..} : xs) = nextWordLength (unDoc indentDoc ++ xs)
+
+
+--------------------------------------------------------------------------------
+toString :: Doc -> String
+toString = concat . map chunkToString . docToChunks
+
+
+--------------------------------------------------------------------------------
+-- | Returns the rows and columns necessary to render this document
+dimensions :: Doc -> (Int, Int)
+dimensions doc =
+ let ls = lines (toString doc) in
+ (length ls, foldr max 0 (map length ls))
+
+
+--------------------------------------------------------------------------------
+null :: Doc -> Bool
+null doc = case unDoc doc of [] -> True; _ -> False
+
+
+--------------------------------------------------------------------------------
+hPutDoc :: IO.Handle -> Doc -> IO ()
+hPutDoc h = mapM_ (hPutChunk h) . docToChunks
+
+
+--------------------------------------------------------------------------------
+putDoc :: Doc -> IO ()
+putDoc = hPutDoc IO.stdout
+
+
+--------------------------------------------------------------------------------
+mkDoc :: DocE -> Doc
+mkDoc e = Doc [e]
+
+
+--------------------------------------------------------------------------------
+string :: String -> Doc
+string = mkDoc . String -- TODO (jaspervdj): Newline conversion
+
+
+--------------------------------------------------------------------------------
+text :: T.Text -> Doc
+text = string . T.unpack
+
+
+--------------------------------------------------------------------------------
+space :: Doc
+space = mkDoc Softspace
+
+
+--------------------------------------------------------------------------------
+spaces :: Int -> Doc
+spaces n = mconcat $ replicate n space
+
+
+--------------------------------------------------------------------------------
+softline :: Doc
+softline = mkDoc Softline
+
+
+--------------------------------------------------------------------------------
+hardline :: Doc
+hardline = mkDoc Hardline
+
+
+--------------------------------------------------------------------------------
+wrapAt :: Maybe Int -> Doc -> Doc
+wrapAt wrapAtCol wrapDoc = mkDoc WrapAt {..}
+
+
+--------------------------------------------------------------------------------
+indent :: Trimmable Doc -> Trimmable Doc -> Doc -> Doc
+indent firstLineDoc otherLinesDoc doc = mkDoc $ Indent
+ { indentFirstLine = traverse docToChunks firstLineDoc
+ , indentOtherLines = traverse docToChunks otherLinesDoc
+ , indentDoc = doc
+ }
+
+
+--------------------------------------------------------------------------------
+ansi :: [Ansi.SGR] -> Doc -> Doc
+ansi codes = mkDoc . Ansi (codes ++)
+
+
+--------------------------------------------------------------------------------
+(<+>) :: Doc -> Doc -> Doc
+x <+> y = x <> space <> y
+infixr 6 <+>
+
+
+--------------------------------------------------------------------------------
+(<$$>) :: Doc -> Doc -> Doc
+x <$$> y = x <> hardline <> y
+infixr 5 <$$>
+
+
+--------------------------------------------------------------------------------
+vcat :: [Doc] -> Doc
+vcat = mconcat . L.intersperse hardline
+
+
+--------------------------------------------------------------------------------
+data Alignment = AlignLeft | AlignCenter | AlignRight deriving (Eq, Ord, Show)
+
+
+--------------------------------------------------------------------------------
+align :: Int -> Alignment -> Doc -> Doc
+align width alignment doc0 =
+ let chunks0 = docToChunks doc0
+ lines_ = chunkLines chunks0 in
+ vcat
+ [ Doc (map chunkToDocE (alignLine line))
+ | line <- lines_
+ ]
+ where
+ lineWidth :: [Chunk] -> Int
+ lineWidth = sum . map (length . chunkToString)
+
+ alignLine :: [Chunk] -> [Chunk]
+ alignLine line =
+ let actual = lineWidth line
+ chunkSpaces n = [StringChunk [] (replicate n ' ')] in
+ case alignment of
+ AlignLeft -> line <> chunkSpaces (width - actual)
+ AlignRight -> chunkSpaces (width - actual) <> line
+ AlignCenter ->
+ let r = (width - actual) `div` 2
+ l = (width - actual) - r in
+ chunkSpaces l <> line <> chunkSpaces r
+
+
+--------------------------------------------------------------------------------
+-- | Like the unix program 'paste'.
+paste :: [Doc] -> Doc
+paste docs0 =
+ let chunkss = map docToChunks docs0 :: [Chunks]
+ cols = map chunkLines chunkss :: [[Chunks]]
+ rows0 = L.transpose cols :: [[Chunks]]
+ rows1 = map (map (Doc . map chunkToDocE)) rows0 :: [[Doc]] in
+ vcat $ map mconcat rows1
--- /dev/null
+--------------------------------------------------------------------------------
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Patat.Theme
+ ( Theme (..)
+ , defaultTheme
+
+ , Style (..)
+
+ , SyntaxHighlighting (..)
+ , defaultSyntaxHighlighting
+ , syntaxHighlight
+ ) where
+
+
+--------------------------------------------------------------------------------
+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)
+
+
+--------------------------------------------------------------------------------
+data Theme = Theme
+ { themeBorders :: !(Maybe Style)
+ , themeHeader :: !(Maybe Style)
+ , themeCodeBlock :: !(Maybe Style)
+ , themeBulletList :: !(Maybe Style)
+ , themeBulletListMarkers :: !(Maybe T.Text)
+ , themeOrderedList :: !(Maybe Style)
+ , themeBlockQuote :: !(Maybe Style)
+ , themeDefinitionTerm :: !(Maybe Style)
+ , themeDefinitionList :: !(Maybe Style)
+ , themeTableHeader :: !(Maybe Style)
+ , themeTableSeparator :: !(Maybe Style)
+ , themeLineBlock :: !(Maybe Style)
+ , themeEmph :: !(Maybe Style)
+ , themeStrong :: !(Maybe Style)
+ , themeCode :: !(Maybe Style)
+ , themeLinkText :: !(Maybe Style)
+ , themeLinkTarget :: !(Maybe Style)
+ , themeStrikeout :: !(Maybe Style)
+ , themeQuoted :: !(Maybe Style)
+ , themeMath :: !(Maybe Style)
+ , themeImageText :: !(Maybe Style)
+ , themeImageTarget :: !(Maybe Style)
+ , themeSyntaxHighlighting :: !(Maybe SyntaxHighlighting)
+ } deriving (Show)
+
+
+--------------------------------------------------------------------------------
+instance Semigroup Theme where
+ l <> r = Theme
+ { themeBorders = mplusOn themeBorders
+ , themeHeader = mplusOn themeHeader
+ , themeCodeBlock = mplusOn themeCodeBlock
+ , themeBulletList = mplusOn themeBulletList
+ , themeBulletListMarkers = mplusOn themeBulletListMarkers
+ , themeOrderedList = mplusOn themeOrderedList
+ , themeBlockQuote = mplusOn themeBlockQuote
+ , themeDefinitionTerm = mplusOn themeDefinitionTerm
+ , themeDefinitionList = mplusOn themeDefinitionList
+ , themeTableHeader = mplusOn themeTableHeader
+ , themeTableSeparator = mplusOn themeTableSeparator
+ , themeLineBlock = mplusOn themeLineBlock
+ , themeEmph = mplusOn themeEmph
+ , themeStrong = mplusOn themeStrong
+ , themeCode = mplusOn themeCode
+ , themeLinkText = mplusOn themeLinkText
+ , themeLinkTarget = mplusOn themeLinkTarget
+ , themeStrikeout = mplusOn themeStrikeout
+ , themeQuoted = mplusOn themeQuoted
+ , themeMath = mplusOn themeMath
+ , themeImageText = mplusOn themeImageText
+ , themeImageTarget = mplusOn themeImageTarget
+ , themeSyntaxHighlighting = mappendOn themeSyntaxHighlighting
+ }
+ where
+ mplusOn f = f l `mplus` f r
+ mappendOn f = f l `mappend` f r
+
+
+--------------------------------------------------------------------------------
+instance Monoid Theme where
+ mappend = (<>)
+ mempty = Theme
+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+ Nothing Nothing Nothing Nothing Nothing
+
+--------------------------------------------------------------------------------
+defaultTheme :: Theme
+defaultTheme = Theme
+ { themeBorders = dull Ansi.Yellow
+ , themeHeader = dull Ansi.Blue
+ , themeCodeBlock = dull Ansi.White `mappend` ondull Ansi.Black
+ , themeBulletList = dull Ansi.Magenta
+ , themeBulletListMarkers = Just "-*"
+ , themeOrderedList = dull Ansi.Magenta
+ , themeBlockQuote = dull Ansi.Green
+ , themeDefinitionTerm = dull Ansi.Blue
+ , themeDefinitionList = dull Ansi.Magenta
+ , themeTableHeader = dull Ansi.Blue
+ , themeTableSeparator = dull Ansi.Magenta
+ , themeLineBlock = dull Ansi.Magenta
+ , themeEmph = dull Ansi.Green
+ , themeStrong = dull Ansi.Red `mappend` bold
+ , themeCode = dull Ansi.White `mappend` ondull Ansi.Black
+ , themeLinkText = dull Ansi.Green
+ , themeLinkTarget = dull Ansi.Cyan `mappend` underline
+ , themeStrikeout = ondull Ansi.Red
+ , themeQuoted = dull Ansi.Green
+ , themeMath = dull Ansi.Green
+ , themeImageText = dull Ansi.Green
+ , themeImageTarget = dull Ansi.Cyan `mappend` underline
+ , themeSyntaxHighlighting = Just defaultSyntaxHighlighting
+ }
+ where
+ dull c = Just $ Style [Ansi.SetColor Ansi.Foreground Ansi.Dull c]
+ ondull c = Just $ Style [Ansi.SetColor Ansi.Background Ansi.Dull c]
+ bold = Just $ Style [Ansi.SetConsoleIntensity Ansi.BoldIntensity]
+ underline = Just $ Style [Ansi.SetUnderlining Ansi.SingleUnderline]
+
+
+--------------------------------------------------------------------------------
+newtype Style = Style {unStyle :: [Ansi.SGR]}
+ deriving (Monoid, Semigroup, Show)
+
+
+--------------------------------------------------------------------------------
+instance A.ToJSON Style where
+ toJSON = A.toJSON . mapMaybe sgrToString . unStyle
+
+
+--------------------------------------------------------------------------------
+instance A.FromJSON Style where
+ parseJSON val = do
+ names <- A.parseJSON val
+ sgrs <- mapM toSgr names
+ return $! Style sgrs
+ where
+ toSgr name = case stringToSgr name of
+ Just sgr -> return sgr
+ Nothing -> fail $!
+ "Unknown style: " ++ show name ++ ". Known styles are: " ++
+ intercalate ", " (map show $ M.keys namedSgrs) ++
+ ", or \"rgb#RrGgBb\" and \"onRgb#RrGgBb\" where 'Rr', " ++
+ "'Gg' and 'Bb' are hexadecimal bytes (e.g. \"rgb#f08000\")."
+
+
+--------------------------------------------------------------------------------
+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) $
+ (case intensity of
+ Ansi.Dull -> "dull"
+ Ansi.Vivid -> "vivid") ++
+ (case color of
+ Ansi.Black -> "Black"
+ Ansi.Red -> "Red"
+ Ansi.Green -> "Green"
+ Ansi.Yellow -> "Yellow"
+ Ansi.Blue -> "Blue"
+ Ansi.Magenta -> "Magenta"
+ Ansi.Cyan -> "Cyan"
+ Ansi.White -> "White")
+
+sgrToString (Ansi.SetUnderlining Ansi.SingleUnderline) = Just "underline"
+
+sgrToString (Ansi.SetConsoleIntensity Ansi.BoldIntensity) = Just "bold"
+
+sgrToString (Ansi.SetItalicized True) = Just "italic"
+
+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
+
+sgrToString _ = Nothing
+
+
+--------------------------------------------------------------------------------
+namedSgrs :: M.Map String Ansi.SGR
+namedSgrs = M.fromList
+ [ (name, sgr)
+ | sgr <- knownSgrs
+ , name <- maybeToList (sgrToString sgr)
+ ]
+ where
+ -- | It doesn't really matter if we generate "too much" SGRs here since
+ -- 'sgrToString' will only pick the ones we support.
+ knownSgrs =
+ [ Ansi.SetColor l i c
+ | l <- [minBound .. maxBound]
+ , i <- [minBound .. maxBound]
+ , c <- [minBound .. maxBound]
+ ] ++
+ [Ansi.SetUnderlining u | u <- [minBound .. maxBound]] ++
+ [Ansi.SetConsoleIntensity c | c <- [minBound .. maxBound]] ++
+ [Ansi.SetItalicized i | i <- [minBound .. maxBound]]
+
+
+--------------------------------------------------------------------------------
+newtype SyntaxHighlighting = SyntaxHighlighting
+ { unSyntaxHighlighting :: M.Map String Style
+ } deriving (Monoid, Semigroup, Show, A.ToJSON)
+
+
+--------------------------------------------------------------------------------
+instance A.FromJSON SyntaxHighlighting where
+ parseJSON val = do
+ styleMap <- A.parseJSON val
+ forM_ (M.keys styleMap) $ \k -> case nameToTokenType k of
+ Just _ -> return ()
+ Nothing -> fail $ "Unknown token type: " ++ show k
+ return (SyntaxHighlighting styleMap)
+
+
+--------------------------------------------------------------------------------
+defaultSyntaxHighlighting :: SyntaxHighlighting
+defaultSyntaxHighlighting = mkSyntaxHighlighting
+ [ (Skylighting.KeywordTok, dull Ansi.Yellow)
+ , (Skylighting.ControlFlowTok, dull Ansi.Yellow)
+
+ , (Skylighting.DataTypeTok, dull Ansi.Green)
+
+ , (Skylighting.DecValTok, dull Ansi.Red)
+ , (Skylighting.BaseNTok, dull Ansi.Red)
+ , (Skylighting.FloatTok, dull Ansi.Red)
+ , (Skylighting.ConstantTok, dull Ansi.Red)
+ , (Skylighting.CharTok, dull Ansi.Red)
+ , (Skylighting.SpecialCharTok, dull Ansi.Red)
+ , (Skylighting.StringTok, dull Ansi.Red)
+ , (Skylighting.VerbatimStringTok, dull Ansi.Red)
+ , (Skylighting.SpecialStringTok, dull Ansi.Red)
+
+ , (Skylighting.CommentTok, dull Ansi.Blue)
+ , (Skylighting.DocumentationTok, dull Ansi.Blue)
+ , (Skylighting.AnnotationTok, dull Ansi.Blue)
+ , (Skylighting.CommentVarTok, dull Ansi.Blue)
+
+ , (Skylighting.ImportTok, dull Ansi.Cyan)
+ , (Skylighting.OperatorTok, dull Ansi.Cyan)
+ , (Skylighting.FunctionTok, dull Ansi.Cyan)
+ , (Skylighting.PreprocessorTok, dull Ansi.Cyan)
+ ]
+ where
+ dull c = Style [Ansi.SetColor Ansi.Foreground Ansi.Dull c]
+
+ mkSyntaxHighlighting ls = SyntaxHighlighting $
+ M.fromList [(nameForTokenType tt, s) | (tt, s) <- ls]
+
+
+--------------------------------------------------------------------------------
+nameForTokenType :: Skylighting.TokenType -> String
+nameForTokenType =
+ unCapitalize . dropTok . show
+ where
+ unCapitalize (x : xs) = toLower x : xs
+ unCapitalize xs = xs
+
+ dropTok :: String -> String
+ dropTok str
+ | "Tok" `isSuffixOf` str = take (length str - 3) str
+ | otherwise = str
+
+
+--------------------------------------------------------------------------------
+nameToTokenType :: String -> Maybe Skylighting.TokenType
+nameToTokenType = readMaybe . capitalize . (++ "Tok")
+
+
+--------------------------------------------------------------------------------
+capitalize :: String -> String
+capitalize "" = ""
+capitalize (x : xs) = toUpper x : xs
+
+
+--------------------------------------------------------------------------------
+syntaxHighlight :: Theme -> Skylighting.TokenType -> Maybe Style
+syntaxHighlight theme tokenType = do
+ sh <- themeSyntaxHighlighting theme
+ M.lookup (nameForTokenType tokenType) (unSyntaxHighlighting sh)
+
+
+--------------------------------------------------------------------------------
+$(A.deriveJSON A.dropPrefixOptions ''Theme)
--- /dev/null
+--------------------------------------------------------------------------------
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+module Text.Pandoc.Extended
+ ( module Text.Pandoc
+
+ , plainToPara
+ , newlineToSpace
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Data.Data.Extended (grecT)
+import Text.Pandoc
+import Prelude
+
+
+--------------------------------------------------------------------------------
+plainToPara :: [Block] -> [Block]
+plainToPara = map $ \case
+ Plain inlines -> Para inlines
+ block -> block
+
+
+--------------------------------------------------------------------------------
+newlineToSpace :: [Inline] -> [Inline]
+newlineToSpace = grecT $ \case
+ SoftBreak -> Space
+ LineBreak -> Space
+ inline -> inline
--- /dev/null
+resolver: nightly-2018-08-29
+packages:
+- '.'
+flags:
+ patat:
+ patat-make-man: true
+extra-deps:
+- 'HsYAML-0.1.1.2'
+- 'aeson-1.4.0.0'
+- 'containers-0.5.11.0'
+- 'pandoc-2.2.3.2'
+- 'yaml-0.10.1.1'
--- /dev/null
+#!/bin/bash
+set -o nounset -o errexit -o pipefail
+
+srcs=$(find tests -type f ! -name '*.dump')
+stuff_went_wrong=false
+
+for src in $srcs; do
+ expected="$src.dump"
+ echo -n "Testing $src... "
+ actual=$(mktemp)
+ HOME=/dev/null patat --dump --force "$src" >"$actual"
+
+ if [[ $@ == "--fix" ]]; then
+ cp "$actual" "$expected"
+ echo 'Fixed'
+ elif [[ ! -f "$expected" ]]; then
+ echo "missing file: $expected"
+ stuff_went_wrong=true
+ elif [[ "$(cat "$expected")" == "$(cat "$actual")" ]]; then
+ echo 'OK'
+ else
+ echo 'files differ'
+ diff "$actual" "$expected" || true
+ stuff_went_wrong=true
+ fi
+done
+
+if [[ "$stuff_went_wrong" = true ]]; then
+ exit 1
+fi
--- /dev/null
+---
+title: This is my presentation
+author: Jasper Van der Jeugt
+...
+
+# This is a test
+
+Hello world
+
+---
+
+# This is a second slide
+
+lololol
--- /dev/null
+\e[34m# This is a test\e[0m
+
+\e[mHello world\e[0m
+
+\e[m----------\e[0m
+\e[34m# This is a second slide\e[0m
+
+\e[mlololol\e[0m
--- /dev/null
+This is how you define a `String` in Haskell:
+
+> test :: String
+> test = "Hello World!"
+
+Cool, right?
--- /dev/null
+\e[mThis is how you define a \e[0m\e[40;37m String \e[0m\e[m in Haskell:\e[0m
+
+\e[m \e[0m\e[40;37m \e[0m
+\e[m \e[0m\e[40;37m test :: \e[0m\e[40;37;32mString\e[0m\e[40;37m \e[0m
+\e[m \e[0m\e[40;37m test \e[0m\e[40;37;36m=\e[0m\e[40;37m \e[0m\e[40;37;31m"Hello World!"\e[0m\e[40;37m \e[0m
+\e[m \e[0m\e[40;37m \e[0m
+
+\e[mCool, right?\e[0m
--- /dev/null
+Inline markups:
+
+- ~~striked out~~
+- <http://example.com>
+
+---
+
+> Some quote
+
+> Quote with embedded list:
+>
+> - Hello
+> - World
+
+---
+
+- List with an embedded quote:
+
+ > Tu quoque
+
+ Wow rad stuff.
+
+- Second item in that list.
+
+---
+
+Code with empty line:
+
+ puts "wow"
+
+ puts "amaze"
+
+---
+
+Code in ordered list:
+
+1. Do you know the coolest codes?
+
+ It's this:
+
+ fire_missiles()
+ cancel()
+
+ Great
+
+2. Also `fib` is pretty cool yeah
--- /dev/null
+\e[mInline markups:\e[0m
+
+\e[35m - \e[0m\e[m~~\e[0m\e[41mstriked out\e[0m\e[m~~\e[0m
+\e[35m - \e[0m\e[m<\e[0m\e[4;36mhttp://example.com\e[0m\e[m>\e[0m
+
+\e[m----------\e[0m
+\e[32m> \e[0m\e[mSome quote\e[0m
+
+\e[32m> \e[0m\e[mQuote with embedded list:\e[0m
+\e[32m> \e[0m
+\e[32m> \e[0m\e[35m - \e[0m\e[mHello\e[0m
+\e[32m> \e[0m\e[35m - \e[0m\e[mWorld\e[0m
+
+\e[m----------\e[0m
+\e[35m - \e[0m\e[mList with an embedded quote:\e[0m
+
+\e[m \e[0m\e[32m> \e[0m\e[mTu quoque\e[0m
+
+\e[m Wow rad stuff.\e[0m
+
+\e[35m - \e[0m\e[mSecond item in that list.\e[0m
+
+
+\e[m----------\e[0m
+\e[mCode with empty line:\e[0m
+
+\e[m \e[0m\e[40;37m \e[0m
+\e[m \e[0m\e[40;37m puts "wow" \e[0m
+\e[m \e[0m\e[40;37m \e[0m
+\e[m \e[0m\e[40;37m puts "amaze" \e[0m
+\e[m \e[0m\e[40;37m \e[0m
+
+\e[m----------\e[0m
+\e[mCode in ordered list:\e[0m
+
+\e[35m1. \e[0m\e[mDo you know the coolest codes?\e[0m
+
+\e[m It's this:\e[0m
+
+\e[m \e[0m\e[40;37m \e[0m
+\e[m \e[0m\e[40;37m fire_missiles() \e[0m
+\e[m \e[0m\e[40;37m cancel() \e[0m
+\e[m \e[0m\e[40;37m \e[0m
+
+\e[m Great\e[0m
+
+\e[35m2. \e[0m\e[mAlso \e[0m\e[40;37m fib \e[0m\e[m is pretty cool yeah\e[0m
+
--- /dev/null
+---
+patat:
+ theme:
+ emph: [italic]
+ strong: [bold]
+...
+
+**Strong** and _emph_.
--- /dev/null
+\e[1mStrong\e[0m\e[m and \e[0m\e[3memph\e[0m\e[m.\e[0m
--- /dev/null
+# This is a test
+
+Hello world
+
+<!--
+This is a comment so please don't include it.
+-->
+
+# This is a second slide
+
+<!--- Differently-formatted comment -->
+
+Where are my raw blocks at
+
+<!-- Differently-formatted
+comment -->
--- /dev/null
+\e[34m# This is a test\e[0m
+
+\e[mHello world\e[0m
+
+\e[m----------\e[0m
+\e[34m# This is a second slide\e[0m
+
+\e[mWhere are my raw blocks at\e[0m
--- /dev/null
+Term 1
+
+: Definition 1
+
+Term 2 with *inline markup*
+
+: Definition 2
+
+ { some code, part of Definition 2 }
+
+ Third paragraph of definition 2.
+
+---
+
+Term 1
+ ~ Definition 1
+
+Term 2
+ ~ Definition 2a
+ ~ Definition 2b
--- /dev/null
+\e[34mTerm 1\e[0m
+
+\e[35m: \e[0m\e[mDefinition 1\e[0m
+
+\e[34mTerm 2 with \e[0m\e[34;32minline markup\e[0m
+
+\e[35m: \e[0m\e[mDefinition 2\e[0m
+
+\e[m \e[0m\e[40;37m \e[0m
+\e[m \e[0m\e[40;37m { some code, part of Definition 2 } \e[0m
+\e[m \e[0m\e[40;37m \e[0m
+
+\e[m Third paragraph of definition 2.\e[0m
+
+\e[m----------\e[0m
+\e[34mTerm 1\e[0m
+
+\e[35m: \e[0m\e[mDefinition 1\e[0m
+
+\e[34mTerm 2\e[0m
+
+\e[35m: \e[0m\e[mDefinition 2a\e[0m
+
+\e[35m: \e[0m\e[mDefinition 2b\e[0m
--- /dev/null
+---
+patat:
+ pandocExtensions:
+ - patat_extensions
+ - autolink_bare_uris
+ - emoji
+...
+
+Check out this example: http://example.com/ :smile:
--- /dev/null
+\e[mCheck out this example: <\e[0m\e[4;36mhttp://example.com/\e[0m\e[m> 😄\e[0m
--- /dev/null
+---
+patat:
+ pandocExtensions:
+ - emoji
+...
+
+The patat default ~~strikeout~~ is not enabled, but emojis are :smile:
--- /dev/null
+\e[mThe patat default ~~strikeout~~ is not enabled, but emojis are 😄\e[0m
--- /dev/null
+---
+patat:
+ incrementalLists: true
+...
+
+- This list
+- is displayed
+
+ * item
+ * by item
+
+- Or sometimes
+
+ > * all at
+ > * once
+
+---
+
+Legen
+
+. . .
+
+wait for it
+
+. . .
+
+Dary!
--- /dev/null
+
+
+\e[m~~~frag\e[0m
+\e[35m - \e[0m\e[mThis list\e[0m
+
+\e[m~~~frag\e[0m
+\e[35m - \e[0m\e[mThis list\e[0m
+\e[35m - \e[0m\e[mis displayed\e[0m
+
+
+
+
+\e[m~~~frag\e[0m
+\e[35m - \e[0m\e[mThis list\e[0m
+\e[35m - \e[0m\e[mis displayed\e[0m
+
+\e[m \e[0m\e[35m * \e[0m\e[mitem\e[0m
+
+
+\e[m~~~frag\e[0m
+\e[35m - \e[0m\e[mThis list\e[0m
+\e[35m - \e[0m\e[mis displayed\e[0m
+
+\e[m \e[0m\e[35m * \e[0m\e[mitem\e[0m
+\e[m \e[0m\e[35m * \e[0m\e[mby item\e[0m
+
+
+\e[m~~~frag\e[0m
+\e[35m - \e[0m\e[mThis list\e[0m
+\e[35m - \e[0m\e[mis displayed\e[0m
+
+\e[m \e[0m\e[35m * \e[0m\e[mitem\e[0m
+\e[m \e[0m\e[35m * \e[0m\e[mby item\e[0m
+
+\e[35m - \e[0m\e[mOr sometimes\e[0m
+
+\e[m \e[0m\e[35m * \e[0m\e[mall at\e[0m
+\e[m \e[0m\e[35m * \e[0m\e[monce\e[0m
+
+
+\e[m----------\e[0m
+\e[mLegen\e[0m
+
+\e[m~~~frag\e[0m
+\e[mLegen\e[0m
+
+\e[mwait for it\e[0m
+
+\e[m~~~frag\e[0m
+\e[mLegen\e[0m
+
+\e[mwait for it\e[0m
+
+\e[mDary!\e[0m
--- /dev/null
+# This could be a title
+
+## This is nested
+
+Here is some content
+
+## This is also nested
+
+Here is more content
+
+# Another topic
+
+## What is going on?
+
+I think we can display slides?
--- /dev/null
+\e[m~~~title\e[0m
+\e[34m# This could be a title\e[0m
+
+\e[m----------\e[0m
+\e[34m## This is nested\e[0m
+
+\e[mHere is some content\e[0m
+
+\e[m----------\e[0m
+\e[34m## This is also nested\e[0m
+
+\e[mHere is more content\e[0m
+
+\e[m----------\e[0m
+\e[m~~~title\e[0m
+\e[34m# Another topic\e[0m
+
+\e[m----------\e[0m
+\e[34m## What is going on?\e[0m
+
+\e[mI think we can display slides?\e[0m
--- /dev/null
+This is an "automatic link": <https://jaspervdj.be>.
+
+This is an [inline link](/url), and here's [one with
+a title](http://fsf.org "click here for a good time!").
+
+Let's talk about [foo][foosite]
+
+[foosite]: http://foo.com/
--- /dev/null
+\e[mThis is an "automatic link": <\e[0m\e[4;36mhttps://jaspervdj.be\e[0m\e[m>.\e[0m
+
+\e[mThis is an [\e[0m\e[32minline link\e[0m\e[m], and here's [\e[0m\e[32mone with\e[0m
+\e[32ma title\e[0m\e[m].\e[0m
+
+\e[mLet's talk about [\e[0m\e[32mfoo\e[0m\e[m]\e[0m
+
+\e[m[\e[0m\e[32minline link\e[0m\e[m](\e[0m\e[4;36m/url\e[0m\e[m)\e[0m
+\e[m[\e[0m\e[32mone with a title\e[0m\e[m](\e[0m\e[4;36mhttp://fsf.org\e[0m\e[m "click here for a good time!")\e[0m
+\e[m[\e[0m\e[32mfoo\e[0m\e[m](\e[0m\e[4;36mhttp://foo.com/\e[0m\e[m)\e[0m
\ No newline at end of file
--- /dev/null
+- This is a nested list.
+
+ * The nested items should have different list markers.
+
+ * I mean, they can be the same, but it doesn't look nice.
+
+ printf("Nested code block!\n")
+
+ * Cool right?
+
+ Definitely super cool
+
+- One final item
--- /dev/null
+\e[35m - \e[0m\e[mThis is a nested list.\e[0m
+
+\e[m \e[0m\e[35m * \e[0m\e[mThe nested items should have different list markers.\e[0m
+
+\e[m \e[0m\e[35m * \e[0m\e[mI mean, they can be the same, but it doesn't look nice.\e[0m
+
+\e[m printf("Nested code block!\n")\e[0m
+
+\e[m \e[0m\e[35m * \e[0m\e[mCool right?\e[0m
+
+\e[m Definitely super cool\e[0m
+
+
+\e[35m - \e[0m\e[mOne final item\e[0m
+
--- /dev/null
+---
+patat:
+ wrap: true
+ columns: 57 # 10 + 42 + 5
+ margins:
+ left: 10
+ right: 5
+...
+
+This text will have 10 spaces on the left.
+
+- So
+ * will
+ * these
+ * bullets
+
+This line will have 10 spaces on the left, but will also break after "left".
--- /dev/null
+\e[m This text will have 10 spaces on the left.\e[0m
+\e[m \e[0m
+\e[m \e[0m\e[35m - \e[0m\e[mSo\e[0m
+\e[m \e[0m\e[35m * \e[0m\e[mwill\e[0m
+\e[m \e[0m\e[35m * \e[0m\e[mthese\e[0m
+\e[m \e[0m\e[35m * \e[0m\e[mbullets\e[0m
+
+\e[m \e[0m
+\e[m This line will have 10 spaces on the left,\e[0m
+\e[m but will also break after "left".\e[0m
--- /dev/null
+---
+patat:
+ theme:
+ bulletListMarkers: '<>'
+...
+
+- Hello
+- World
+ * How
+ * Are
+ * You
+ * Doing
--- /dev/null
+\e[35m < \e[0m\e[mHello\e[0m
+\e[35m < \e[0m\e[mWorld\e[0m
+\e[m \e[0m\e[35m > \e[0m\e[mHow\e[0m
+\e[m \e[0m\e[35m > \e[0m\e[mAre\e[0m
+\e[m \e[0m\e[35m > \e[0m\e[mYou\e[0m
+\e[m \e[0m\e[35m > \e[0m\e[mDoing\e[0m
+
--- /dev/null
+---
+patat:
+ slideLevel: 0
+---
+
+# We should not split slides
+
+Never
+
+# At all
+
+Because we have `slideLevel` set to 0
--- /dev/null
+\e[34m# We should not split slides\e[0m
+
+\e[mNever\e[0m
+
+\e[34m# At all\e[0m
+
+\e[mBecause we have \e[0m\e[40;37m slideLevel \e[0m\e[m set to 0\e[0m
--- /dev/null
+---
+patat:
+ slideLevel: 1
+---
+
+# This starts a new slide
+
+## But this does not
+
+Here is some content
+
+## And another header
+
+And more content (yep)
+
+# This should start a new slide
+
+## With some content
+
+### Very deeply nested
+
+#### Is a hidden message
+
+##### A dark secret...
+
+jet fuel can't melt steel beams
--- /dev/null
+\e[34m# This starts a new slide\e[0m
+
+\e[34m## But this does not\e[0m
+
+\e[mHere is some content\e[0m
+
+\e[34m## And another header\e[0m
+
+\e[mAnd more content (yep)\e[0m
+
+\e[m----------\e[0m
+\e[34m# This should start a new slide\e[0m
+
+\e[34m## With some content\e[0m
+
+\e[34m### Very deeply nested\e[0m
+
+\e[34m#### Is a hidden message\e[0m
+
+\e[34m##### A dark secret...\e[0m
+
+\e[mjet fuel can't melt steel beams\e[0m
--- /dev/null
+# This is a title
+
+## This is a slide
+
+Here is some content
+
+## And another slide
+
+And more content (yep)
+
+# This is another title
+
+## With some content
+
+Yay
--- /dev/null
+\e[m~~~title\e[0m
+\e[34m# This is a title\e[0m
+
+\e[m----------\e[0m
+\e[34m## This is a slide\e[0m
+
+\e[mHere is some content\e[0m
+
+\e[m----------\e[0m
+\e[34m## And another slide\e[0m
+
+\e[mAnd more content (yep)\e[0m
+
+\e[m----------\e[0m
+\e[m~~~title\e[0m
+\e[34m# This is another title\e[0m
+
+\e[m----------\e[0m
+\e[34m## With some content\e[0m
+
+\e[mYay\e[0m
--- /dev/null
+---
+patat:
+ theme:
+ syntaxHighlighting:
+ decVal: [bold, onDullRed]
+...
+
+Some simple code:
+
+```c
+int main(int argc, char **argv) {
+ return 0;
+}
+```
--- /dev/null
+\e[mSome simple code:\e[0m
+
+\e[m \e[0m\e[40;37m \e[0m
+\e[m \e[0m\e[40;37m \e[0m\e[40;37;32mint\e[0m\e[40;37m main(\e[0m\e[40;37;32mint\e[0m\e[40;37m argc, \e[0m\e[40;37;32mchar\e[0m\e[40;37m **argv) { \e[0m
+\e[m \e[0m\e[40;37m \e[0m\e[40;37;33mreturn\e[0m\e[40;37m \e[0m\e[40;37;41;1m0\e[0m\e[40;37m; \e[0m
+\e[m \e[0m\e[40;37m } \e[0m
+\e[m \e[0m\e[40;37m \e[0m
--- /dev/null
+# Normal simple table
+
+ Right Left Center Default
+------- ------ ---------- -------
+ 12 12 12 12
+ 123 123 123 123
+ 1 1 1 1
+
+Table: Demonstration of simple table syntax.
+
+
+# Headerless table
+
+------- ------ ---------- -------
+ 12 12 12 12
+ 123 123 123 123
+ 1 1 1 1
+------- ------ ---------- -------
+
+# Multiline
+
+-------------------------------------------------------------
+ Centered Default Right Left
+ Header Aligned Aligned Aligned
+----------- ------- --------------- -------------------------
+ First row 12.0 Example of a row that
+ spans multiple lines.
+
+ Second row 5.0 Here's another one. Note
+ the blank line between
+ rows.
+-------------------------------------------------------------
+
+Table: Here's the caption. It, too, may span
+multiple lines.
+
+# Headerless multiline
+
+----------- ------- --------------- -------------------------
+ First row 12.0 Example of a row that
+ spans multiple lines.
+
+ Second row 5.0 Here's another one. Note
+ the blank line between
+ rows.
+----------- ------- --------------- -------------------------
+
+: Here's a multiline table without headers.
--- /dev/null
+\e[34m# Normal simple table\e[0m
+
+\e[m Right Left Center Default\e[0m
+\e[m \e[0m\e[35m-----\e[0m\e[m \e[0m\e[35m----\e[0m\e[m \e[0m\e[35m------\e[0m\e[m \e[0m\e[35m-------\e[0m
+\e[m 12 12 12 12 \e[0m
+\e[m 123 123 123 123 \e[0m
+\e[m 1 1 1 1 \e[0m
+
+\e[m Table: Demonstration of simple table syntax.\e[0m
+
+\e[m----------\e[0m
+\e[34m# Headerless table\e[0m
+
+\e[m \e[0m\e[35m---\e[0m\e[m \e[0m\e[35m---\e[0m\e[m \e[0m\e[35m---\e[0m\e[m \e[0m\e[35m---\e[0m
+\e[m 12 12 12 12\e[0m
+\e[m 123 123 123 123\e[0m
+\e[m 1 1 1 1 \e[0m
+\e[m \e[0m\e[35m---\e[0m\e[m \e[0m\e[35m---\e[0m\e[m \e[0m\e[35m---\e[0m\e[m \e[0m\e[35m---\e[0m
+
+\e[m----------\e[0m
+\e[34m# Multiline\e[0m
+
+\e[m Centered Default Right Left \e[0m
+\e[m Header Aligned Aligned Aligned \e[0m
+\e[m \e[0m\e[35m--------\e[0m\e[m \e[0m\e[35m-------\e[0m\e[m \e[0m\e[35m-------\e[0m\e[m \e[0m\e[35m------------------------\e[0m
+\e[m First row 12.0 Example of a row that \e[0m
+\e[m spans multiple lines. \e[0m
+\e[m \e[0m
+\e[m Second row 5.0 Here's another one. Note\e[0m
+\e[m the blank line between \e[0m
+\e[m rows. \e[0m
+
+\e[m Table: Here's the caption. It, too, may span\e[0m
+\e[m multiple lines.\e[0m
+
+\e[m----------\e[0m
+\e[34m# Headerless multiline\e[0m
+
+\e[m \e[0m\e[35m------\e[0m\e[m \e[0m\e[35m---\e[0m\e[m \e[0m\e[35m----\e[0m\e[m \e[0m\e[35m------------------------\e[0m
+\e[m First row 12.0 Example of a row that \e[0m
+\e[m spans multiple lines. \e[0m
+\e[m \e[0m
+\e[m Second row 5.0 Here's another one. Note\e[0m
+\e[m the blank line between \e[0m
+\e[m rows. \e[0m
+\e[m \e[0m\e[35m------\e[0m\e[m \e[0m\e[35m---\e[0m\e[m \e[0m\e[35m----\e[0m\e[m \e[0m\e[35m------------------------\e[0m
+
+\e[m Table: Here's a multiline table without headers.\e[0m
--- /dev/null
+---
+patat:
+ theme:
+ bulletListMarkers: '-+'
+ emph: [onVividRed, underline]
+ strong: [rgb#f08000, onRgb#101060]
+...
+
+- This is a simple list.
+ * With _nested_ items.
+ * One or two **bold**.
+- The list theming is customized a bit.
--- /dev/null
+\e[35m - \e[0m\e[mThis is a simple list.\e[0m
+\e[m \e[0m\e[35m + \e[0m\e[mWith \e[0m\e[4;101mnested\e[0m\e[m items.\e[0m
+\e[m \e[0m\e[35m + \e[0m\e[mOne or two \e[0m\e[48;2;16;16;96;38;2;240;128;0mbold\e[0m\e[m.\e[0m
+
+\e[35m - \e[0m\e[mThe list theming is customized a bit.\e[0m
--- /dev/null
+---
+patat:
+ wrap: true
+ columns: 40
+...
+
+This is a long
+sentence over multiple
+lines which can be
+re-wrapped.
+
+
+This is a super long sentence over a single line which should also be re-wrapped.
+
+
+ This is a table and tables should not be wrapped
+ ------- ------- ---------- ---------- ----------
+ 1 2 3 4 5
+ 6 7 8 9 10
+
+- This is a list
+- This list has a really long sentence in it which should also be wrapped with proper indentation
+- Another item
+
+This line is long, and then ends with `code`
--- /dev/null
+\e[mThis is a long sentence over multiple\e[0m
+\e[mlines which can be re-wrapped.\e[0m
+
+\e[mThis is a super long sentence over a\e[0m
+\e[msingle line which should also be\e[0m
+\e[mre-wrapped.\e[0m
+
+\e[m This is a table and tables should not be wrapped\e[0m
+\e[m \e[0m\e[35m-------\e[0m\e[m \e[0m\e[35m-------\e[0m\e[m \e[0m\e[35m----------\e[0m\e[m \e[0m\e[35m----------\e[0m\e[m \e[0m\e[35m----------\e[0m
+\e[m 1 2 3 4 5 \e[0m
+\e[m 6 7 8 9 10 \e[0m
+
+\e[35m - \e[0m\e[mThis is a list\e[0m
+\e[35m - \e[0m\e[mThis list has a really long sentence\e[0m
+\e[m in it which should also be wrapped\e[0m
+\e[m with proper indentation\e[0m
+\e[35m - \e[0m\e[mAnother item\e[0m
+
+\e[mThis line is long, and then ends with\e[0m
+\e[40;37m code \e[0m
projects / patat.git / commitdiff
