version 0.4.7.00.4.7.0

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