summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasperVanDerJeugt <>2017-01-20 13:09:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-01-20 13:09:00 (GMT)
commit51f923366b8619860240a51e7a0dc3e5160d88c2 (patch)
tree711212f897b6c69219003eddafcb194393a13341
parentd4ae9e9a6f710b785a9783a06fa42a4e66b6e42b (diff)
version 0.4.7.00.4.7.0
-rw-r--r--CHANGELOG.md5
-rw-r--r--patat.cabal5
-rw-r--r--src/Patat/Presentation/Read.hs40
-rw-r--r--src/Text/Pandoc/Extended.hs20
4 files changed, 39 insertions, 31 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index be9ad13..925a3c2 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,10 @@
# Changelog
+- 0.4.7.0 (2017-01-20)
+ * Bump `aeson-1.1` dependency
+ * Parse YAML for settings using `yaml` instead of pandoc
+ * Clarify watch & autoAdvance combination in documentation.
+
- 0.4.6.0 (2016-12-28)
* Redraw the screen on unknown commands to prevent accidental typing from
showing up.
diff --git a/patat.cabal b/patat.cabal
index fa1625b..3fe007b 100644
--- a/patat.cabal
+++ b/patat.cabal
@@ -1,5 +1,5 @@
Name: patat
-Version: 0.4.6.0
+Version: 0.4.7.0
Synopsis: Terminal-based presentations using Pandoc
Description: Terminal-based presentations using Pandoc
License: GPL-2
@@ -24,7 +24,7 @@ Executable patat
Default-language: Haskell2010
Build-depends:
- aeson >= 0.9 && < 1.1,
+ aeson >= 0.9 && < 1.2,
ansi-terminal >= 0.6 && < 0.7,
ansi-wl-pprint >= 0.6 && < 0.7,
base >= 4.6 && < 4.10,
@@ -39,6 +39,7 @@ Executable patat
terminal-size >= 0.3 && < 0.4,
text >= 1.2 && < 1.3,
time >= 1.4 && < 1.7,
+ unordered-containers >= 0.2 && < 0.3,
yaml >= 0.7 && < 0.9
Other-modules:
diff --git a/src/Patat/Presentation/Read.hs b/src/Patat/Presentation/Read.hs
index e345368..19d357d 100644
--- a/src/Patat/Presentation/Read.hs
+++ b/src/Patat/Presentation/Read.hs
@@ -1,6 +1,7 @@
-- | Read a presentation from disk.
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
module Patat.Presentation.Read
( readPresentation
) where
@@ -12,17 +13,20 @@ import Control.Monad.Except (ExceptT (..), runExceptT,
import Control.Monad.Trans (liftIO)
import qualified Data.Aeson as A
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.Yaml as Yaml
import Patat.Presentation.Fragment
import Patat.Presentation.Internal
+import Prelude
import System.Directory (doesFileExist, getHomeDirectory)
import System.FilePath (takeExtension, (</>))
import qualified Text.Pandoc.Error as Pandoc
import qualified Text.Pandoc.Extended as Pandoc
-import Prelude
--------------------------------------------------------------------------------
@@ -32,12 +36,12 @@ readPresentation filePath = runExceptT $ do
reader <- case readExtension ext of
Nothing -> throwError $ "Unknown file extension: " ++ show ext
Just x -> return x
- doc@(Pandoc.Pandoc meta _) <- case reader src of
+ 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 meta
+ metaSettings <- ExceptT $ return $ readMetaSettings src
let settings = metaSettings <> homeSettings <> defaultPresentationSettings
ExceptT $ return $ pandocToPresentation filePath settings doc
@@ -75,11 +79,29 @@ pandocToPresentation pFilePath pSettings pandoc@(Pandoc.Pandoc meta _) = do
--------------------------------------------------------------------------------
+-- | This re-parses the pandoc metadata block using the YAML library. This
+-- avoids the problems caused by pandoc involving rendering Markdown. This
+-- should only be used for settings though, not things like title / authors
+-- since those /can/ contain markdown.
+parseMetadataBlock :: String -> Maybe A.Value
+parseMetadataBlock src = do
+ block <- mbBlock
+ Yaml.decode $! T.encodeUtf8 $! T.pack block
+ where
+ mbBlock = case lines src of
+ ("---" : ls) -> case break (`elem` ["---", "..."]) ls of
+ (_, []) -> Nothing
+ (block, (_ : _)) -> Just (unlines block)
+ _ -> Nothing
+
+
+--------------------------------------------------------------------------------
-- | Read settings from the metadata block in the Pandoc document.
-readMetaSettings :: Pandoc.Meta -> Either String PresentationSettings
-readMetaSettings meta = case Pandoc.lookupMeta "patat" meta of
- Nothing -> return mempty
- Just val -> resultToEither $! A.fromJSON $! Pandoc.metaToJson val
+readMetaSettings :: String -> Either String PresentationSettings
+readMetaSettings src = fromMaybe (Right mempty) $ do
+ A.Object obj <- parseMetadataBlock src
+ val <- HMS.lookup "patat" obj
+ return $! resultToEither $! A.fromJSON val
where
resultToEither :: A.Result a -> Either String a
resultToEither (A.Success x) = Right x
diff --git a/src/Text/Pandoc/Extended.hs b/src/Text/Pandoc/Extended.hs
index ab139a9..941d716 100644
--- a/src/Text/Pandoc/Extended.hs
+++ b/src/Text/Pandoc/Extended.hs
@@ -6,15 +6,11 @@ module Text.Pandoc.Extended
, plainToPara
, newlineToSpace
- , metaToJson
) where
--------------------------------------------------------------------------------
-import qualified Data.Aeson as A
import Data.Data.Extended (grecT)
-import qualified Data.Map as M
-import Data.Monoid (mempty)
import Text.Pandoc
import Prelude
@@ -32,19 +28,3 @@ newlineToSpace = grecT $ \case
SoftBreak -> Space
LineBreak -> Space
inline -> inline
-
-
---------------------------------------------------------------------------------
--- | Convert Pandoc's internal metadata value format to JSON. This makes
--- parsing some things a bit easier.
-metaToJson :: MetaValue -> A.Value
-metaToJson (MetaMap m) = A.toJSON $! M.map metaToJson m
-metaToJson (MetaList l) = A.toJSON $! map metaToJson l
-metaToJson (MetaBool b) = A.toJSON b
-metaToJson (MetaString s) = A.toJSON s
-metaToJson (MetaInlines i) =
- let !t = writeMarkdown def (Pandoc mempty [Plain i]) :: String in
- A.toJSON t
-metaToJson (MetaBlocks b) =
- let !t = writeMarkdown def (Pandoc mempty b) :: String in
- A.toJSON t