pax_global_header00006660000000000000000000000064135473734730014532gustar00rootroot0000000000000052 comment=f4534d5e5467246b6babda364cafbae807e5d978 patat-0.8.4.0/000077500000000000000000000000001354737347300130125ustar00rootroot00000000000000patat-0.8.4.0/.circleci/000077500000000000000000000000001354737347300146455ustar00rootroot00000000000000patat-0.8.4.0/.circleci/config.yml000066400000000000000000000023561354737347300166430ustar00rootroot00000000000000version: 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' command is currently broken because the Docker image stopped # providing 'ssh'. We do a manual checkout instead. # - checkout - run: name: 'Checkout' command: 'git clone https://github.com/$CIRCLE_PROJECT_USERNAME/$CIRCLE_PROJECT_REPONAME.git .' - restore_cache: key: 'v4-patat-{{ arch }}-{{ .Branch }}' - run: # We set jobs to 1 here because that prevents Out-Of-Memory exceptions # while compiling dependencies. name: 'Install' command: '.circleci/tickle.sh stack build --pedantic --copy-bins --jobs=1 --no-terminal --test' - run: name: 'Run golden tests' command: 'make test' - save_cache: key: 'v4-patat-{{ arch }}-{{ .Branch }}-{{ .Revision }}' paths: - '~/.stack-work' - '~/.stack' - run: name: 'Upload release' command: '.circleci/release.sh "$CIRCLE_TAG"' patat-0.8.4.0/.circleci/release.sh000077500000000000000000000021511354737347300166230ustar00rootroot00000000000000#!/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" patat-0.8.4.0/.circleci/tickle.sh000077500000000000000000000006541354737347300164640ustar00rootroot00000000000000#!/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!" patat-0.8.4.0/.gitignore000066400000000000000000000000741354737347300150030ustar00rootroot00000000000000*.o *.hi extra/make-man extra/patat.1 .stack-work dist tags patat-0.8.4.0/CHANGELOG.md000066400000000000000000000121641354737347300146270ustar00rootroot00000000000000# Changelog - 0.8.4.0 (2019-10-09) * Add slide seeking (enter slide number + `enter`) * Fix turning tty echo off/on during presentation * Run `w3mimgdisplay` cleanup action, fixing image issues on some terminals - 0.8.3.0 (2019-09-07) * Fix test failure again, and ensure that it works for multiple pandoc versions by slightly modifying test input * Include pandoc version info in `patat --version` - 0.8.2.5 (2019-08-12) * Fix test failure caused by slightly different pandoc output for lists - 0.8.2.4 (2019-08-12) * Bump `optparse-applicative` upper bound to 0.16 * Bump `skylighting` upper bound to 0.9 - 0.8.2.3 (2019-06-25) * Bump upper `pandoc` dependency to 2.8 - 0.8.2.2 (2019-02-04) * Bump lower `base` dependency to 4.8 - 0.8.2.1 (2019-02-03) * Bump `pandoc` to 2.6 * Bump `ansi-terminal` to 0.10 - 0.8.2.0 (2019-01-24) * GHC 7.8 compatibility - 0.8.1.3 (2019-01-24) * Bump `pandoc` to 2.4 * Bump `yaml` to 0.11 - 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. patat-0.8.4.0/LICENSE000066400000000000000000000431731354737347300140270ustar00rootroot00000000000000 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. Copyright (C) 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. , 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. patat-0.8.4.0/Makefile000066400000000000000000000013361354737347300144550ustar00rootroot00000000000000# 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 tests/golden.sh clean: rm -f extra/patat.1 rm -f extra/make-man rm -f extra/patat.bash-completion .PHONY: man completion test clean patat-0.8.4.0/README.md000066400000000000000000000345361354737347300143040ustar00rootroot00000000000000patat ===== [![Build Status](https://img.shields.io/circleci/project/github/jaspervdj/patat.svg)](https://circleci.com/gh/jaspervdj/patat) [![Hackage](https://img.shields.io/hackage/v/patat.svg)](https://hackage.haskell.org/package/patat) [![GitHub tag](https://img.shields.io/github/tag/jaspervdj/patat.svg)]() `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]. ![screenshot](extra/screenshot.png?raw=true) [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: - Debian: - Ubuntu: - openSUSE: You can also find generic linux binaries here: . ### 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` - **Jump to slide N**: `N` followed by `enter` - **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 Slide contents. Yay. ``` 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. ![Hello](foo.png) ``` 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. ![](matterhorn.jpg) ``` If `images` is enabled (not by default), `patat` will draw slides that consist only of a single image just by drawing the image, centered and resized to fit the terminal window. `patat` supports the following image drawing backends: - `backend: iterm2`: uses [iTerm2](https://iterm2.com/)'s special escape sequence to render the image. This even works with animated GIFs! - `backend: w3m`: uses the `w3mimgdisplay` executable to draw directly onto the window. This has been tested in `urxvt` and `xterm`, but is known to produce weird results in `tmux`. If `w3mimgdisplay` is in a non-standard location, you can specify that using `path`: ```yaml backend: 'w3m' path: '/home/jasper/.local/bin/w3mimgdisplay' ``` Trivia ------ _"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 patat-0.8.4.0/Setup.hs000066400000000000000000000000561354737347300144470ustar00rootroot00000000000000import Distribution.Simple main = defaultMain patat-0.8.4.0/extra/000077500000000000000000000000001354737347300141355ustar00rootroot00000000000000patat-0.8.4.0/extra/make-man.hs000066400000000000000000000103671354737347300161660ustar00rootroot00000000000000-- | 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." patat-0.8.4.0/extra/screenshot.png000066400000000000000000001455541354737347300170360ustar00rootroot00000000000000PNG  IHDRbsBITO IDATx^|Ugf{IｑBn( <{(((@)& $B=&wٖFvf6Dٹs9sE# @5ñ@  V#Le+z9jw54k<~AN>}@<!@U̚x5JhpK]]wd'[D`$5 v>?%FͻO]9ʡ:vt@2w1*YMr^H2VfAkX6σe 4,@k7Wz=&!*cG{XNOGdQvAŃc?!и? }Y뎄nץ(G*1f31>@3ݒ#w8b4EvS-~WC_2V8wϑM?J_X+ĥNRvWtFݨjʄ[iWWG{#KCg Ɗ03kuy݈y5g7(a&T8{wCh22b`V>Gmn61uS*sP`l/g_G׸y-VLX|Q)8}ˍ5(0kB +Mӧṱxºyq}| nׯ^YJC%gzy>2QzEbעҖGUƻj9JVϙ>@U,iJq>p47wfΒ,5IbNcrMA72ASQd:z'<5%:esd!?Tpm:ҳ\3j8xV̋UU%5RE%oՇEYG[Eݭ{ȒDӎTdsZDﻟ*wuV"]Wr W>GcE*YNR'blᖌj#ªxɂUzgԲȭWubHUvs*|,'k ~sV* v2b*Bq5s{BUžVbC<|Έ9|a^3%g4}_CX7 HYYTjl@&G7yy]ݯ0˝Tjtۑ/dH!1j<|~TM#q(Q83zױ"y+x; _,a^kK֑dQmܐ*3 Ws0\%o5𰜓YGq t;B+PEJ-v+cgtYNO0=Ъ Ċ{ hصQߏy)okZT'6@&601֯.0Xv};۱z9i"hdK@g"Z~vvJ3N@rr:ZU=1 yc"@A6VӰkAR#S&~-wZFj̱fS@M?Lx̊TĦ:P$ Q ?_(5ll[Ԁ8:*G֩CHnr V X=)RDnt񒷶[::uvu+0ѭaKQαjFsD|zeyF܇v:7M QMx-w3+"{X!@>@ 5Tu"^NC`n^ֽ4ǯ9^u 8q:\H,OO<4Y*ϖhR %UOIEu +နrM5-!n dV^z`\a&EZ"hU-Ohv6lx ]sk:wK^᤬(lޕsL q2LZWWx۱ @3@ CN < | !Dg @y@@ :C P 9( @t2@ rP@<   ( :C d@<x@ P@tIuv@mP@ z(( :q @ S 08y|ˡlmjOݕI┱^/m,{*A7 d|C%:JcV'R)gm#@ - N).ñP3,,Htu$&\QN_pAvˁ@sPrPqTsX*U}@qCrUݦF! OĬT0yς@30n_[@?݇Tnm*4m`p6U^v'\ :Qy[<@/n_%VXs񋯗5fO-ݛ$1zrДHSU5ag{H ښ5WvULaQsV81jְװo"@KxSVҵNRcSז**Q5%%{EP"n(6^݋LN=фq;-x\]X/0/XҐ",ר̷d^sd=+?Pu=Y%ȹ&J5#U_^u"P]R+P19:`| G0 If:65:PT7դg6 >3M5 S*ɁjKn5LKw>&"6)W'oT# t1 M*Q-ELtQ\L5j =z;MJGXvjVqM~ҙ&B[n p( G e5(9w@CKr qkH6i&ܮTqħc[6۱J @0(C : 庠l1dj۱v~%$"k*4} pt5#Zey,J-[у(u8>/.Ӈ晼U*tN^ Pl'^ozBQ3(RMg @03Æ\vX[7ݓ%{@qދV}Bilо살)!$L"vB*v,9С|O'c":u܍JA0C)ގU^ ݇;V9|SxGkդ)_ͩϭtT9xi/ܰb{vhv #J,FZCE!uGn5d7UY&4gS]PpUl({zOÆr0ʼRr`ͲD+(TYx3G "S Luɡ -UߺF{=SK' ÙųfCvCZ\C :aچJSKTu -ctuU5_̽`@N^!K;hޔu{c{DLė(uRx]Vbà'w.kv-M[SKrp/i~hۘyIQ]^Y%֕+8ae1Q7g0]#NXG4ma@ @OYb tYU/ D}G|Olh{BVraՃԞiz.:,6pS[ڐX2S~0#A|HΆK08_4?/G)^[: d@؇KQ@p}g?˼Aq47"?u~@fAw e& |;> Qzzzuw- = ?8 @gS=;x @G#=>8@ @@ z*( zjρ@  (  |0 @ @@ z*( zjρ@  (  |0 @ @@ z*( zjρ@  (  |0 @ @@ z*( zjρ@  (  |0 @ @`>@` -@m}䘲Qf ۝@)-(Gf:&s'px BoCtt%iڽ;c4N_/.ۥbNyEݻCGyYPXywSv ol2vtF; !zR7YREI h=Y{EJ#h8؝50A^驢; w/KߓkzN%tP'\.q|1IU qk ل.7JȾ.&}laPO\gl3cn/>QYu*,ht:^'t1@U(O ؖe\ȈٍYdp1鏾c=l#/_ve]*?iG6ö}|L{L-9.[朢'x[?G?OmѲG%N)Pf8eV|q7}/h"6kϪ+Q^3 *roٱP#]u<}#tc#_!x5Yu1'=[K8xd-'ƇČW_kx_?Uw 5e Jʶ(;F>w,ؼbnGٿII?_X|he{k`%*6xpX^xkۆgW'GPg8<$,ͼZu3M//t%.5]afœUe55::k[eLCɊ0S =gl"[qC fYuqӷɛ֝ZKB˚/S) }u"Q]޶O(U/X8.1,'uj1 Y8Gyf^+2Y@苯-[_Lٰ|L03IW *mXe7|vƄ ꅷ '}M~+f +ђvڜ`KQtH""rڒ]7,ߕVQY&|8l["?g٪t`6)dI"w'+Jl8<~\|D+ìqO o~Ϯa.Zb8L,7h/rͤNxvew?W5uxg-Aڧ*&͘pn9%-^*9;i~~+MKhoVP~|"2qWz[k=֌@h6O:Ҁ74k v DK ;~Ѐң6+ ]oH=?%sin|Ehqap%(^Vzw6qu SbU\]!peht*ǼQ\ݒSQfq@#[\uQXNGxWnnGxڪBbe+ %Wإǣ~e:""¸nY]XX\dS =ķehf'fŻ=&6l:}SX>F{ǵ7JET,Eu~rrrl^ xQ#}YSv-kmYyGҶ|uk<'iG`+׶zz_Ϩl+ģW9Yj[y~֕v( ۾~__\OK|U_$ v' Cþʤ""~ ʰX}𾃹%MүWwTi+PȒE%^Iv Ҵsу4 lO]۹D3`yrS";.ܠӿ-5/5vh0Ik wF[Rd~mɎ=WOJfգ1On._.,|ȔȤ37# xSnFv1 ..rr?1~̂1s u(; z4y)k,.hD:u E</%b׃Vm*ݴ^[h98GԀ([v(62YvD (v4 |iՃ8FNܹ>"AHMCx;K~J%FGt\QwR8PV]-2\ppSm[1 nEQqo(#BC%0H,RQqZnAZnaF!v&)i 'P3 _Znm7U{UNꮯwԼ/?ؿl/sӊB T3,fX=dz$h8SZOOg:EGmjXNJ#NuQfV1^[dsKH%5%yFO4UyU:'/7ҠHT"7Bfez2"7=՞zA3C[RR!1V:: )Nu~5ӂ8.0O]V5]&qxD1sr1Ko_UISBQ9jմ*%rdp@y*=ܻ)=dSU> HI^QmVcj-pR-U s;CFX,ڛMZDTAT˱+ MwCA؄$3a\C^E2'uWO=ҒV^єB*; mqRX3Uܠ_ eV6jS<|燆9s|V[…ݕMh쾯h)}kSw93qi%Ƽ?noo 1{Fɋ# IbwOоQxP8_5{A#4)?2_؃Uk:WP$=G @o'TiW-sצO. 21eM5-qS:uFqgrbCW}K_)l3bYU]9RO;! O ,Gܟ4ɬ$"xDLSMrMMrDq*W/9W up۲+hs+Ҳgsk?PUr9əB͘^QIHr1'"\W ȼ:C@qGijdzCWyǭ\yG>uGW_Q]HUzOmܮ:-#O?|%cgE|jvҜ<靿 V{< SNnB#Ey?+ unrK%ڿ+%uDԆs甞p{V#xKEȒщ)sdžHQhٽ_~?ʸ1c8쿔o\BrB#9EY5Ƽ)˙ tflAL$]dXC\:z̀SG#zLvI=66X?zyDA W 9+!٤Hrɽ"o%_̥s]>neq^a)'=[1a˅E /G]P"X>!1trI ,.<؋fHhK(r9#^}ݹ~.48+AZ=iV-d7]޾nd֋$7%P˒%lh[!^것[TA m1),E{EJ޿xщ_wS/?*8sqi})°G絻O[2A^KZN[k)4DWw#X,ב[E9~,n]Hx(JPɅWc~n{_cOcϨp\A] PǨA> qs{ئl0{vrp]ki{ O`f@ @>w!\Po"0QX2o wD("=D` & hx0h@{<#@ =P@G @@XM @ @ `5( F@ @  P@@ Vjd @@9@XM @ @ `5( F@ @  P@@ Vjd @03@؝7e > >kVo/vwm`1^y&:f=HEu:QbjpE{) mȭO7x ӛ?8ݡrmOkvv.x#yyn_S r[U M1 gwιi* tu9}/|⣅ wsS R]C@'ϒ "k<@ pBbwo:#ѝMކPZцE#Y{V-8XA8MGsĨ L;_"$E/0\GLtdd &t|m!=j?$fDX×;f^Js[&iԬ>^n؋}qѹ?=Ud:II#v1'=[K,'@qJb1q8U*I>Ar/RK\{iRLҖ^eΖm[,gkB uUݽ/v$/9Ia6e"b&vjV3_UYdPc,}[fafiegK^:;rlPs `]OM bc$8ޙnϏvHҳk}YIMzL$s7lky 6 $5Wg)eY9Vu@ fYuqӷɛ֝ZfYEVE I*^B9҃I{~㍝Pr&1M=)W?=h-רZ"I4,H-bSdN*.kBLΨ0Q'$O*똡#y;\L-gIr*ȏT6f0H8TDS3 8'=Ps+ϺR&Ȇso'ŵ1K|8dfb/DٻW/RkB9B.2|-T͙ xDr%C[(dɝJohv-wڕmؤ.Ev.q>G]W8S)zZ٤QN$e8Bomٛ s?V=<MݑiJ4X&#sD-q^L=}?5[ΚdqPUH**)hHC64rQ[3^}liZsGG3HKt"b0Lsʘ~W vmXZT,Dd&:]Ŕ;S}n,Z~[$mY)+jTvݖ,[-5yeJnPE1'^Xb~ WJ5!##=]?B:iaqNvWX]ub+o4̞w)xDMVh~a)mWT49~}F YJg5w$1gIku۪mM(;riIZ>"?b9xU֔^a.~aE9~t¬tVk|lw~ y] IxzL`/?b /,U z,qDhNk7rYx~n^ ?˗{worB\s)Nm8wN .{m=K>"?ӲKEȒщ)sdžHD6N԰Q̼NVbѓ{n=/Hl9$8r1O-;GXݖa$[{\%˙C.m gp ˟tP-"vrD eRsUǓs,!k9s6ƃy3,^<4Ri<{k?"oZF]k|_+0\Zx௃=e+UvWiW&2=|{I5XiwM2}c` /OCt{=KA]:قjFT cL^M|I.|g겙w&MOZ*( yM(r9#^}ݹ~}7|Ƶ4OM<ÇzsAʒkW矽%=zFmۡFR&dQd|~gƿ`Hmэ2^~K0Ee?B*ЪG+|2J>#߈꿁f9U$-zqg9ײnGz^]; ˙CΔir }q/u-~mYyt2" g%^nḬVֱEa1}Ьxɯu>5\~9s=* 􉧎ΛU6?/T8t|"+By?j[{MʼnԨi祱N_p7 -+7X㱅ͻOҼ,[(uҼUpC2XݛHtgabΊ3Dž6|X(]`B/y7EPj+~RT\):=; vs/M @DoTQS;ps `חIJ558Ѡ>^n؋}M0aWݕO<|a}IÏp/wܽS-Q_X:!G[yz)ijgmޘ$wm?ߡ 2YC1konݾ;)`<UZ#(Ӫhsg>UU\߲cߡҖp #^:22̅P=h'k?Ee5g$Wo,h"Oڬ=0@#Ʈxb̨@GkBg_sBOΟ47nxdo5x=1q/?973qQn\V۟kڒOz U7/VMⓗ _1`0ikkI~¨;K S =O(U/X8.;f~̵KG]x̊Or1 {u5d%?$7qﯘ=EGX`}nmݹ"F|dǮ+=Òr$iuel\.9ۆe]zgj+5Wg)eY9V.^`P?xx?"Yc=鹏YyRSn`>󜀪S/Hܼ;̙nt|Ь]˺J]2vHubr@h;ڸ>HD78 +0, (=:oShyoSǩ#-kL!hKX;i[i7[{NprOK}iXOgʃ8嫳Xc >ΐC|+O/PAo6y~bVcatN xc$F&pT Tߎ7]ZdÀƄ%%i}3;:<޽j"$ֻVHd.q&i✬ @έu-nP$|ʨ-2۳ldžGE ixm/T$;R%Nxj_ǮbӁJEAֈ*0˗}+޺eyR{wFܣ@Rw 3ioO[Ww|= ؁N ":9MVCg>8uқ(KlQcOb4&j&c,1j,h{^kG*p-SYnV(^M}-o 7R >I 1\E}]P!w"AA4) _,fyAL<ۨPMmdG{B9p^JS2;8 #SS~E_tmC5'Y^rzpk.`c ) K{ cƍ:Nz)T@LW^_#tRŪS@uYò/4sް@@đ&v G.-̎J.;GA G'ɠu?$?PR8tWڅnC$ KKZaFFMeΉN)YH͌KvgiY]/*?:! ݗ뭝߻ϳgPY,IKK0 V51ݬ=MGYQY>[#,@\TǥEh3WX>qq9q}G7D-h+1"16eӽ&;+T^DѵiQkI K.8#;!/pA΅g1}$+3)KG{Wڮ0/a?@nȼg؜~~IOt&N耰xZϓ};O380a{! %.7qBTC>2}=oŹ@1;k3E"#f̨}<^g~ pqq㸎fR7Gܩ};Mt-lyG~%oKz΢YoYvO8bHo`82Ky-t@(h""a,}%уaJ.}Nyo?i'틮7= PB uޭZSE8o7Ga`}cF^x-5UCȰL>nW, !/A!^tl3 {]9~JXP@3htKPqZ LV`$?:(,kgL.=-i1Oϭ-` K2Njzz}1^s;w|N#a*lNu;oɎ3}IN8v.߫ =7!S'И~o_M0©T]fKTIS^\PWK2܎/ߙM~d"z,8R+F.ݣ 3?9ɓd[?zP?C:4k<;#ީKUT_-/K*Pϳ$Kĭl>/e=}ǘʯQC d2pd~d~Û܈Ry4.RJĵ2c>6l~ROUt@7=o{L ϊk߿Wt}?}6K,ع䗵nޱۗrW49+O ?+ߊKfzخ=Xwԭ ւhR@$Jd@o]0&:4wLK8D^Gl7~66x/'rˬýՋf6O#K+F+H^Rldu#ޯ1Rr';N}wA7Fࣗ)M H{7]~NxjFIyrzw )1̥wI>Hօ. IDAT9[YL/{.Y|Wa02:Ğo8ve#*J u>̊ց@ 1#Lk]qsZ#Tuko( ̢`x[pI8k?ae_^zYݙrC%'4v, K; 0 8xr܍>t5cƝɒȰTf7!a"VmtmcI 4cdOUTtݔk/R9\x)WY}eVRPIe~jELQR_9y%>Y'?!WrJwђU+ e ksgu) rJ0}=ޮLYR29:z::dvllS3R(oTPS׭LWf EO&b̠RCO--|c1 {=6c޹#=Ϯj )y'^5K}TQ= YYr_w{a Նܔr⒊,eW__-eDaQ6ԭLv`¬ʎ:Lٹq08v= Lj'AN Ifc/goPx’B˕[]a[>V|t޷rr\KD$NFx>*%E|BzLtbrYX)_P JRcVATH3H:K̹S 83'1jix}L,S$QMCMq?0fjw';C,S{[yVDգtn $^ӓ[W SQwUjTc^5~Fb՜´$RVUle?n0w:s|/ B#_\+d{f8u-0'#sofH}L:Ou_Tǟ((*t 1,EiF7 ~=oS~](2ܲODL?wLԽOKgeNx3kn#v|P\'me G׀FՎQ|a=@C,9wk%nhDFxcO ]N_wAڛ^%Ԝ%&4Z.r RL}b>f1O$x|Ht~V@X39Ϧ6Nţ=H8/O 5;8 #SS~Et5)$㒫&Wg[e8zZ˧-z@(\Z@$d,9|΢^lj=uBO_q3ګj/NI Jk:SݥAɁz,aٗT=Za+M T2i#?aR!oA[gX,8ip0o[S)s pGE%a$|@Z@ejaBdԳb(xKVuWl z(t# ,%:40J`=F36S{ĝzdnCEU\{dyıw ~Qy=ҷpp6m if߮;]I Ψ< EI Mt?դ琏L_[q.Pŝ K<<&56Ԇϯ6N"?_U\Z)+޷%"cs%=Mq8qV'=_wfqn#F-a²$0($Z3wP±D:SP5H\Itw߮ ]t:1f0 xrg|?X8d踸q\Y3}]p,ZU V}2b{7]@ӵ>~IJ%cZ'{m١(}n ^f/8Z@Ō{-/.+z1YG-"|K6J@u 0Y(U,%|Œ\(5 ̅ɗU5 ?lu%ݲժG:k 72!xuAC*Wi;/}2x^_*N|)wUO(R)mEWa}%YN~ʊw}ɴc{3fҴӷ8NӆY^]^rhW}wR Ȭ'V\8 ¸g/]i3Ic4 yd[~ΔGwmƄa/M+oN=}[~=zZ/^r+OԝQg/cozJY~a,t_ f]}URS5rҧ >MRgRX#kQ!f5͑.fXxtn7^/h5U$/2,~= H-P$ʆMTzMб=C04wW_o`N=fi>YR@ hDLH H~tPX:׶Ϙ>]zZb[yMXFΊ,M{.u`oh4 aoStm=շ5-ůw?l|V6̶ Xf\41Ɂ@S!<@@@dz-`  P v P v P v P v P v P v P v P vj,{ //.JB A@B*  B3*hZݼP9ЌqTA@@@ ʁf Ќ+   Z-V7/T@@4#f\!Uj yr    4 V @ @WH@@Zn^hF͸B   @huB@@@@3@hRB*  B3*hZݼP9Ќ@ pn6 @ !>_wX+ج>\5@S@V 7֘yjAS cl%Fg^ܞz@wYhOZB ˗:)2k7dָ2h̖@@_E0ݔJm;a dm/7zAѿO'=V[@@@KU%7x5NY.('LW/V%`\z2[gG+fO39mP{㒤G_c/sF^BCw-Vfk'çv`'<\ȸ5|8yI.]Xy1:(KFRQ~e7E֏8V2+p$phٱow={0D 9nֲX6"{l9uܽZ[VhfF=wg-ݶY(?np8'u'߸s_A9dLfgvQ~ݳ16_9WhrX⳹[v*> pQcQG_}0~ֱ~}JidΈkiҥOO[|YjkOc/JzbpI7z]8]V옴b{92c c=Wn~I*+c_׫g lFU~aͰ&9 {Of{uWJq@@@AeG32^ D#/8&, Oy2%€ޢ}gu7)=kt32sCEQ ^V+@FxS_zNbWm3F_?/7߈$0b }LU3ҳ2uC8)⚗l׎>-/DSOȬȊń'1H5.%e0Eά ;ݘVFQ'8i\8}~ŰdTa fh >1tlLD&p cH ˜We‚b[qi8'ǗIaJx,JM)KnюS1ّ*}FgуY9btZcuWˬxwܤ5ZvR'SQ;{sUj$MXr@Er0ê6XYo qӇ4U{Cqa-T? htU7P/V~QńB-d #˃DON|uUȎ1tXTPKLX?E,N]Wo jt$îwj ~_کUeV\o䲱R>RI^L+v&^6*X}δ1?5BN@@@>zƚN?os? Dπh`4;)8ɑ~y12 UHB^AOvyKg.n/8,yv|S v^ST!Ee֠ƎS&n^ƻ$UI U  M#Ь5l5D4D!&dS!KJ1KٯKfVuOeRlF%])@2_⫛t{aޣ uw1K>{˩+J<Ȓ԰)?p~{q eV\N_\.W!QN:0#^ V=m>C"_7]Lyւ@Kh9ԙښ|gqƉ(c"16eݾ ;JYS Dұx]$S1sK3ݲhv Cy:Nӥ{8]Z*Jk1`wt ~zԫtRXSJd)cI1 +WqDNX"d'2ҖK~nٽy\^7AiɛK~ zP@Z_)8kҔ]vՈFw4d F[goN HUi.dGRhxGc.X~'R2Llct[=Xv.ކDQZB`W|'5m@ K,yaӇ40413}p,‡ןyˡ6G6?W[r~g;_y~؀^wEߞƇ?0n7Sxo.OY3kP6hH~wkWKX$1-mh)lʤ(X  -O%"xџn ł{nkΏݰQ?+yCˢ:owi~5 g֓O8}̹ c|#e"r!V_Vy"!gƬY:DkԨS|wVVLxm6x1_^&T ӫ#K h-e`4Y)6F:߿u^cMVLH}1 IDATb) ^Zsk= m(7C;!hLjރH,j@b -\@rGL Cb$eվhCŎg3}r 1NP=*+}%(nݫZ@󻺹sn ^:^ȎOKzʌ_8ذI\<_mp~FdYvUh.[5V . w\-~W ;Y]ū{t4Na}%\[|o<ȿA3xqj˚Os/k#3ܿf܀~9ua\tڶ%f$X~aį~m:m\ȡ,=c!O7)0j /n٘G)6}mxxg tYô<]:c2Nեann_q2MdvNzL N`9Wv( ;)/ ;hU5\f2DXmn=e98XLWIN7ʣҼL,5;^ʼn~y6{<;uӣ$wkցܼl9RnF?y׿OD'<X[e& n{9wf_w㍑;vV&XfdfPZ_I%iz rٱ***gztFg8D2<Ǫz].:LܻoQq2c' 2-p]rEIH?ILlt˻R #Տg]0YŒ:$Wh;*\=&Xy6ޚRH~=lZCz<ޑHȳ'B/KTµkQr`9JK/-MRZgaL,T.{[T_V elDwQ,lUȕ%*YOJ$# 8(͖FvDaQ6UJJz~dcz\6V\RPo[Mi(/&"KZf~aVieg=cP]\qnm'~RحUi'9ېL^Jny#s5LMϯy9ArêxzQtQ"R-<%KҳSOl^?t\QM9YPp-U $(ɣ7ueVm!OuϚʊ|.~wi_X  Z@R"a:#Dұh{;8q}z7\2׸T-XQ6PI5 L=՛׭N/w+oME\6kڔc" xEz#1:7h / XI_?a 7d gTmx-5GBQWV _$}i84pu)8&9>U;zi'xqYCrہ>@4*n0y:g>xB疥}dnA1^2\x6(%+eWp{3-S?}./{qwF~,ٯ_fуk@"q]|Ded+cof b}d^d ".טFT:wgdv]ޤ @ UrHĞ:珯&&)81_!b26/95^b5tWW{}A^trNbF^VfAb,rݭ|z9]ƒNk v0=zqrnzFjl %\}߮ wyXǗIJjeܐ[QIG0;rn+@PT'6c4GU-G3WX>s؊jNFqSU4T_ 7l_|tCĩ߂ΚQ"` cSX6+&m]p㞻->n}8Q~W@/2.Zfe6Ut 'L 0QH5 T O3݆G_}S>fq.fQOTO J$b0Zc#$ T08f7ggD7l8ŗ& :$x9԰X2/~ pqq㸎fXtU!h@4@qZ dU0Y4W?թ};Mt-lyGJ>:EƳ?vq;mD'#b[QL! ʿ׀`i.{yӁ˶3=嗚F`ǹX<{$n}Ӭh+PUU{ԶЋwdeOgKu: rh@A;Wnn Uc;N,DIvɪ)9}[~=zZ/^r+OTwҫ_,+V/^"䅀y? vO3i(|(j1VI7|=l QŐnTgՠnX}PN}~~ʡ^|ۢ:\Uc" ^wR}i4zHr`7zTQIe)6G@LwUaBjeFV&n 7S4q@@F j4֚8n2߯5z4aeFa HCSmm@d;Wذ1Zp|e ^*G&hή@7}෉W~o#gk^)*9EB@ y++'y!A#}ձ˄0~ʢ"kڀby޾+'wBcM ;_zûWVWZni2tۺORFC2+x!YVu*& Т h!yiw <{|[WN$?MxvEܿg5FfZ7Ք-8HP6mP+ s,vRW뱣Q~ lX G0ZO[.)2032sdޏW{[]6z9/[ ab@Ըmyh8Mg]5^Xs?,tmN !3nm- (! Dr6tܠG2z߿\$avg\P@ =50]ߝ,muOwNn_,yۃqww 소eY~1w _0krhFnFz,  Ϩa H!i{čuC61tE#F"YJdTVGK_eۢ1ˤl La=r#<@h) ~ ='kƭ9}WOmkᦁj 8~I~e?R/nO=r+ơ#MyŠ͹1Gi[fnmk|-ٲMŭ'YT&lNLE15,<5KZ%s^r ?'jHfY@M#mt(oqI4' D#J(_pzR8{ y,.O*17D/?͋qǽ Q0o0QxAJz*"҃n>Տfi^ӗ/ؚS aC?,PO@Lm[3; \풕?Y0gIZobL?v6?߯O嗲8iƝS bfgvQ~ݳ16_9WI7z]8]V옴b{!I7C3ǝ=;V'2khˏ{-n=cH:@ TZBHV?Z;6EZ"z\&Z .H:$oJy FR":I{c4m18`Om$E8İdCnPb 0IW$} Mg s'}$SCX=+^VYF{o{rL * Cdջ<{~ 6OK|d`ٱ**ʪ|Y@`meBk߽E;L9ń'1HLܿuԕ.kxA$ 2 22#d=R8.ÐA:m$+ PUtҋ(C8'FFpLT4h5&JwT4B\<$.#ZoI U]&R%_RH3Eb9*UCH!Bܥ8"ϊ #q=)ڃuH;sZNybZE+(m_ib8L(8=%GZq1AjrxzQObd'al&HQzx29(_"MD˙Yc^IOe‚b̀0tCd'l IR&M=/X.D:_⌲BصjÊ-#n@14L<Ĉ,ˋhA6,TK5{Sҏ"=#sj/ CjU Ž2pznYDe?o#wa~Zb/@T˞t0+~IYr8ƫLd>0k #?4XV0QX    Hdԩ#N.ymX~-_ B\F F􂲜ϻbPQZm,.F a #*|aQ&WF*F?YTo oRR} KxU_Z%}DPV,zUԶq'?dqjąKwn2Eao97^dnA1^a '\U^)JcMbHd]H%I`T'FWiwjhIvTQBbI 3>(q_)NH5y5O% TA^Mq.']\pDlB™-TSגQ=Q.IA환')nSwoEKPŒ0q'1 FU@*(ypjlDlR\׋Xv@R!ɟL2w +Vm#l T n7ؠtywU(uTk_8e@Fj0Vu7Cҏ)hWw,#D&v֜ZAnD/K"b.ã<_u-FP"7ٝD{R,FfFd'gGKg gp㞻->n}U?T6x! xGw/FΓkՈFw4d F[goN HnP#?`oI\x%QFjⴀ ÿlL=Gx^L$BD3|4"EFR aO#FHyע'8+Y\ALA!qɍ =F HAO-P&;Ѣ$ߪ}+?5BD"?~NK"ȧ4/PVY b8{!<9D'c[Q հeaBrnyat=+ @5 p@qI'gGb?|[@@e @Ѳڣ!ᒂ=3$piH`_%7780!GEĄLQw#t+N]~2)$z$']E/R;1}'4 qWzE=,_Aȝ\>5 UցhQ֜Nͮ0\x9FK[YbY`]T%W} $=%(O9Fy8˷,wA#m_Syv=lC<ۑX,NCK%ozE"K,1FLő+NO V\LNf>   P_<ҍ{ŌJDTjo .)dBTBvѰAFɷ,eQa4!y̞%R%BޓiD/Ex[#ba8"Ij%2]5؅,Pi@  {@l^备/I} UNDMy_$C$V!0amH!^SqFUEEeiF\HUl  JB$K cԹW;cHA^2fILVhŘȅSmA@@y!O!e$?h/Tom@/Hh4}Na¨9d0ƯYEuwK,:<)]~r@:Hv|>eX`WCXd2jn)0,8۰*ѠpH'vMm1ywYAIFVN㞻->n}e<,PQz dBcۦZ'~]N尌SG)[9!7 'uLY%.ER&;]*ha923irJ IDATňy+A"̋Ґ횽$tknzÎbA?p*َC 7 4J  03+fAg2ODŽ_s; LVhEb!LiEE )";)6; {ӿ=$)`$f¨ BƤ\tt@Y@@@@@ @@4C[`C@@@@5 (HLZLZS3BYA@@i.EQFJπM{ @n дpFzCn -z |xMU:r[NR/qV|u?/$Oe   -Rn3~ƣ{J5Z|A@@Bx<>0z$>$jZPn~P`iaH:-vYjz/Uz4j_Q2[x"snr3fiwO4N:/lKِ`䐷s&8tqé@$}-.YopݩTFeo?nudZvVٔ_:Ma(o1;_JX" ~>;bOE5*+l̢-0@\\߫[.E|&uB>W|9LcZL~1.{뗯t%t%;#BW;Ee|4GQA 7 7%%Q'%Ŗ,Evlc'ݺ̦ILwmfg:kͶv6ٸ&YǒX%[HI&A$AA7pw %p$}?~w<"Kih@Q3 o\yl_f8ܐiK޻+07Yyy19_[ TMrmީ} oO-E$?[=}곦YJ3l[Z@yU>d??n;Jܫ|[wA9dO|K.|RP( Kxp۹da ӫ"OoԽ?=Qul 5k_j(B8n@   #>gXe/x0̂ge_`_8zI^Yx$sx#+'Z G(`)(<`P] Њp$si'%_<Ђ$6(T"glգBxGg^FN;1Nzͽ2Si<_oAܯj| Ģ{vN9 g4޲"H;<6 l[sϴ%xEP(&Nqzura7#W=l͍deM6tb952(K qq@@8 +͊Z옾$wX哯7qXaãN5>3Bro2NA?0xޅEP$,U.}րE?ڦUhl#XbFwM;%5`Flf)2F4w=d~qo}ZsrƵܵ W*x@ؽo SKa-ސR˟$z0l2vj cm 20AtY0Ls/H#Wxy|O~WԬaoNS(glYZޘ-L>o(Y?)j $p}ӗЂqX<a樻hˋ lDY]FFF`"cbc^S玘K׮JqmVrʭ_o]/QˠhhhExY+߽Sqqޗ̊%͏Jgd_8Β6{ٿEF 'Q"LA05@ϟǛ;KVnAۇ~0s<Px5e~(au#?`kJ{\0G~XC04@<4w)#y^=sj}Q,(|cDmq.VFFF`#wv444444#a-暜. F*Gŗ|t>G@,5ƁG͖F߁@=Wk.;'ѾGŷ44o6!Mxtd.4UE 9{ ?urxR{z/P,>k% S{/aS_1O 0Q bS)YXE74N<;pTh}'KH^%ꪯ ˍ#uvt)S'zihlI˜%n=EޙpL )K wbg/;ㇰ]WaL7H C_ԇb>F z渉 <҅m:CN4vxiQif4}|f3u%q*1h$e vgb4βvJKu5olSwF:>:lޮ3&ۥL2R@~DĔ5}\.i&l!d(ŋ t` &>6_w<oHɕYa1lS2(sz#2v(+U! J{^Rŧcݾ 'Q{v_yIRz|v@:q*1e;3JVGƻc*]0ʛ Ӓ8RlJ9* 5]0ŐRn(#7Z-AۜY lcwiy4.jdGn-x&e,k.Y@YwЇ(/)Lʱ#֚jc^;7ɠ.pV$3#1-gj| (0Rh?4PsoNƄG޺xV1mP(v!ՠ VQq b0@Q Da)xh$ Y+-yj AxR;Uj:W}łJVwMw# 9ҏ?TVΟglp~tJ MtCwœGZ>{ 󍞌vpm0L\1:M=SoŦTm:%B'_ #^9}DÕ QT5LQ;"d%>샫Q~ MQq(qyۖB_'tZܛ@e< ±CK 2bD8Iތ' Jqج';FDrnF[.X,KX%+?c57B2bU2paaX;!yz BYKݽ]O \60'N/q*5ݤ(LwK ١i ]o'huyMHqJn&8=rjl=<Ϲ ) :^{X-jjYФG*of  FׯLk^-e5'l~%6ׂ+6`.l!Frp%Givi-mBt'SZ:hV/2lj6+?Vަ;fCdx¶ӍՉLmT?QjI[?bgeNՖ/r+~=3rcwOI܎0{$}\fFkv-r#D&&@LU`F$D ~)BA` n*XyS,2z&IKڛ0&1V4 G0cX@ZV!>U@..t<(PƮ3QW^نFK1*g<PHxaG(7qd팇UV*"$q*@G_/>qd Q[oщN#.=4pHʋ7&1s#Q'z:DH) qD2GEEYsM>"_2^?p|?/"U|tKV+Z `ؤ 0vC\fӣniV9ܤ)XW'*@5/8-Cd"CiKZTŵwt{tB ~h^O E{'fMnED<0TOmw'2P-jy^o)ɒF}DԛˏU`.6|{PMst4.T`DpHBX]Hqx$3^}Nۄ@u 8 ڧy܊e"[BI@E'C>`_ǩу,X^;@FX\7LR'IzwY,&zqσŰb;>- IDATB>xM^f>T߄MGNφ?@2t +…o Σa\*'RhYG dP>/B X>v?7oah2=Q%N%g9HwcbZp[W1PN`F -3ڼASM] al (`ͩ"l&ݰ2LwGυ۷{Y tUNmLb?/(!6Яku1Xr#nG56N ׾ds?B7A0mx1jF(W@$W6ߣ~T?=!ʺ8Xe2yb.slO撻q&/Io/ߍvtҵv]1H}KXD?lvs(0|r>`pp@]g.%yOxs̰i+#? i{ΟmK+!I͡ɗ)i)/]SSioQe?_qyKK* A!- oN CūNuU2+0 R@1Ӧo֟hHye}^y5H,ˌ9=a8*-K'/ޞCѳƧnz +C:أCNuEĩJn(K:afZgߍT0`D s5s~*KOuS@lR囜 WOEɰ rة݆hTb9IʒeR7Lbz3PzX.2"8[.KeaޭT!Xl6MܒRˉe I%* A!]4 W]6x¶yՍ)Xcĩ[[<>V P`+X䬖7*F%&IH_lء唏~Q+y>gtؒBXANT8oI&pW-\Gp K.h QШz?(*B,9o>,sʬMbxHk_;۱gwYuFk۰F6@*̒Os8 DVjM.,I;" rn,Pf|])4B*T;ņWwTܶOo!vS%6Niٺq*deI2b.$-7#Vj?ZD9{;W3Oy|R%ߘK֣gL؊4E ZNgn קe& qLlS/juq8 /(ʢrxF1WߕރSB^Bp`L\RfgP 3I8 -sF&8J|4&]o8 Cc5،e#*Ek,l|iGvBsp@+:z8৐[=]YFalG18i֏EĂXH3xrk3*WD5[`wV  sASd>1.Z?&.<A\xYݺuU眽; ٺo WŖt'Q¸EUD7˨l]yV4qZ dҫtrcgxٓ'jF<\vq;"%9' I4!P7+]%-RۉZ*^_ ډk}Am(bհNc/IO2%ɓLT'1>ӬVjUmT͈k mjx79@sV~7~5~ǹG5؊Wf45"p(YkQ/Di) <wPGg2!@[` l/Ə;a9OAWZھ"Fa^#9l@yw>:vKt')) 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 patat-0.8.4.0/lib/Data/Aeson/TH/000077500000000000000000000000001354737347300160115ustar00rootroot00000000000000patat-0.8.4.0/lib/Data/Aeson/TH/Extended.hs000066400000000000000000000012151354737347300201040ustar00rootroot00000000000000-------------------------------------------------------------------------------- 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 patat-0.8.4.0/lib/Data/Data/000077500000000000000000000000001354737347300153025ustar00rootroot00000000000000patat-0.8.4.0/lib/Data/Data/Extended.hs000066400000000000000000000011201354737347300173700ustar00rootroot00000000000000module 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 patat-0.8.4.0/lib/Patat/000077500000000000000000000000001354737347300146315ustar00rootroot00000000000000patat-0.8.4.0/lib/Patat/AutoAdvance.hs000066400000000000000000000041461354737347300173640ustar00rootroot00000000000000-------------------------------------------------------------------------------- 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 patat-0.8.4.0/lib/Patat/Cleanup.hs000066400000000000000000000005061354737347300165550ustar00rootroot00000000000000-------------------------------------------------------------------------------- -- | Defines a cleanup action that needs to be run after we're done with a slide -- or image. module Patat.Cleanup ( Cleanup ) where -------------------------------------------------------------------------------- type Cleanup = IO () patat-0.8.4.0/lib/Patat/Images.hs000066400000000000000000000040471354737347300163770ustar00rootroot00000000000000-------------------------------------------------------------------------------- {-# 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.Cleanup 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 Cleanup drawImage = hDrawImage patat-0.8.4.0/lib/Patat/Images/000077500000000000000000000000001354737347300160365ustar00rootroot00000000000000patat-0.8.4.0/lib/Patat/Images/ITerm2.hs000066400000000000000000000041671354737347300175040ustar00rootroot00000000000000-------------------------------------------------------------------------------- {-# 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 Patat.Cleanup (Cleanup) 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 Cleanup drawImage path = do content <- BL.readFile path withEscapeSequence $ do putStr "1337;File=inline=1;width=100%;height=100%:" BL.putStr (B64.encode content) return mempty -------------------------------------------------------------------------------- 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" patat-0.8.4.0/lib/Patat/Images/Internal.hs000066400000000000000000000024471354737347300201550ustar00rootroot00000000000000-------------------------------------------------------------------------------- {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} module Patat.Images.Internal ( Config (..) , Backend (..) , BackendNotSupported (..) , Handle (..) ) where -------------------------------------------------------------------------------- import Control.Exception (Exception) import qualified Data.Aeson as A import Data.Data (Data) import Data.Typeable (Typeable) import Patat.Cleanup -------------------------------------------------------------------------------- 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 (Data, Show, Typeable) -------------------------------------------------------------------------------- instance Exception BackendNotSupported -------------------------------------------------------------------------------- data Handle = Handle { hDrawImage :: FilePath -> IO Cleanup } patat-0.8.4.0/lib/Patat/Images/W3m.hs000066400000000000000000000121211354737347300170350ustar00rootroot00000000000000-------------------------------------------------------------------------------- {-# LANGUAGE TemplateHaskell #-} module Patat.Images.W3m ( backend ) where -------------------------------------------------------------------------------- import Control.Exception (throwIO) import Control.Monad (unless, void) import qualified Data.Aeson.TH.Extended as A import Data.List (intercalate) import Patat.Cleanup (Cleanup) 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 " \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 Cleanup 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" -- Draw image. _ <- Process.readProcess w3mPath [] command -- Return a 'Cleanup' that clears the image. return $ void $ Process.readProcess w3mPath [] $ "6;" ++ intercalate ";" (map show [x, y, w, h]) 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) patat-0.8.4.0/lib/Patat/Main.hs000066400000000000000000000201771354737347300160600ustar00rootroot00000000000000-------------------------------------------------------------------------------- {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Patat.Main ( main ) where -------------------------------------------------------------------------------- import Control.Applicative ((<$>), (<*>)) import Control.Concurrent (forkIO, killThread, threadDelay) import Control.Concurrent.Chan (Chan) import qualified Control.Concurrent.Chan as Chan import Control.Exception (bracket) 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.Pandoc as Pandoc 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) putStrLn $ "Using pandoc: " ++ Pandoc.pandocVersion 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 = interactively readPresentationCommand $ \commandChan0 -> do -- 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 cleanup <- case mbError of Nothing -> displayPresentation images pres Just err -> displayPresentationError pres err c <- Chan.readChan commandChan update <- updatePresentation c pres cleanup case update of ExitedPresentation -> return () UpdatedPresentation pres' -> loop pres' Nothing ErroredPresentation err -> loop pres (Just err) loop pres0 Nothing -------------------------------------------------------------------------------- -- | Utility for dealing with pecularities of stdin & interactive applications -- on the terminal. Tries to restore the original state of the terminal as much -- as possible. interactively -- | Reads a command from stdin (or from some other IO). This will be -- interrupted by 'killThread' when the application finishes. :: (IO.Handle -> IO a) -- | Application to run. -> (Chan a -> IO ()) -- | Returns when application finishes. -> IO () interactively reader app = bracket setup teardown $ \(_, _, _, chan) -> app chan where setup = do chan <- Chan.newChan echo <- IO.hGetEcho IO.stdin buff <- IO.hGetBuffering IO.stdin IO.hSetEcho IO.stdin False IO.hSetBuffering IO.stdin IO.NoBuffering Ansi.hideCursor readerThreadId <- forkIO $ forever $ reader IO.stdin >>= Chan.writeChan chan return (echo, buff, readerThreadId, chan) teardown (echo, buff, readerThreadId, _chan) = do Ansi.showCursor Ansi.clearScreen Ansi.setCursorPosition 0 0 killThread readerThreadId IO.hSetEcho IO.stdin echo IO.hSetBuffering IO.stdin buff -------------------------------------------------------------------------------- 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 patat-0.8.4.0/lib/Patat/Presentation.hs000066400000000000000000000010211354737347300176320ustar00rootroot00000000000000module 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 patat-0.8.4.0/lib/Patat/Presentation/000077500000000000000000000000001354737347300173045ustar00rootroot00000000000000patat-0.8.4.0/lib/Patat/Presentation/Display.hs000066400000000000000000000353271354737347300212570ustar00rootroot00000000000000-------------------------------------------------------------------------------- {-# 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 Patat.Cleanup 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 Cleanup 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 return mempty -------------------------------------------------------------------------------- displayImage :: Images.Handle -> FilePath -> IO Cleanup 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 Cleanup 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 Cleanup 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.isSuffixOf` t) isVisibleBlock _ = True patat-0.8.4.0/lib/Patat/Presentation/Display/000077500000000000000000000000001354737347300207115ustar00rootroot00000000000000patat-0.8.4.0/lib/Patat/Presentation/Display/CodeBlock.hs000066400000000000000000000061731354737347300231010ustar00rootroot00000000000000-------------------------------------------------------------------------------- -- | 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) ' ') <> " " patat-0.8.4.0/lib/Patat/Presentation/Display/Table.hs000066400000000000000000000071661354737347300223060ustar00rootroot00000000000000-------------------------------------------------------------------------------- {-# 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 patat-0.8.4.0/lib/Patat/Presentation/Fragment.hs000066400000000000000000000122301354737347300214010ustar00rootroot00000000000000-- | 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 patat-0.8.4.0/lib/Patat/Presentation/Interactive.hs000066400000000000000000000123051354737347300221160ustar00rootroot00000000000000-------------------------------------------------------------------------------- -- | 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 Data.Char (isDigit) import Patat.Presentation.Internal import Patat.Presentation.Read import qualified System.IO as IO import Text.Read (readMaybe) -------------------------------------------------------------------------------- data PresentationCommand = Exit | Forward | Backward | SkipForward | SkipBackward | First | Last | Reload | Seek Int | UnknownCommand String deriving (Eq, Show) -------------------------------------------------------------------------------- readPresentationCommand :: IO.Handle -> IO PresentationCommand readPresentationCommand h = do k <- readKeys 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 -- Number followed by enter _ | Just n <- readMaybe k -> return (Seek n) _ -> return (UnknownCommand k) where readKeys :: IO String readKeys = do c0 <- IO.hGetChar h case c0 of '\ESC' -> do c1 <- IO.hGetChar h case c1 of '[' -> do c2 <- IO.hGetChar h return [c0, c1, c2] _ -> return [c0, c1] _ | isDigit c0 && c0 /= '0' -> (c0 :) <$> readDigits _ -> return [c0] readDigits :: IO String readDigits = do c <- IO.hGetChar h if isDigit c then (c :) <$> readDigits else return [c] -------------------------------------------------------------------------------- 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) Seek n -> return $ goToSlide $ \_ -> (n - 1, 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 } patat-0.8.4.0/lib/Patat/Presentation/Internal.hs000066400000000000000000000230061354737347300214150ustar00rootroot00000000000000-------------------------------------------------------------------------------- {-# 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) patat-0.8.4.0/lib/Patat/Presentation/Read.hs000066400000000000000000000205041354737347300205140ustar00rootroot00000000000000-- | 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 patat-0.8.4.0/lib/Patat/PrettyPrint.hs000066400000000000000000000315031354737347300174730ustar00rootroot00000000000000-------------------------------------------------------------------------------- -- | 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 patat-0.8.4.0/lib/Patat/Theme.hs000066400000000000000000000315531354737347300162360ustar00rootroot00000000000000-------------------------------------------------------------------------------- {-# 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) patat-0.8.4.0/lib/Text/000077500000000000000000000000001354737347300145045ustar00rootroot00000000000000patat-0.8.4.0/lib/Text/Pandoc/000077500000000000000000000000001354737347300157105ustar00rootroot00000000000000patat-0.8.4.0/lib/Text/Pandoc/Extended.hs000066400000000000000000000015261354737347300200100ustar00rootroot00000000000000-------------------------------------------------------------------------------- {-# 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 patat-0.8.4.0/patat.cabal000066400000000000000000000072511354737347300151140ustar00rootroot00000000000000Name: patat Version: 0.8.4.0 Synopsis: Terminal-based presentations using Pandoc Description: Terminal-based presentations using Pandoc. License: GPL-2 License-file: LICENSE Author: Jasper Van der Jeugt Maintainer: Jasper Van der Jeugt 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 Library Ghc-options: -Wall Hs-source-dirs: lib Default-language: Haskell2010 Build-depends: aeson >= 0.9 && < 1.5, ansi-terminal >= 0.6 && < 0.10, ansi-wl-pprint >= 0.6 && < 0.7, base >= 4.8 && < 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.16, pandoc >= 2.0.4 && < 2.8, process >= 1.6 && < 1.7, skylighting >= 0.1 && < 0.9, 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.12, -- 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 Exposed-modules: Patat.AutoAdvance Patat.Cleanup Patat.Images Patat.Images.Internal Patat.Images.W3m Patat.Images.ITerm2 Patat.Main 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 Other-modules: Data.Aeson.Extended Data.Aeson.TH.Extended Data.Data.Extended Paths_patat Text.Pandoc.Extended Executable patat Main-is: Main.hs Ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N" Hs-source-dirs: src Default-language: Haskell2010 Build-depends: base, patat 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.8 && < 5, mtl >= 2.2 && < 2.3, pandoc >= 2.0 && < 2.8, text >= 1.2 && < 1.3, time >= 1.6 && < 1.10 Test-suite patat-tests Main-is: Main.hs Ghc-options: -Wall Hs-source-dirs: tests/haskell Type: exitcode-stdio-1.0 Default-language: Haskell2010 Other-modules: Patat.Presentation.Interactive.Tests Build-depends: patat, base >= 4.8 && < 5, directory >= 1.2 && < 1.4, tasty >= 1.2 && < 1.3, tasty-hunit >= 0.10 && < 0.11, tasty-quickcheck >= 0.10 && < 0.11, QuickCheck >= 2.8 && < 2.14 patat-0.8.4.0/src/000077500000000000000000000000001354737347300136015ustar00rootroot00000000000000patat-0.8.4.0/src/Main.hs000066400000000000000000000001021354737347300150120ustar00rootroot00000000000000import qualified Patat.Main main :: IO () main = Patat.Main.main patat-0.8.4.0/stack.yaml000066400000000000000000000001721354737347300150030ustar00rootroot00000000000000resolver: 'lts-14.6' save-hackage-creds: false packages: - '.' flags: patat: patat-make-man: true extra-deps: [] patat-0.8.4.0/tests/000077500000000000000000000000001354737347300141545ustar00rootroot00000000000000patat-0.8.4.0/tests/golden.sh000077500000000000000000000013421354737347300157630ustar00rootroot00000000000000#!/bin/bash set -o nounset -o errexit -o pipefail srcs=$(find tests/golden -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 patat-0.8.4.0/tests/golden/000077500000000000000000000000001354737347300154245ustar00rootroot00000000000000patat-0.8.4.0/tests/golden/01.md000066400000000000000000000002131354737347300161620ustar00rootroot00000000000000--- title: This is my presentation author: Jasper Van der Jeugt ... # This is a test Hello world --- # This is a second slide lololol patat-0.8.4.0/tests/golden/01.md.dump000066400000000000000000000001631354737347300171320ustar00rootroot00000000000000# This is a test Hello world ---------- # This is a second slide lololol patat-0.8.4.0/tests/golden/02.lhs000066400000000000000000000001461354737347300163560ustar00rootroot00000000000000This is how you define a `String` in Haskell: > test :: String > test = "Hello World!" Cool, right? patat-0.8.4.0/tests/golden/02.lhs.dump000066400000000000000000000005141354737347300173210ustar00rootroot00000000000000This is how you define a  String  in Haskell:      test :: String    test = "Hello World!"     Cool, right? patat-0.8.4.0/tests/golden/03.md000066400000000000000000000007141354737347300161720ustar00rootroot00000000000000Inline markups: - ~~striked out~~ - --- > 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 patat-0.8.4.0/tests/golden/03.md.dump000066400000000000000000000021411354737347300171320ustar00rootroot00000000000000Inline 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 patat-0.8.4.0/tests/golden/bolditalic.md000066400000000000000000000001261354737347300200530ustar00rootroot00000000000000--- patat: theme: emph: [italic] strong: [bold] ... **Strong** and _emph_. patat-0.8.4.0/tests/golden/bolditalic.md.dump000066400000000000000000000000571354737347300210220ustar00rootroot00000000000000Strong and emph. patat-0.8.4.0/tests/golden/comments.lhs000066400000000000000000000001521354737347300177570ustar00rootroot00000000000000# This is a test > putStrLn "Hello, world" Yep. patat-0.8.4.0/tests/golden/comments.lhs.dump000066400000000000000000000003541354737347300207270ustar00rootroot00000000000000# This is a test      putStrLn "Hello, world"     Yep. patat-0.8.4.0/tests/golden/comments.md000066400000000000000000000003351354737347300175740ustar00rootroot00000000000000# This is a test Hello world # This is a second slide Where are my raw blocks at patat-0.8.4.0/tests/golden/comments.md.dump000066400000000000000000000002061354737347300205350ustar00rootroot00000000000000# This is a test Hello world ---------- # This is a second slide Where are my raw blocks at patat-0.8.4.0/tests/golden/deflist.md000066400000000000000000000003451354737347300174020ustar00rootroot00000000000000Term 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 patat-0.8.4.0/tests/golden/deflist.md.dump000066400000000000000000000010161354737347300203420ustar00rootroot00000000000000Term 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 patat-0.8.4.0/tests/golden/extentions0.md000066400000000000000000000002241354737347300202240ustar00rootroot00000000000000--- patat: pandocExtensions: - patat_extensions - autolink_bare_uris - emoji ... Check out this example: http://example.com/ :smile: patat-0.8.4.0/tests/golden/extentions0.md.dump000066400000000000000000000001141354737347300211660ustar00rootroot00000000000000Check out this example: <http://example.com/> 😄 patat-0.8.4.0/tests/golden/extentions1.md000066400000000000000000000001671354737347300202330ustar00rootroot00000000000000--- patat: pandocExtensions: - emoji ... The patat default ~~strikeout~~ is not enabled, but emojis are :smile: patat-0.8.4.0/tests/golden/extentions1.md.dump000066400000000000000000000001131354737347300211660ustar00rootroot00000000000000The patat default ~~strikeout~~ is not enabled, but emojis are 😄 patat-0.8.4.0/tests/golden/fragments.md000066400000000000000000000002721354737347300177350ustar00rootroot00000000000000--- patat: incrementalLists: true ... - This list - is displayed * item * by item - Or sometimes > * all at > * once --- Legen . . . wait for it . . . Dary! patat-0.8.4.0/tests/golden/fragments.md.dump000066400000000000000000000014601354737347300207010ustar00rootroot00000000000000 ~~~frag  - This list ~~~frag  - This list  - is displayed ~~~frag  - This list  - is displayed   * item ~~~frag  - This list  - is displayed   * item   * by item ~~~frag  - This list  - is displayed   * item   * by item  - Or sometimes   * all at   * once ---------- Legen ~~~frag Legen wait for it ~~~frag Legen wait for it Dary! patat-0.8.4.0/tests/golden/headers.md000066400000000000000000000002661354737347300173650ustar00rootroot00000000000000# 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? patat-0.8.4.0/tests/golden/headers.md.dump000066400000000000000000000005401354737347300203240ustar00rootroot00000000000000~~~title # This could be a title ---------- ## This is nested Here is some content ---------- ## This is also nested Here is more content ---------- ~~~title # Another topic ---------- ## What is going on? I think we can display slides? patat-0.8.4.0/tests/golden/links.md000066400000000000000000000003401354737347300170630ustar00rootroot00000000000000This is an "automatic link": . 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/ patat-0.8.4.0/tests/golden/links.md.dump000066400000000000000000000007161354737347300200360ustar00rootroot00000000000000This is an "automatic link": <https://jaspervdj.be>. This is an [inline link], and here's [one with a title]. Let's talk about [foo] [inline link](/url) [one with a title](http://fsf.org "click here for a good time!") [foo](http://foo.com/)patat-0.8.4.0/tests/golden/lists.md000066400000000000000000000004001354737347300170760ustar00rootroot00000000000000- 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 patat-0.8.4.0/tests/golden/lists.md.dump000066400000000000000000000005771354737347300200610ustar00rootroot00000000000000 - 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 patat-0.8.4.0/tests/golden/margins.md000066400000000000000000000004221354737347300174040ustar00rootroot00000000000000--- 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". patat-0.8.4.0/tests/golden/margins.md.dump000066400000000000000000000006061354737347300203540ustar00rootroot00000000000000 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". patat-0.8.4.0/tests/golden/meta.md000066400000000000000000000001651354737347300166760ustar00rootroot00000000000000--- patat: theme: bulletListMarkers: '<>' ... - Hello - World * How * Are * You * Doing patat-0.8.4.0/tests/golden/meta.md.dump000066400000000000000000000003031354737347300176340ustar00rootroot00000000000000 < Hello  < World   > How   > Are   > You   > Doing patat-0.8.4.0/tests/golden/slidelevel0.md000066400000000000000000000001651354737347300201600ustar00rootroot00000000000000--- patat: slideLevel: 0 --- # We should not split slides Never # At all Because we have `slideLevel` set to 0 patat-0.8.4.0/tests/golden/slidelevel0.md.dump000066400000000000000000000002101354737347300211130ustar00rootroot00000000000000# We should not split slides Never # At all Because we have  slideLevel  set to 0 patat-0.8.4.0/tests/golden/slidelevel1.md000066400000000000000000000004671354737347300201660ustar00rootroot00000000000000--- 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 patat-0.8.4.0/tests/golden/slidelevel1.md.dump000066400000000000000000000006061354737347300211250ustar00rootroot00000000000000# 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 patat-0.8.4.0/tests/golden/slidelevel2.md000066400000000000000000000002361354737347300201610ustar00rootroot00000000000000# 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 patat-0.8.4.0/tests/golden/slidelevel2.md.dump000066400000000000000000000005101354737347300211200ustar00rootroot00000000000000~~~title # This is a title ---------- ## This is a slide Here is some content ---------- ## And another slide And more content (yep) ---------- ~~~title # This is another title ---------- ## With some content Yay patat-0.8.4.0/tests/golden/syntax.md000066400000000000000000000002371354737347300172760ustar00rootroot00000000000000--- patat: theme: syntaxHighlighting: decVal: [bold, onDullRed] ... Some simple code: ```c int main(int argc, char **argv) { return 0; } ``` patat-0.8.4.0/tests/golden/syntax.md.dump000066400000000000000000000007051354737347300202420ustar00rootroot00000000000000Some simple code:      int main(int argc, char **argv) {    return 0;    }     patat-0.8.4.0/tests/golden/tables.md000066400000000000000000000030611354737347300172200ustar00rootroot00000000000000# 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. patat-0.8.4.0/tests/golden/tables.md.dump000066400000000000000000000036061354737347300201710ustar00rootroot00000000000000# 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.   ------ --- ---- ------------------------  Table: Here's a multiline table without headers. patat-0.8.4.0/tests/golden/themes.md000066400000000000000000000003651354737347300172370ustar00rootroot00000000000000--- 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. patat-0.8.4.0/tests/golden/themes.md.dump000066400000000000000000000004051354737347300201760ustar00rootroot00000000000000 - This is a simple list.   + With nested items.   + One or two bold.  - The list theming is customized a bit. patat-0.8.4.0/tests/golden/wrapping.md000066400000000000000000000011061354737347300175730ustar00rootroot00000000000000--- 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` patat-0.8.4.0/tests/golden/wrapping.md.dump000066400000000000000000000014151354737347300205420ustar00rootroot00000000000000This 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  patat-0.8.4.0/tests/haskell/000077500000000000000000000000001354737347300155775ustar00rootroot00000000000000patat-0.8.4.0/tests/haskell/Main.hs000066400000000000000000000004011354737347300170120ustar00rootroot00000000000000module Main where import qualified Patat.Presentation.Interactive.Tests import qualified Test.Tasty as Tasty main :: IO () main = Tasty.defaultMain $ Tasty.testGroup "patat" [ Patat.Presentation.Interactive.Tests.tests ] patat-0.8.4.0/tests/haskell/Patat/000077500000000000000000000000001354737347300166505ustar00rootroot00000000000000patat-0.8.4.0/tests/haskell/Patat/Presentation/000077500000000000000000000000001354737347300213235ustar00rootroot00000000000000patat-0.8.4.0/tests/haskell/Patat/Presentation/Interactive/000077500000000000000000000000001354737347300236005ustar00rootroot00000000000000patat-0.8.4.0/tests/haskell/Patat/Presentation/Interactive/Tests.hs000066400000000000000000000047701354737347300252460ustar00rootroot00000000000000module Patat.Presentation.Interactive.Tests ( tests ) where import Control.Monad (forM_, replicateM) import Patat.Presentation.Interactive import System.Directory (getTemporaryDirectory, removeFile) import qualified System.IO as IO import qualified Test.QuickCheck as QC import qualified Test.QuickCheck.Monadic as QC import qualified Test.Tasty as Tasty import qualified Test.Tasty.QuickCheck as Tasty tests :: Tasty.TestTree tests = Tasty.testGroup "Patat.Presentation.Interactive.Tests" [ Tasty.testProperty "testReadPresentationCommands" $ QC.monadicIO . QC.run . testReadPresentationCommands ] -- | A raw input string followed by the expected command. data ArbitraryCommand = ArbitraryCommand String PresentationCommand deriving (Show) instance QC.Arbitrary ArbitraryCommand where arbitrary = QC.oneof $ [ return $ ArbitraryCommand "q" Exit , return $ ArbitraryCommand "\n" Forward , return $ ArbitraryCommand "\DEL" Backward , return $ ArbitraryCommand "h" Backward , return $ ArbitraryCommand "j" SkipForward , return $ ArbitraryCommand "k" SkipBackward , return $ ArbitraryCommand "l" Forward , return $ ArbitraryCommand "\ESC[C" Forward , return $ ArbitraryCommand "\ESC[D" Backward , return $ ArbitraryCommand "\ESC[B" SkipForward , return $ ArbitraryCommand "\ESC[A" SkipBackward , return $ ArbitraryCommand "\ESC[6" Forward , return $ ArbitraryCommand "\ESC[5" Backward , return $ ArbitraryCommand "0" First , return $ ArbitraryCommand "G" Last , return $ ArbitraryCommand "r" Reload , do n <- QC.choose (1, 1000) return $ ArbitraryCommand (show n <> "\n") (Seek n) ] testReadPresentationCommands :: [ArbitraryCommand] -> IO Bool testReadPresentationCommands commands = do tmpdir <- getTemporaryDirectory (tmppath, h) <- IO.openBinaryTempFile tmpdir "patat.input" IO.hSetBuffering h IO.NoBuffering forM_ commands $ \(ArbitraryCommand s _) -> IO.hPutStr h s IO.hSeek h IO.AbsoluteSeek 0 parsed <- replicateM (length commands) (readPresentationCommand h) IO.hClose h removeFile tmppath return $ [expect | ArbitraryCommand _ expect <- commands] == parsed