summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasperVanDerJeugt <>2017-12-19 17:45:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-12-19 17:45:00 (GMT)
commit53b5b5d06c810d8572795cec8000bfcb84e598be (patch)
treeaa87f66ed31e154c1449be6bfa95e743707a1eba
parentc124879a16c7f44612ac3d0080b27d4ae2694fbc (diff)
version 0.6.0.00.6.0.0
-rw-r--r--CHANGELOG.md4
-rw-r--r--README.md47
-rw-r--r--extra/make-man.hs127
-rw-r--r--patat.cabal60
-rw-r--r--src/Main.hs2
-rw-r--r--src/Patat/Presentation/Internal.hs70
-rw-r--r--src/Patat/Presentation/Read.hs55
7 files changed, 319 insertions, 46 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index aac2a95..237212f 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,9 @@
# Changelog
+- 0.6.0.0 (2017-12-19)
+ * Make pandoc extensions customizable in the configuration
+ * Bump `pandoc` to 2.0
+
- 0.5.2.2 (2017-06-14)
* Add `network-uri` dependency to fix travis build
diff --git a/README.md b/README.md
index 2b6f7f3..1bd10ae 100644
--- a/README.md
+++ b/README.md
@@ -1,7 +1,7 @@
patat
=====
-[![Build Status](https://img.shields.io/travis/jaspervdj/patat.svg)](https://travis-ci.org/jaspervdj/patat) [![Hackage](https://img.shields.io/hackage/v/patat.svg)](https://hackage.haskell.org/package/patat) [![GitHub tag](https://img.shields.io/github/tag/jaspervdj/patat.svg)]()
+[![Build Status](https://img.shields.io/circleci/project/github/jaspervdj/patat.svg)](https://circleci.com/gh/jaspervdj/patat) [![Hackage](https://img.shields.io/hackage/v/patat.svg)](https://hackage.haskell.org/package/patat) [![GitHub tag](https://img.shields.io/github/tag/jaspervdj/patat.svg)]()
`patat` (**P**resentations **A**top **T**he **A**NSI **T**erminal) is a small
tool that allows you to show presentations using only an ANSI terminal. It does
@@ -46,6 +46,7 @@ Table of Contents
- [Fragmented slides](#fragmented-slides)
- [Theming](#theming)
- [Syntax Highlighting](#syntax-highlighting)
+ - [Pandoc Extensions](#pandoc-extensions)
- [Trivia](#trivia)
Installation
@@ -53,9 +54,9 @@ Installation
### Pre-built-packages
-There is a pre-built package available for Debian:
-
-- <https://packages.debian.org/unstable/patat>
+- Debian: <https://packages.debian.org/unstable/patat>
+- Ubuntu: <https://packages.ubuntu.com/artful/patat>
+- openSUSE: <https://build.opensuse.org/package/show/openSUSE:Factory:ARM/patat>
### From source
@@ -407,6 +408,44 @@ an obvious way.
[this list]: https://hackage.haskell.org/package/highlighting-kate-0.6.3/docs/Text-Highlighting-Kate-Types.html#t:TokenType
+### Pandoc Extensions
+
+Pandoc comes with a fair number of extensions on top of markdown:
+
+ <https://hackage.haskell.org/package/pandoc-2.0.5/docs/Text-Pandoc-Extensions.html>
+
+`patat` enables a number of them by default, but this is also customizable.
+
+In order to enable an additional extensions, e.g. `autolink_bare_uris`, add it
+to the `pandocExtensions` field in the YAML metadata:
+
+ ---
+ patat:
+ pandocExtensions:
+ - patat_extensions
+ - autolink_bare_uris
+ ...
+
+ Document content...
+
+The `patat_extensions` in the above snippet refers to the default set of
+extensions enabled by `patat`. If you want to disable those and only use a
+select few extensions, simply leave it out and choose your own:
+
+ ---
+ patat:
+ pandocExtensions:
+ - autolink_bare_uris
+ - emoji
+ ...
+
+ ...
+
+ Document content...
+
+If you don't want to enable any extensions, simply set `pandocExtensions` to the
+empty list `[]`.
+
Trivia
------
diff --git a/extra/make-man.hs b/extra/make-man.hs
new file mode 100644
index 0000000..58cb00d
--- /dev/null
+++ b/extra/make-man.hs
@@ -0,0 +1,127 @@
+-- | This script generates a man page for patat.
+{-# LANGUAGE OverloadedStrings #-}
+import Control.Applicative ((<$>))
+import Control.Exception (throw)
+import Control.Monad (guard)
+import Control.Monad.Trans (liftIO)
+import Data.Char (isSpace, toLower)
+import Data.List (isPrefixOf)
+import Data.Maybe (isJust)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import qualified GHC.IO.Encoding as Encoding
+import Prelude
+import System.Environment (getEnv)
+import qualified System.IO as IO
+import qualified Data.Time as Time
+import qualified Text.Pandoc as Pandoc
+
+getVersion :: IO String
+getVersion =
+ dropWhile isSpace . drop 1 . dropWhile (/= ':') . head .
+ filter (\l -> "version:" `isPrefixOf` map toLower l) .
+ map (dropWhile isSpace) . lines <$> readFile "patat.cabal"
+
+getPrettySourceDate :: IO String
+getPrettySourceDate = do
+ epoch <- getEnv "SOURCE_DATE_EPOCH"
+ utc <- Time.parseTimeM True locale "%s" epoch :: IO Time.UTCTime
+ return $ Time.formatTime locale "%B %d, %Y" utc
+ where
+ locale = Time.defaultTimeLocale
+
+removeLinks :: Pandoc.Pandoc -> Pandoc.Pandoc
+removeLinks = Pandoc.bottomUp $ \inline -> case inline of
+ Pandoc.Link _ inlines _ -> Pandoc.Emph inlines
+ _ -> inline
+
+type Sections = [(Int, T.Text, [Pandoc.Block])]
+
+toSections :: Int -> [Pandoc.Block] -> Sections
+toSections level = go
+ where
+ go [] = []
+ go (h : xs) = case toSectionHeader h of
+ Nothing -> go xs
+ Just (l, title) ->
+ let (section, cont) = break (isJust . toSectionHeader) xs in
+ (l, title, section) : go cont
+
+ toSectionHeader :: Pandoc.Block -> Maybe (Int, T.Text)
+ toSectionHeader (Pandoc.Header l _ inlines) = do
+ guard (l <= level)
+ let doc = Pandoc.Pandoc Pandoc.nullMeta [Pandoc.Plain inlines]
+ txt = case Pandoc.runPure (Pandoc.writeMarkdown Pandoc.def doc) of
+ Left err -> throw err -- Bad!
+ Right x -> x
+ return (l, txt)
+ toSectionHeader _ = Nothing
+
+fromSections :: Sections -> [Pandoc.Block]
+fromSections = concatMap $ \(level, title, blocks) ->
+ Pandoc.Header level ("", [], []) [Pandoc.Str $ T.unpack title] : blocks
+
+reorganizeSections :: Pandoc.Pandoc -> Pandoc.Pandoc
+reorganizeSections (Pandoc.Pandoc meta0 blocks0) =
+ let sections0 = toSections 2 blocks0 in
+ Pandoc.Pandoc meta0 $ fromSections $
+ [ (1, "NAME", nameSection)
+ ] ++
+ [ (1, "SYNOPSIS", s)
+ | (_, _, s) <- lookupSection "Running" sections0
+ ] ++
+ [ (1, "DESCRIPTION", [])
+ ] ++
+ [ (2, n, s)
+ | (_, n, s) <- lookupSection "Controls" sections0
+ ] ++
+ [ (2, n, s)
+ | (_, n, s) <- lookupSection "Input format" sections0
+ ] ++
+ [ (2, n, s)
+ | (_, n, s) <- lookupSection "Configuration" sections0
+ ] ++
+ [ (1, "OPTIONS", s)
+ | (_, _, s) <- lookupSection "Options" sections0
+ ] ++
+ [ (1, "SEE ALSO", seeAlsoSection)
+ ]
+ where
+ nameSection = mkPara "patat - Presentations Atop The ANSI Terminal"
+ seeAlsoSection = mkPara "pandoc(1)"
+ mkPara str = [Pandoc.Para [Pandoc.Str str]]
+
+ lookupSection name sections =
+ [section | section@(_, n, _) <- sections, name == n]
+
+main :: IO ()
+main = Pandoc.runIOorExplode $ do
+ liftIO $ Encoding.setLocaleEncoding Encoding.utf8
+
+ let readerOptions = Pandoc.def
+ { Pandoc.readerExtensions = Pandoc.pandocExtensions
+ }
+
+ source <- liftIO $ T.readFile "README.md"
+ pandoc0 <- Pandoc.readMarkdown readerOptions source
+ template <- Pandoc.getDefaultTemplate "man"
+
+ version <- liftIO getVersion
+ date <- liftIO getPrettySourceDate
+
+ let writerOptions = Pandoc.def
+ { Pandoc.writerTemplate = Just template
+ , Pandoc.writerVariables =
+ [ ("author", "Jasper Van der Jeugt")
+ , ("title", "patat manual")
+ , ("date", date)
+ , ("footer", "patat v" ++ version)
+ , ("section", "1")
+ ]
+ }
+
+ let pandoc1 = reorganizeSections $ removeLinks pandoc0
+ txt <- Pandoc.writeMan writerOptions pandoc1
+ liftIO $ do
+ T.putStr txt
+ IO.hPutStrLn IO.stderr "Wrote man page."
diff --git a/patat.cabal b/patat.cabal
index 5422b1a..dc67ccd 100644
--- a/patat.cabal
+++ b/patat.cabal
@@ -1,5 +1,5 @@
Name: patat
-Version: 0.5.2.2
+Version: 0.6.0.0
Synopsis: Terminal-based presentations using Pandoc
Description: Terminal-based presentations using Pandoc
License: GPL-2
@@ -20,6 +20,11 @@ Source-repository head
Type: git
Location: git://github.com/jaspervdj/patat.git
+Flag patat-make-man
+ Description: Build the executable to generate the man page
+ Default: False
+ Manual: True
+
Executable patat
Main-is: Main.hs
Ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N"
@@ -27,23 +32,23 @@ Executable patat
Default-language: Haskell2010
Build-depends:
- aeson >= 0.9 && < 1.3,
- ansi-terminal >= 0.6 && < 0.7,
- ansi-wl-pprint >= 0.6 && < 0.7,
- base >= 4.6 && < 4.10,
- bytestring >= 0.10 && < 0.11,
- containers >= 0.5 && < 0.6,
- directory >= 1.2 && < 1.4,
- filepath >= 1.4 && < 1.5,
- mtl >= 2.2 && < 2.3,
- optparse-applicative >= 0.12 && < 0.15,
- pandoc >= 1.16 && < 1.20,
- skylighting >= 0.1 && < 0.4,
- terminal-size >= 0.3 && < 0.4,
- text >= 1.2 && < 1.3,
- time >= 1.4 && < 1.8,
- unordered-containers >= 0.2 && < 0.3,
- yaml >= 0.7 && < 0.9,
+ aeson >= 0.9 && < 1.3,
+ ansi-terminal >= 0.6 && < 0.7,
+ ansi-wl-pprint >= 0.6 && < 0.7,
+ base >= 4.6 && < 4.11,
+ bytestring >= 0.10 && < 0.11,
+ containers >= 0.5 && < 0.6,
+ directory >= 1.2 && < 1.4,
+ filepath >= 1.4 && < 1.5,
+ mtl >= 2.2 && < 2.3,
+ optparse-applicative >= 0.12 && < 0.15,
+ pandoc >= 2.0.4 && < 2.1,
+ skylighting >= 0.1 && < 0.6,
+ terminal-size >= 0.3 && < 0.4,
+ text >= 1.2 && < 1.3,
+ time >= 1.4 && < 1.9,
+ unordered-containers >= 0.2 && < 0.3,
+ yaml >= 0.7 && < 0.9,
-- We don't even depend on these packages but they can break cabal install
-- because of the conflicting 'Network.URI' module.
network-uri >= 2.6,
@@ -64,4 +69,23 @@ Executable patat
Patat.Presentation.Read
Patat.PrettyPrint
Patat.Theme
+ Paths_patat
Text.Pandoc.Extended
+
+Executable patat-make-man
+ Main-is: make-man.hs
+ Ghc-options: -Wall
+ Hs-source-dirs: extra
+ Default-language: Haskell2010
+
+ If flag(patat-make-man)
+ Buildable: True
+ Else
+ Buildable: False
+
+ Build-depends:
+ base >= 4.6 && < 4.11,
+ mtl >= 2.2 && < 2.3,
+ pandoc >= 2.0 && < 2.1,
+ text >= 1.2 && < 1.3,
+ time >= 1.6 && < 1.9
diff --git a/src/Main.hs b/src/Main.hs
index 2073453..3ba00c6 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -178,7 +178,7 @@ main = do
watcher :: Chan.Chan PresentationCommand -> FilePath -> UTCTime -> IO a
watcher chan filePath mtime0 = do
-- The extra exists check helps because some editors temporarily make the
- -- file dissapear while writing.
+ -- file disappear while writing.
exists <- doesFileExist filePath
mtime1 <- if exists then getModificationTime filePath else return mtime0
diff --git a/src/Patat/Presentation/Internal.hs b/src/Patat/Presentation/Internal.hs
index c253f13..3ed7ac0 100644
--- a/src/Patat/Presentation/Internal.hs
+++ b/src/Patat/Presentation/Internal.hs
@@ -1,10 +1,15 @@
--------------------------------------------------------------------------------
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Patat.Presentation.Internal
( Presentation (..)
, PresentationSettings (..)
, defaultPresentationSettings
+
+ , ExtensionList (..)
+ , defaultExtensionList
+
, Slide (..)
, Fragment (..)
, Index
@@ -21,11 +26,15 @@ module Patat.Presentation.Internal
import Control.Monad (mplus)
import qualified Data.Aeson.Extended as A
import qualified Data.Aeson.TH.Extended as A
+import qualified Data.Foldable as Foldable
+import Data.List (intercalate)
import Data.Maybe (listToMaybe)
import Data.Monoid (Monoid (..), (<>))
+import qualified Data.Text as T
import qualified Patat.Theme as Theme
-import qualified Text.Pandoc as Pandoc
import Prelude
+import qualified Text.Pandoc as Pandoc
+import Text.Read (readMaybe)
--------------------------------------------------------------------------------
@@ -50,6 +59,7 @@ data PresentationSettings = PresentationSettings
, psIncrementalLists :: !(Maybe Bool)
, psAutoAdvanceDelay :: !(Maybe (A.FlexibleNum Int))
, psSlideLevel :: !(Maybe Int)
+ , psPandocExtensions :: !(Maybe ExtensionList)
} deriving (Show)
@@ -57,6 +67,7 @@ data PresentationSettings = PresentationSettings
instance Monoid PresentationSettings where
mempty = PresentationSettings
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+ Nothing
mappend l r = PresentationSettings
{ psRows = psRows l `mplus` psRows r
, psColumns = psColumns l `mplus` psColumns r
@@ -65,6 +76,7 @@ instance Monoid PresentationSettings where
, psIncrementalLists = psIncrementalLists l `mplus` psIncrementalLists r
, psAutoAdvanceDelay = psAutoAdvanceDelay l `mplus` psAutoAdvanceDelay r
, psSlideLevel = psSlideLevel l `mplus` psSlideLevel r
+ , psPandocExtensions = psPandocExtensions l `mplus` psPandocExtensions r
}
@@ -78,10 +90,64 @@ defaultPresentationSettings = PresentationSettings
, psIncrementalLists = Nothing
, psAutoAdvanceDelay = Nothing
, psSlideLevel = Nothing
+ , psPandocExtensions = Nothing
}
--------------------------------------------------------------------------------
+newtype ExtensionList = ExtensionList {unExtensionList :: Pandoc.Extensions}
+ deriving (Show)
+
+
+--------------------------------------------------------------------------------
+instance A.FromJSON ExtensionList where
+ parseJSON = A.withArray "FromJSON ExtensionList" $
+ fmap (ExtensionList . mconcat) . mapM parseExt . Foldable.toList
+ where
+ parseExt = A.withText "FromJSON ExtensionList" $ \txt -> case txt of
+ -- Our default extensions
+ "patat_extensions" -> return (unExtensionList defaultExtensionList)
+
+ -- Individuals
+ _ -> case readMaybe ("Ext_" ++ T.unpack txt) of
+ Just e -> return $ Pandoc.extensionsFromList [e]
+ Nothing -> fail $
+ "Unknown extension: " ++ show txt ++
+ ", known extensions are: " ++
+ intercalate ", "
+ [ show (drop 4 (show e))
+ | e <- [minBound .. maxBound] :: [Pandoc.Extension]
+ ]
+
+
+--------------------------------------------------------------------------------
+defaultExtensionList :: ExtensionList
+defaultExtensionList = ExtensionList $
+ Pandoc.readerExtensions Pandoc.def <> Pandoc.extensionsFromList
+ [ Pandoc.Ext_yaml_metadata_block
+ , Pandoc.Ext_table_captions
+ , Pandoc.Ext_simple_tables
+ , Pandoc.Ext_multiline_tables
+ , Pandoc.Ext_grid_tables
+ , Pandoc.Ext_pipe_tables
+ , Pandoc.Ext_raw_html
+ , Pandoc.Ext_tex_math_dollars
+ , Pandoc.Ext_fenced_code_blocks
+ , Pandoc.Ext_fenced_code_attributes
+ , Pandoc.Ext_backtick_code_blocks
+ , Pandoc.Ext_inline_code_attributes
+ , Pandoc.Ext_fancy_lists
+ , Pandoc.Ext_four_space_rule
+ , Pandoc.Ext_definition_lists
+ , Pandoc.Ext_compact_definition_lists
+ , Pandoc.Ext_example_lists
+ , Pandoc.Ext_strikeout
+ , Pandoc.Ext_superscript
+ , Pandoc.Ext_subscript
+ ]
+
+
+--------------------------------------------------------------------------------
data Slide
= ContentSlide [Fragment]
| TitleSlide Pandoc.Block
@@ -126,4 +192,4 @@ getActiveFragment presentation = do
--------------------------------------------------------------------------------
-$(A.deriveJSON A.dropPrefixOptions ''PresentationSettings)
+$(A.deriveFromJSON A.dropPrefixOptions ''PresentationSettings)
diff --git a/src/Patat/Presentation/Read.hs b/src/Patat/Presentation/Read.hs
index 92bce07..07bc72e 100644
--- a/src/Patat/Presentation/Read.hs
+++ b/src/Patat/Presentation/Read.hs
@@ -16,9 +16,9 @@ import qualified Data.ByteString as B
import qualified Data.HashMap.Strict as HMS
import Data.Maybe (fromMaybe)
import Data.Monoid (mempty, (<>))
-import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
+import qualified Data.Text.IO as T
import qualified Data.Yaml as Yaml
import Patat.Presentation.Fragment
import Patat.Presentation.Internal
@@ -32,18 +32,20 @@ import qualified Text.Pandoc.Extended as Pandoc
--------------------------------------------------------------------------------
readPresentation :: FilePath -> IO (Either String Presentation)
readPresentation filePath = runExceptT $ do
- src <- liftIO $ readFile filePath
- reader <- case readExtension ext of
+ -- We need to read the settings first.
+ src <- liftIO $ T.readFile filePath
+ homeSettings <- ExceptT readHomeSettings
+ metaSettings <- ExceptT $ return $ readMetaSettings src
+ let settings = metaSettings <> homeSettings <> defaultPresentationSettings
+
+ let pexts = fromMaybe defaultExtensionList (psPandocExtensions settings)
+ reader <- case readExtension pexts ext of
Nothing -> throwError $ "Unknown file extension: " ++ show ext
Just x -> return x
doc <- case reader src of
Left e -> throwError $ "Could not parse document: " ++ show e
Right x -> return x
- homeSettings <- ExceptT readHomeSettings
- metaSettings <- ExceptT $ return $ readMetaSettings src
- let settings = metaSettings <> homeSettings <> defaultPresentationSettings
-
ExceptT $ return $ pandocToPresentation filePath settings doc
where
ext = takeExtension filePath
@@ -51,20 +53,30 @@ readPresentation filePath = runExceptT $ do
--------------------------------------------------------------------------------
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
- ".org" -> Just $ Pandoc.readOrg Pandoc.def
+ :: ExtensionList -> String
+ -> Maybe (T.Text -> Either Pandoc.PandocError Pandoc.Pandoc)
+readExtension (ExtensionList extensions) fileExt = case fileExt of
+ ".md" -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts
+ ".lhs" -> Just $ Pandoc.runPure . Pandoc.readMarkdown lhsOpts
+ "" -> Just $ Pandoc.runPure . Pandoc.readMarkdown readerOpts
+ ".org" -> Just $ Pandoc.runPure . Pandoc.readOrg readerOpts
_ -> Nothing
where
- lhsOpts = Pandoc.def
- { Pandoc.readerExtensions = Set.insert Pandoc.Ext_literate_haskell
- (Pandoc.readerExtensions Pandoc.def)
+ readerOpts = Pandoc.def
+ { Pandoc.readerExtensions =
+ extensions <> absolutelyRequiredExtensions
}
+ lhsOpts = readerOpts
+ { Pandoc.readerExtensions =
+ Pandoc.readerExtensions readerOpts <>
+ Pandoc.extensionsFromList [Pandoc.Ext_literate_haskell]
+ }
+
+ absolutelyRequiredExtensions =
+ Pandoc.extensionsFromList [Pandoc.Ext_yaml_metadata_block]
+
--------------------------------------------------------------------------------
pandocToPresentation
@@ -83,21 +95,22 @@ pandocToPresentation pFilePath pSettings pandoc@(Pandoc.Pandoc meta _) = do
-- avoids the problems caused by pandoc involving rendering Markdown. This
-- should only be used for settings though, not things like title / authors
-- since those /can/ contain markdown.
-parseMetadataBlock :: String -> Maybe A.Value
+parseMetadataBlock :: T.Text -> Maybe A.Value
parseMetadataBlock src = do
block <- mbBlock
- Yaml.decode $! T.encodeUtf8 $! T.pack block
+ Yaml.decode $! T.encodeUtf8 block
where
- mbBlock = case lines src of
+ mbBlock :: Maybe T.Text
+ mbBlock = case T.lines src of
("---" : ls) -> case break (`elem` ["---", "..."]) ls of
(_, []) -> Nothing
- (block, (_ : _)) -> Just (unlines block)
+ (block, (_ : _)) -> Just (T.unlines block)
_ -> Nothing
--------------------------------------------------------------------------------
-- | Read settings from the metadata block in the Pandoc document.
-readMetaSettings :: String -> Either String PresentationSettings
+readMetaSettings :: T.Text -> Either String PresentationSettings
readMetaSettings src = fromMaybe (Right mempty) $ do
A.Object obj <- parseMetadataBlock src
val <- HMS.lookup "patat" obj