1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
-- | Read a presentation from disk.
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
module Patat.Presentation.Read
( readPresentation
) where
--------------------------------------------------------------------------------
import Control.Monad.Except (ExceptT (..), runExceptT,
throwError)
import Control.Monad.Trans (liftIO)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import Data.Maybe (fromMaybe)
import Data.Monoid (mempty, (<>))
import qualified Data.Set as Set
import qualified Data.Yaml as Yaml
import Patat.Presentation.Fragment
import Patat.Presentation.Internal
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
--------------------------------------------------------------------------------
readPresentation :: FilePath -> IO (Either String Presentation)
readPresentation filePath = runExceptT $ do
src <- liftIO $ readFile filePath
reader <- case readExtension ext of
Nothing -> throwError $ "Unknown file extension: " ++ show ext
Just x -> return x
doc@(Pandoc.Pandoc meta _) <- 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
let settings = metaSettings <> homeSettings <> defaultPresentationSettings
ExceptT $ return $ pandocToPresentation filePath settings 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
".org" -> Just $ Pandoc.readOrg Pandoc.def
_ -> Nothing
where
lhsOpts = Pandoc.def
{ Pandoc.readerExtensions = Set.insert Pandoc.Ext_literate_haskell
(Pandoc.readerExtensions Pandoc.def)
}
--------------------------------------------------------------------------------
pandocToPresentation
:: FilePath -> PresentationSettings -> Pandoc.Pandoc
-> Either String Presentation
pandocToPresentation pFilePath pSettings pandoc@(Pandoc.Pandoc meta _) = do
let !pTitle = Pandoc.docTitle meta
!pSlides = pandocToSlides pSettings pandoc
!pActiveFragment = (0, 0)
!pAuthor = concat (Pandoc.docAuthors meta)
return Presentation {..}
--------------------------------------------------------------------------------
-- | 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
where
resultToEither :: A.Result a -> Either String a
resultToEither (A.Success x) = Right x
resultToEither (A.Error e) = Left $!
"Error parsing patat settings from metadata: " ++ e
--------------------------------------------------------------------------------
-- | Read settings from "$HOME/.patat.yaml".
readHomeSettings :: IO (Either String PresentationSettings)
readHomeSettings = do
home <- getHomeDirectory
let path = home </> ".patat.yaml"
exists <- doesFileExist path
if not exists
then return (Right mempty)
else do
contents <- B.readFile path
return $! Yaml.decodeEither contents
--------------------------------------------------------------------------------
pandocToSlides :: PresentationSettings -> Pandoc.Pandoc -> [Slide]
pandocToSlides settings pandoc =
let blockss = splitSlides pandoc in
map (Slide . map Fragment . (fragmentBlocks fragmentSettings)) blockss
where
fragmentSettings = FragmentSettings
{ fsIncrementalLists = fromMaybe False (psIncrementalLists settings)
}
--------------------------------------------------------------------------------
-- | 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.
splitSlides :: Pandoc.Pandoc -> [[Pandoc.Block]]
splitSlides (Pandoc.Pandoc _meta blocks0)
| any (== Pandoc.HorizontalRule) blocks0 = splitAtRules blocks0
| otherwise = splitAtH1s blocks0
where
splitAtRules blocks = case break (== Pandoc.HorizontalRule) blocks of
(xs, []) -> [xs]
(xs, (_rule : ys)) -> xs : splitAtRules ys
splitAtH1s [] = []
splitAtH1s (b : bs) = case break isH1 bs of
(xs, []) -> [(b : xs)]
(xs, (y : ys)) -> (b : xs) : splitAtH1s (y : ys)
isH1 (Pandoc.Header i _ _) = i == 1
isH1 _ = False
|
