blob: c9626322fdbfee1e914242619e5a3282e610311c (
plain)
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
|
-- | 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.Monoid (mempty, (<>))
import qualified Data.Set as Set
import qualified Data.Yaml as Yaml
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 pandoc
!pActiveSlide = 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
--------------------------------------------------------------------------------
-- | 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.
pandocToSlides :: Pandoc.Pandoc -> [Slide]
pandocToSlides (Pandoc.Pandoc _meta blocks0)
| any (== Pandoc.HorizontalRule) blocks0 = splitAtRules blocks0
| otherwise = splitAtH1s blocks0
where
splitAtRules blocks = case break (== Pandoc.HorizontalRule) blocks of
(xs, []) -> [Slide xs]
(xs, (_rule : ys)) -> Slide xs : splitAtRules ys
splitAtH1s [] = []
splitAtH1s (b : bs) = case break isH1 bs of
(xs, []) -> [Slide (b : xs)]
(xs, (y : ys)) -> Slide (b : xs) : splitAtH1s (y : ys)
isH1 (Pandoc.Header i _ _) = i == 1
isH1 _ = False
|
