summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasperVanDerJeugt <>2016-10-02 12:02:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-10-02 12:02:00 (GMT)
commita7c0d1bec9548480b27275432aa916d8ff53493b (patch)
treea16042a3cd13622348c240da060802c346c337a2
version 0.1.0.00.1.0.0
-rw-r--r--CHANGELOG.md4
-rw-r--r--LICENSE339
-rw-r--r--Setup.hs2
-rw-r--r--patat.cabal48
-rw-r--r--src/Data/Data/Extended.hs23
-rw-r--r--src/Main.hs137
-rw-r--r--src/Patat/Presentation.hs16
-rw-r--r--src/Patat/Presentation/Display.hs243
-rw-r--r--src/Patat/Presentation/Display/Table.hs93
-rw-r--r--src/Patat/Presentation/Interactive.hs100
-rw-r--r--src/Patat/Presentation/Internal.hs27
-rw-r--r--src/Patat/Presentation/Read.hs80
-rw-r--r--src/Patat/PrettyPrint.hs386
-rw-r--r--src/Text/Pandoc/Extended.hs21
14 files changed, 1519 insertions, 0 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..9b45b5e
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,4 @@
+# Changelog
+
+- 0.1.0.0 (2016-10-02)
+ * Upload first version from hotel wifi in Kalaw.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..1f53f40
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,339 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Lesser General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License along
+ with this program; if not, write to the Free Software Foundation, Inc.,
+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/patat.cabal b/patat.cabal
new file mode 100644
index 0000000..792060d
--- /dev/null
+++ b/patat.cabal
@@ -0,0 +1,48 @@
+Name: patat
+Version: 0.1.0.0
+Synopsis: Terminal-based presentations using Pandoc
+Description: Terminal-based presentations using Pandoc
+License: GPL-2
+License-file: LICENSE
+Author: Jasper Van der Jeugt <m@jaspervdj.be>
+Maintainer: Jasper Van der Jeugt <m@jaspervdj.be>
+Homepage: http://github.com/jaspervdj/patat
+Copyright: 2016 Jasper Van der Jeugt
+Category: Text
+Build-type: Simple
+Extra-source-files: CHANGELOG.md
+Cabal-version: >=1.10
+
+Source-repository head
+ Type: git
+ Location: git://github.com/jaspervdj/patat.git
+
+Executable patat
+ Main-is: Main.hs
+ Ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N"
+ Hs-source-dirs: src
+ Default-language: Haskell2010
+
+ Build-depends:
+ ansi-terminal >= 0.6 && < 0.7,
+ ansi-wl-pprint >= 0.6 && < 0.7,
+ base >= 4.6 && < 4.10,
+ containers >= 0.5 && < 0.6,
+ directory >= 1.2 && < 1.3,
+ filepath >= 1.4 && < 1.5,
+ mtl >= 2.2 && < 2.3,
+ optparse-applicative >= 0.12 && < 0.14,
+ pandoc >= 1.17 && < 1.18,
+ terminal-size >= 0.3 && < 0.4,
+ time >= 1.4 && < 1.7
+
+ Other-modules:
+ Data.Data.Extended
+ Patat.Presentation
+ Patat.Presentation.Display
+ Patat.Presentation.Display.Table
+ Patat.Presentation.Interactive
+ Patat.Presentation.Internal
+ Patat.Presentation.Read
+ Patat.PrettyPrint
+ Text.Pandoc.Extended
diff --git a/src/Data/Data/Extended.hs b/src/Data/Data/Extended.hs
new file mode 100644
index 0000000..636591e
--- /dev/null
+++ b/src/Data/Data/Extended.hs
@@ -0,0 +1,23 @@
+module Data.Data.Extended
+ ( module Data.Data
+
+ , grecQ
+ , grecT
+ ) where
+
+import Data.Data
+
+-- | Recursively find all values of a certain type.
+grecQ :: (Data a, Data b) => a -> [b]
+grecQ = concat . gmapQ (\x -> maybe id (:) (cast x) $ grecQ x)
+
+-- | Recursively apply an update to a certain type.
+grecT :: (Data a, Data b) => (a -> a) -> b -> b
+grecT f x = gmapT (grecT f) (castMap f x)
+
+castMap :: (Typeable a, Typeable b) => (a -> a) -> b -> b
+castMap f x = case cast x of
+ Nothing -> x
+ Just y -> case cast (f y) of
+ Nothing -> x
+ Just z -> z
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..2278478
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,137 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Main where
+
+
+--------------------------------------------------------------------------------
+import Control.Applicative ((<$>), (<*>))
+import Control.Concurrent (forkIO, threadDelay)
+import qualified Control.Concurrent.Chan as Chan
+import Control.Monad (forever, unless, when)
+import Data.Monoid ((<>))
+import Data.Version (showVersion)
+import qualified Options.Applicative as OA
+import Patat.Presentation
+import qualified Paths_patat
+import qualified System.Console.ANSI as Ansi
+import System.Directory (getModificationTime)
+import System.Exit (exitFailure)
+import qualified System.IO as IO
+import qualified Text.PrettyPrint.ANSI.Leijen as PP
+import Prelude
+
+
+--------------------------------------------------------------------------------
+data Options = Options
+ { oFilePath :: !FilePath
+ , oForce :: !Bool
+ , oDump :: !Bool
+ , oWatch :: !Bool
+ } deriving (Show)
+
+
+--------------------------------------------------------------------------------
+parseOptions :: OA.Parser Options
+parseOptions = Options
+ <$> (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")
+
+
+--------------------------------------------------------------------------------
+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"
+ , "- Previous slide: backspace, h, left"
+ , "- Go forward 10 slides: j, down"
+ , "- Go backward 10 slides: k, up"
+ , "- First slide: 0"
+ , "- Last slide: G"
+ , "- Reload file: r"
+ , "- Quit: q"
+ ]
+
+
+--------------------------------------------------------------------------------
+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.execParser parserInfo
+ errOrPres <- readPresentation (oFilePath options)
+ pres <- either (errorAndExit . return) return errOrPres
+
+ unless (oForce options) assertAnsiFeatures
+
+ if oDump options
+ then dumpPresentation pres
+ else interactiveLoop options pres
+
+ where
+ interactiveLoop options pres0 = do
+ IO.hSetBuffering IO.stdin IO.NoBuffering
+ commandChan <- Chan.newChan
+
+ _ <- forkIO $ forever $
+ readPresentationCommand >>= Chan.writeChan commandChan
+
+ mtime0 <- getModificationTime (pFilePath pres0)
+ let watcher mtime = do
+ mtime' <- getModificationTime (pFilePath pres0)
+ when (mtime' > mtime) $ Chan.writeChan commandChan Reload
+ threadDelay (200 * 1000)
+ watcher mtime'
+
+ when (oWatch options) $ do
+ _ <- forkIO $ watcher mtime0
+ return ()
+
+ let loop pres = do
+ displayPresentation pres
+ c <- Chan.readChan commandChan
+ update <- updatePresentation c pres
+ case update of
+ ExitedPresentation -> return ()
+ UpdatedPresentation pres' -> loop pres'
+ ErroredPresentation err -> errorAndExit [err]
+
+ loop pres0
diff --git a/src/Patat/Presentation.hs b/src/Patat/Presentation.hs
new file mode 100644
index 0000000..9addefb
--- /dev/null
+++ b/src/Patat/Presentation.hs
@@ -0,0 +1,16 @@
+module Patat.Presentation
+ ( Presentation (..)
+ , readPresentation
+ , displayPresentation
+ , dumpPresentation
+
+ , PresentationCommand (..)
+ , readPresentationCommand
+ , UpdatedPresentation (..)
+ , updatePresentation
+ ) where
+
+import Patat.Presentation.Display
+import Patat.Presentation.Interactive
+import Patat.Presentation.Internal
+import Patat.Presentation.Read
diff --git a/src/Patat/Presentation/Display.hs b/src/Patat/Presentation/Display.hs
new file mode 100644
index 0000000..50b9e05
--- /dev/null
+++ b/src/Patat/Presentation/Display.hs
@@ -0,0 +1,243 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Patat.Presentation.Display
+ ( displayPresentation
+ , dumpPresentation
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Data.Data.Extended (grecQ)
+import Data.List (intersperse)
+import Data.Monoid (mconcat, mempty, (<>))
+import Patat.Presentation.Display.Table
+import Patat.Presentation.Internal
+import Patat.PrettyPrint ((<$$>), (<+>))
+import qualified Patat.PrettyPrint as PP
+import qualified System.Console.ANSI as Ansi
+import qualified System.Console.Terminal.Size as Terminal
+import qualified Text.Pandoc.Extended as Pandoc
+import Prelude
+
+
+--------------------------------------------------------------------------------
+displayPresentation :: Presentation -> IO ()
+displayPresentation Presentation {..} = do
+ Ansi.clearScreen
+ Ansi.setCursorPosition 0 0
+
+ -- Get terminal width/title
+ mbWindow <- Terminal.size
+ let termWidth = maybe 72 Terminal.width mbWindow
+ termHeight = maybe 24 Terminal.height mbWindow
+ title = PP.toString (prettyInlines pTitle)
+ titleWidth = length title
+ titleOffset = (termWidth - titleWidth) `div` 2
+
+ Ansi.setCursorColumn titleOffset
+ PP.putDoc $ PP.dullyellow $ PP.string title
+ putStrLn ""
+ putStrLn ""
+
+ let slide = case drop pActiveSlide pSlides of
+ [] -> mempty
+ (s : _) -> s
+
+ PP.putDoc $ prettySlide slide
+ putStrLn ""
+
+ let active = show (pActiveSlide + 1) ++ " / " ++ show (length pSlides)
+ activeWidth = length active
+
+ Ansi.setCursorPosition (termHeight - 2) 0
+ PP.putDoc $ " " <> PP.dullyellow (prettyInlines pAuthor)
+ Ansi.setCursorColumn (termWidth - activeWidth - 1)
+ PP.putDoc $ PP.dullyellow $ PP.string active
+ putStrLn ""
+
+
+--------------------------------------------------------------------------------
+dumpPresentation :: Presentation -> IO ()
+dumpPresentation =
+ PP.putDoc . PP.vcat . intersperse "----------" . map prettySlide . pSlides
+
+
+--------------------------------------------------------------------------------
+prettySlide :: Slide -> PP.Doc
+prettySlide slide@(Slide blocks) =
+ prettyBlocks blocks <>
+ case prettyReferences slide of
+ [] -> mempty
+ refs -> PP.newline <> PP.vcat refs
+
+
+--------------------------------------------------------------------------------
+prettyBlock :: Pandoc.Block -> PP.Doc
+
+prettyBlock (Pandoc.Plain inlines) = prettyInlines inlines
+
+prettyBlock (Pandoc.Para inlines) = prettyInlines inlines <> PP.newline
+
+prettyBlock (Pandoc.Header i _ inlines) =
+ PP.dullblue (PP.string (replicate i '#') <+> prettyInlines inlines) <>
+ PP.newline
+
+prettyBlock (Pandoc.CodeBlock _ txt) = PP.vcat
+ [ let ind = PP.NotTrimmable " " in
+ PP.indent ind ind $ PP.ondullblack $ PP.dullwhite $ PP.string line
+ | line <- blockified txt
+ ] <> PP.newline
+ where
+ blockified str =
+ let ls = lines str
+ longest = foldr max 0 (map length ls)
+ extend l = " " ++ l ++ replicate (longest - length l) ' ' ++ " " in
+ map extend $ [""] ++ ls ++ [""]
+
+prettyBlock (Pandoc.BulletList bss) = PP.vcat
+ [ PP.indent
+ (PP.NotTrimmable $ PP.dullmagenta " - ")
+ (PP.Trimmable " ")
+ (prettyBlocks bs)
+ | bs <- bss
+ ] <> PP.newline
+
+prettyBlock (Pandoc.OrderedList _ bss) = PP.vcat
+ [ PP.indent
+ (PP.NotTrimmable $ PP.dullmagenta $ PP.string prefix)
+ (PP.Trimmable " ")
+ (prettyBlocks bs)
+ | (prefix, bs) <- zip padded bss
+ ] <> PP.newline
+ where
+ padded = [n ++ replicate (4 - length n) ' ' | n <- numbers]
+ numbers =
+ [ show i ++ "."
+ | i <- [1 .. length bss]
+ ]
+
+prettyBlock (Pandoc.RawBlock _ t) = PP.string t <> PP.newline
+
+prettyBlock Pandoc.HorizontalRule = "---"
+
+prettyBlock (Pandoc.BlockQuote bs) =
+ let quote = PP.NotTrimmable (PP.dullgreen "> ") in
+ PP.indent quote quote (prettyBlocks bs)
+
+prettyBlock (Pandoc.Table caption aligns _ headers rows) = prettyTable Table
+ { tCaption = prettyInlines caption
+ , tAligns = map align aligns
+ , tHeaders = map prettyBlocks headers
+ , tRows = map (map prettyBlocks) rows
+ }
+ where
+ align Pandoc.AlignLeft = PP.AlignLeft
+ align Pandoc.AlignCenter = PP.AlignCenter
+ align Pandoc.AlignDefault = PP.AlignLeft
+ align Pandoc.AlignRight = PP.AlignRight
+
+prettyBlock (Pandoc.Div _attrs blocks) = prettyBlocks blocks
+
+prettyBlock (Pandoc.DefinitionList terms) =
+ PP.vcat $ map prettyDefinition terms
+ where
+ prettyDefinition (term, definitions) =
+ PP.dullblue (prettyInlines term) <$$> PP.newline <> PP.vcat
+ [ PP.indent
+ (PP.NotTrimmable (PP.dullmagenta ": "))
+ (PP.Trimmable " ") $
+ prettyBlocks (Pandoc.plainToPara definition)
+ | definition <- definitions
+ ]
+
+prettyBlock Pandoc.Null = mempty
+
+
+--------------------------------------------------------------------------------
+prettyBlocks :: [Pandoc.Block] -> PP.Doc
+prettyBlocks = PP.vcat . map prettyBlock
+
+
+--------------------------------------------------------------------------------
+prettyInline :: Pandoc.Inline -> PP.Doc
+
+prettyInline Pandoc.Space = PP.space
+
+prettyInline (Pandoc.Str str) = PP.string str
+
+prettyInline (Pandoc.Emph inlines) =
+ PP.dullgreen $ prettyInlines inlines
+
+prettyInline (Pandoc.Strong inlines) =
+ PP.dullred $ PP.bold $ prettyInlines inlines
+
+prettyInline (Pandoc.Code _ txt) =
+ PP.ondullblack $ PP.dullwhite $ " " <> PP.string txt <> " "
+
+prettyInline link@(Pandoc.Link _attrs text (target, _title))
+ | isReferenceLink link =
+ "[" <> PP.dullcyan (prettyInlines text) <> "]"
+ | otherwise =
+ "<" <> PP.dullcyan (PP.underline $ PP.string target) <> ">"
+
+prettyInline Pandoc.SoftBreak = PP.newline
+
+prettyInline Pandoc.LineBreak = PP.newline
+
+prettyInline (Pandoc.Strikeout t) =
+ "~~" <> PP.ondullred (prettyInlines t) <> "~~"
+
+prettyInline (Pandoc.Quoted Pandoc.SingleQuote t) =
+ "'" <> PP.dullgreen (prettyInlines t) <> "'"
+prettyInline (Pandoc.Quoted Pandoc.DoubleQuote t) =
+ "'" <> PP.dullgreen (prettyInlines t) <> "'"
+
+prettyInline (Pandoc.Math _ t) = PP.dullgreen (PP.string t)
+
+prettyInline (Pandoc.Image _ _ (tit, src)) =
+ "![" <> PP.dullgreen (PP.string tit) <> "](" <>
+ PP.dullcyan (PP.underline (PP.string src)) <> ")"
+
+-- These elements aren't really supported.
+prettyInline (Pandoc.Cite _ t) = prettyInlines t
+prettyInline (Pandoc.Span _ t) = prettyInlines t
+prettyInline (Pandoc.RawInline _ t) = PP.string t
+prettyInline (Pandoc.Note t) = prettyBlocks t
+prettyInline (Pandoc.Superscript t) = prettyInlines t
+prettyInline (Pandoc.Subscript t) = prettyInlines t
+prettyInline (Pandoc.SmallCaps t) = prettyInlines t
+-- prettyInline unsupported = PP.ondullred $ PP.string $ show unsupported
+
+
+--------------------------------------------------------------------------------
+prettyInlines :: [Pandoc.Inline] -> PP.Doc
+prettyInlines = mconcat . map prettyInline
+
+
+--------------------------------------------------------------------------------
+prettyReferences :: Slide -> [PP.Doc]
+prettyReferences =
+ map prettyReference . getReferences . unSlide
+ where
+ getReferences :: [Pandoc.Block] -> [Pandoc.Inline]
+ getReferences = filter isReferenceLink . grecQ
+
+ prettyReference :: Pandoc.Inline -> PP.Doc
+ prettyReference (Pandoc.Link _attrs text (target, title)) =
+ "[" <> PP.dullgreen (prettyInlines $ Pandoc.newlineToSpace text) <>
+ "](" <>
+ PP.dullcyan (PP.underline (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
diff --git a/src/Patat/Presentation/Display/Table.hs b/src/Patat/Presentation/Display/Table.hs
new file mode 100644
index 0000000..181c55a
--- /dev/null
+++ b/src/Patat/Presentation/Display/Table.hs
@@ -0,0 +1,93 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Patat.Presentation.Display.Table
+ ( Table (..)
+ , prettyTable
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Data.List (intersperse, transpose)
+import Data.Monoid (mconcat, mempty, (<>))
+import Patat.PrettyPrint ((<$$>))
+import qualified Patat.PrettyPrint as PP
+import Prelude
+
+
+--------------------------------------------------------------------------------
+data Table = Table
+ { tCaption :: PP.Doc
+ , tAligns :: [PP.Alignment]
+ , tHeaders :: [PP.Doc]
+ , tRows :: [[PP.Doc]]
+ }
+
+
+--------------------------------------------------------------------------------
+prettyTable
+ :: Table -> PP.Doc
+prettyTable Table {..} = PP.indent (PP.Trimmable " ") (PP.Trimmable " ") $
+ lineIf (not isHeaderLess) (hcat2 headerHeight
+ [ PP.dullblue (PP.align w a (vpad headerHeight header))
+ | (w, a, header) <- zip3 columnWidths tAligns tHeaders
+ ]) <>
+ dashedHeaderSeparator 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 columnWidths) <>
+ lineIf
+ (not $ PP.null tCaption) (PP.newline <> "Table: " <> tCaption)
+ where
+ lineIf cond line = if cond then line <> PP.newline 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.newline)
+
+ 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.newline $
+ replicate rowHeight (PP.string " ")
+
+
+--------------------------------------------------------------------------------
+isSimpleCell :: PP.Doc -> Bool
+isSimpleCell = (<= 1) . fst . PP.dimensions
+
+
+--------------------------------------------------------------------------------
+dashedHeaderSeparator :: [Int] -> PP.Doc
+dashedHeaderSeparator columnWidths = mconcat $ intersperse (PP.string " ")
+ [ PP.dullmagenta (PP.string (replicate w '-'))
+ | w <- columnWidths
+ ]
diff --git a/src/Patat/Presentation/Interactive.hs b/src/Patat/Presentation/Interactive.hs
new file mode 100644
index 0000000..2ff5fd5
--- /dev/null
+++ b/src/Patat/Presentation/Interactive.hs
@@ -0,0 +1,100 @@
+--------------------------------------------------------------------------------
+-- | Module that allows the user to interact with the presentation
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Patat.Presentation.Interactive
+ ( PresentationCommand (..)
+ , readPresentationCommand
+
+ , UpdatedPresentation (..)
+ , updatePresentation
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Patat.Presentation.Internal
+import Patat.Presentation.Read
+
+
+--------------------------------------------------------------------------------
+data PresentationCommand
+ = Exit
+ | Forward
+ | Backward
+ | SkipForward
+ | SkipBackward
+ | First
+ | Last
+ | Reload
+
+
+--------------------------------------------------------------------------------
+readPresentationCommand :: IO PresentationCommand
+readPresentationCommand = do
+ k <- readKey
+ case k of
+ "q" -> return Exit
+ "\n" -> return Forward
+ "\DEL" -> return Backward
+ "h" -> return Backward
+ "j" -> return SkipForward
+ "k" -> return SkipBackward
+ "l" -> return Forward
+ "\ESC[C" -> return Forward
+ "\ESC[D" -> return Backward
+ "\ESC[B" -> return SkipForward
+ "\ESC[A" -> return SkipBackward
+ "0" -> return First
+ "G" -> return Last
+ "r" -> return Reload
+ _ -> readPresentationCommand
+ where
+ readKey :: IO String
+ readKey = do
+ c0 <- getChar
+ case c0 of
+ '\ESC' -> do
+ c1 <- getChar
+ case c1 of
+ '[' -> do
+ c2 <- getChar
+ return [c0, c1, c2]
+ _ -> return [c0, c1]
+ _ -> return [c0]
+
+
+--------------------------------------------------------------------------------
+data UpdatedPresentation
+ = UpdatedPresentation !Presentation
+ | ExitedPresentation
+ | ErroredPresentation String
+ deriving (Show)
+
+
+--------------------------------------------------------------------------------
+updatePresentation
+ :: PresentationCommand -> Presentation -> IO UpdatedPresentation
+
+updatePresentation cmd presentation = case cmd of
+ Exit -> return ExitedPresentation
+ Forward -> return $ goToSlide (\x -> x + 1)
+ Backward -> return $ goToSlide (\x -> x - 1)
+ SkipForward -> return $ goToSlide (\x -> x + 10)
+ SkipBackward -> return $ goToSlide (\x -> x - 10)
+ First -> return $ goToSlide (\_ -> 0)
+ Last -> return $ goToSlide (\_ -> numSlides - 1)
+ Reload -> reloadPresentation
+ where
+ numSlides = length (pSlides presentation)
+ clip idx = min (max 0 idx) (numSlides - 1)
+
+ goToSlide f = UpdatedPresentation $
+ presentation {pActiveSlide = clip (f $ pActiveSlide presentation)}
+
+ reloadPresentation = do
+ errOrPres <- readPresentation (pFilePath presentation)
+ return $ case errOrPres of
+ Left err -> ErroredPresentation err
+ Right pres -> UpdatedPresentation $
+ pres {pActiveSlide = clip (pActiveSlide presentation)}
diff --git a/src/Patat/Presentation/Internal.hs b/src/Patat/Presentation/Internal.hs
new file mode 100644
index 0000000..1780db3
--- /dev/null
+++ b/src/Patat/Presentation/Internal.hs
@@ -0,0 +1,27 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Patat.Presentation.Internal
+ ( Presentation (..)
+ , Slide (..)
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Data.Monoid (Monoid)
+import qualified Text.Pandoc as Pandoc
+import Prelude
+
+
+--------------------------------------------------------------------------------
+data Presentation = Presentation
+ { pFilePath :: !FilePath
+ , pTitle :: ![Pandoc.Inline]
+ , pAuthor :: ![Pandoc.Inline]
+ , pSlides :: [Slide]
+ , pActiveSlide :: !Int
+ } deriving (Show)
+
+
+--------------------------------------------------------------------------------
+newtype Slide = Slide {unSlide :: [Pandoc.Block]}
+ deriving (Monoid, Show)
diff --git a/src/Patat/Presentation/Read.hs b/src/Patat/Presentation/Read.hs
new file mode 100644
index 0000000..b74b417
--- /dev/null
+++ b/src/Patat/Presentation/Read.hs
@@ -0,0 +1,80 @@
+-- | Read a presentation from disk.
+{-# LANGUAGE RecordWildCards #-}
+module Patat.Presentation.Read
+ ( readPresentation
+ ) where
+
+
+--------------------------------------------------------------------------------
+import qualified Data.Set as Set
+import Patat.Presentation.Internal
+import System.FilePath (takeExtension)
+import qualified Text.Pandoc as Pandoc
+import qualified Text.Pandoc.Error as Pandoc
+
+
+--------------------------------------------------------------------------------
+readPresentation :: FilePath -> IO (Either String Presentation)
+readPresentation filePath = do
+ src <- readFile filePath
+ return $ do
+ reader <- case readExtension ext of
+ Nothing -> Left $ "Unknown extension: " ++ ext
+ Just r -> Right r
+
+ doc <- case reader src of
+ Left err -> Left $ "Pandoc parsing error: " ++ show err
+ Right x -> Right x
+
+ pandocToPresentation filePath doc
+ where
+ ext = takeExtension filePath
+
+
+--------------------------------------------------------------------------------
+readExtension
+ :: String -> Maybe (String -> Either Pandoc.PandocError Pandoc.Pandoc)
+readExtension fileExt = case fileExt of
+ ".md" -> Just $ Pandoc.readMarkdown Pandoc.def
+ ".lhs" -> Just $ Pandoc.readMarkdown lhsOpts
+ "" -> Just $ Pandoc.readMarkdown Pandoc.def
+ _ -> Nothing
+
+ where
+ lhsOpts = Pandoc.def
+ { Pandoc.readerExtensions = Set.insert Pandoc.Ext_literate_haskell
+ (Pandoc.readerExtensions Pandoc.def)
+ }
+
+
+--------------------------------------------------------------------------------
+pandocToPresentation
+ :: FilePath -> Pandoc.Pandoc -> Either String Presentation
+pandocToPresentation pFilePath pandoc@(Pandoc.Pandoc meta _) = do
+ let pTitle = Pandoc.docTitle meta
+ pSlides = pandocToSlides pandoc
+ pActiveSlide = 0
+ pAuthor = concat (Pandoc.docAuthors meta)
+ return Presentation {..}
+
+
+--------------------------------------------------------------------------------
+-- | 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 h1 headers.
+pandocToSlides :: Pandoc.Pandoc -> [Slide]
+pandocToSlides (Pandoc.Pandoc _meta blocks0)
+ | any (== Pandoc.HorizontalRule) blocks0 = splitAtRules blocks0
+ | otherwise = splitAtH1s blocks0
+ where
+ splitAtRules blocks = case break (== Pandoc.HorizontalRule) blocks of
+ (xs, []) -> [Slide xs]
+ (xs, (_rule : ys)) -> Slide xs : splitAtRules ys
+
+ splitAtH1s [] = []
+ splitAtH1s (b : bs) = case break isH1 bs of
+ (xs, []) -> [Slide (b : xs)]
+ (xs, (y : ys)) -> Slide (b : xs) : splitAtH1s (y : ys)
+
+ isH1 (Pandoc.Header i _ _) = i == 1
+ isH1 _ = False
diff --git a/src/Patat/PrettyPrint.hs b/src/Patat/PrettyPrint.hs
new file mode 100644
index 0000000..59f2c6d
--- /dev/null
+++ b/src/Patat/PrettyPrint.hs
@@ -0,0 +1,386 @@
+--------------------------------------------------------------------------------
+-- | 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
+ , space
+ , newline
+
+ , Trimmable (..)
+ , indent
+
+ , (<+>)
+ , (<$$>)
+ , vcat
+
+ , bold
+ , underline
+
+ , dullblack
+ , dullred
+ , dullgreen
+ , dullyellow
+ , dullblue
+ , dullmagenta
+ , dullcyan
+ , dullwhite
+
+ , ondullblack
+ , ondullred
+
+ -- * Exotic combinators
+ , Alignment (..)
+ , align
+ , paste
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Monad.Reader (asks, local)
+import Control.Monad.RWS (RWS, runRWS)
+import Control.Monad.State (get, modify)
+import Control.Monad.Writer (tell)
+import Data.Foldable (Foldable)
+import qualified Data.List as L
+import Data.Monoid (Monoid, mconcat, mempty, (<>))
+import Data.String (IsString (..))
+import Data.Traversable (Traversable, traverse)
+import qualified System.Console.ANSI as Ansi
+import qualified System.IO as IO
+import Prelude hiding (null)
+
+
+--------------------------------------------------------------------------------
+-- | 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
+ | Space
+ | Newline
+ | Ansi
+ { ansiCode :: [Ansi.SGR] -> [Ansi.SGR] -- ^ Modifies current codes.
+ , ansiDoc :: Doc
+ }
+ | Indent
+ { indentFirstLine :: LineBuffer
+ , indentOtherLines :: LineBuffer
+ , indentDoc :: Doc
+ }
+
+
+--------------------------------------------------------------------------------
+chunkToDocE :: Chunk -> DocE
+chunkToDocE NewlineChunk = Newline
+chunkToDocE (StringChunk codes str) = Ansi (\_ -> codes) (Doc [String str])
+
+
+--------------------------------------------------------------------------------
+newtype Doc = Doc {unDoc :: [DocE]}
+ deriving (Monoid)
+
+
+--------------------------------------------------------------------------------
+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
+ }
+
+
+--------------------------------------------------------------------------------
+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 [] []
+ ((), 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 (Space : docs) = do
+ chunk <- makeChunk " "
+ modify (NotTrimmable chunk :)
+ go docs
+
+ go (Newline : docs) = do
+ buffer <- get
+ tell $ bufferToChunks buffer <> [NewlineChunk]
+ indentation <- asks deIndent
+ modify $ \_ -> if L.null docs then [] else indentation
+ 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
+
+
+--------------------------------------------------------------------------------
+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
+
+
+--------------------------------------------------------------------------------
+space :: Doc
+space = mkDoc Space
+
+
+--------------------------------------------------------------------------------
+newline :: Doc
+newline = mkDoc Newline
+
+
+--------------------------------------------------------------------------------
+indent :: Trimmable Doc -> Trimmable Doc -> Doc -> Doc
+indent firstLineDoc otherLinesDoc doc = mkDoc $ Indent
+ { indentFirstLine = traverse docToChunks firstLineDoc
+ , indentOtherLines = traverse docToChunks otherLinesDoc
+ , indentDoc = doc
+ }
+
+
+--------------------------------------------------------------------------------
+(<+>) :: Doc -> Doc -> Doc
+x <+> y = x <> space <> y
+infixr 6 <+>
+
+
+--------------------------------------------------------------------------------
+(<$$>) :: Doc -> Doc -> Doc
+x <$$> y = x <> newline <> y
+infixr 5 <$$>
+
+
+--------------------------------------------------------------------------------
+vcat :: [Doc] -> Doc
+vcat = mconcat . L.intersperse newline
+
+
+--------------------------------------------------------------------------------
+bold :: Doc -> Doc
+bold = mkDoc . Ansi
+ (\codes -> Ansi.SetConsoleIntensity Ansi.BoldIntensity : codes)
+
+
+--------------------------------------------------------------------------------
+underline :: Doc -> Doc
+underline = mkDoc . Ansi
+ (\codes -> Ansi.SetUnderlining Ansi.SingleUnderline : codes)
+
+
+--------------------------------------------------------------------------------
+dullcolor :: Ansi.Color -> Doc -> Doc
+dullcolor c = mkDoc . Ansi
+ (\codes -> Ansi.SetColor Ansi.Foreground Ansi.Dull c : codes)
+
+
+--------------------------------------------------------------------------------
+dullblack, dullred, dullgreen, dullyellow, dullblue, dullmagenta, dullcyan,
+ dullwhite :: Doc -> Doc
+dullblack = dullcolor Ansi.Black
+dullred = dullcolor Ansi.Red
+dullgreen = dullcolor Ansi.Green
+dullyellow = dullcolor Ansi.Yellow
+dullblue = dullcolor Ansi.Blue
+dullmagenta = dullcolor Ansi.Magenta
+dullcyan = dullcolor Ansi.Cyan
+dullwhite = dullcolor Ansi.White
+
+
+--------------------------------------------------------------------------------
+ondullcolor :: Ansi.Color -> Doc -> Doc
+ondullcolor c = mkDoc . Ansi
+ (\codes -> Ansi.SetColor Ansi.Background Ansi.Dull c : codes)
+
+
+--------------------------------------------------------------------------------
+ondullblack :: Doc -> Doc
+ondullblack = ondullcolor Ansi.Black
+
+
+--------------------------------------------------------------------------------
+ondullred :: Doc -> Doc
+ondullred = ondullcolor Ansi.Red
+
+
+--------------------------------------------------------------------------------
+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
+ spaces n = [StringChunk [] (replicate n ' ')] in
+ case alignment of
+ AlignLeft -> line <> spaces (width - actual)
+ AlignRight -> spaces (width - actual) <> line
+ AlignCenter ->
+ let r = (width - actual) `div` 2
+ l = (width - actual) - r in
+ spaces l <> line <> spaces 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
diff --git a/src/Text/Pandoc/Extended.hs b/src/Text/Pandoc/Extended.hs
new file mode 100644
index 0000000..eb01245
--- /dev/null
+++ b/src/Text/Pandoc/Extended.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE LambdaCase #-}
+module Text.Pandoc.Extended
+ ( module Text.Pandoc
+
+ , plainToPara
+ , newlineToSpace
+ ) where
+
+import Text.Pandoc
+import Data.Data.Extended (grecT)
+
+plainToPara :: [Block] -> [Block]
+plainToPara = map $ \case
+ Plain inlines -> Para inlines
+ block -> block
+
+newlineToSpace :: [Inline] -> [Inline]
+newlineToSpace = grecT $ \case
+ SoftBreak -> Space
+ LineBreak -> Space
+ inline -> inline