patat 0.5.2.2 → 0.6.0.0
raw patch · 7 files changed
+319/−46 lines, 7 filesdep ~basedep ~pandocdep ~skylightingnew-component:exe:patat-make-man
Dependency ranges changed: base, pandoc, skylighting, time
Files
- CHANGELOG.md +4/−0
- README.md +43/−4
- extra/make-man.hs +127/−0
- patat.cabal +42/−18
- src/Main.hs +1/−1
- src/Patat/Presentation/Internal.hs +68/−2
- src/Patat/Presentation/Read.hs +34/−21
CHANGELOG.md view
@@ -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
README.md view
@@ -1,7 +1,7 @@ patat ===== -[](https://travis-ci.org/jaspervdj/patat) [](https://hackage.haskell.org/package/patat) []()+[](https://circleci.com/gh/jaspervdj/patat) [](https://hackage.haskell.org/package/patat) []() `patat` (**P**resentations **A**top **T**he **A**NSI **T**erminal) is a small tool that allows you to show presentations using only an ANSI terminal. It does@@ -46,6 +46,7 @@ - [Fragmented slides](#fragmented-slides) - [Theming](#theming) - [Syntax Highlighting](#syntax-highlighting)+ - [Pandoc Extensions](#pandoc-extensions) - [Trivia](#trivia) Installation@@ -53,9 +54,9 @@ ### 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 @@ -406,6 +407,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 ------
+ extra/make-man.hs view
@@ -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."
patat.cabal view
@@ -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 @@ 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 @@ 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 @@ 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
src/Main.hs view
@@ -178,7 +178,7 @@ 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
src/Patat/Presentation/Internal.hs view
@@ -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 @@ 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 @@ , psIncrementalLists :: !(Maybe Bool) , psAutoAdvanceDelay :: !(Maybe (A.FlexibleNum Int)) , psSlideLevel :: !(Maybe Int)+ , psPandocExtensions :: !(Maybe ExtensionList) } deriving (Show) @@ -57,6 +67,7 @@ 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 @@ , 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 @@ , 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 @@ ---------------------------------------------------------------------------------$(A.deriveJSON A.dropPrefixOptions ''PresentationSettings)+$(A.deriveFromJSON A.dropPrefixOptions ''PresentationSettings)
src/Patat/Presentation/Read.hs view
@@ -16,9 +16,9 @@ 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 @@ -------------------------------------------------------------------------------- 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,21 +53,31 @@ -------------------------------------------------------------------------------- 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 :: FilePath -> PresentationSettings -> Pandoc.Pandoc@@ -83,21 +95,22 @@ -- 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