diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /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 --- /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. + + + 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /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 --- /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 +Maintainer: Jasper Van der Jeugt +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 --- /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 --- /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 --- /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 --- /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 --- /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 --- /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 --- /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 --- /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 --- /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 --- /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