{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Patat.Presentation.Read
( readPresentation
, readMetaSettings
) where
import Control.Monad.Except (ExceptT (..), runExceptT,
throwError)
import Control.Monad.Trans (liftIO)
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as AKM
import Data.Bifunctor (first)
import Data.Maybe (fromMaybe)
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.Eval (eval)
import Patat.Presentation.Fragment
import qualified Patat.Presentation.Instruction as Instruction
import Patat.Presentation.Internal
import Prelude
import System.Directory (doesFileExist,
getHomeDirectory)
import System.FilePath (splitFileName, takeExtension,
(</>))
import qualified Text.Pandoc.Error as Pandoc
import qualified Text.Pandoc.Extended as Pandoc
readPresentation :: FilePath -> IO (Either String Presentation)
readPresentation :: String -> IO (Either String Presentation)
readPresentation String
filePath = ExceptT String IO Presentation -> IO (Either String Presentation)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO Presentation -> IO (Either String Presentation))
-> ExceptT String IO Presentation
-> IO (Either String Presentation)
forall a b. (a -> b) -> a -> b
$ do
Text
src <- IO Text -> ExceptT String IO Text
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT String IO Text)
-> IO Text -> ExceptT String IO Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
filePath
PresentationSettings
homeSettings <- IO (Either String PresentationSettings)
-> ExceptT String IO PresentationSettings
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT IO (Either String PresentationSettings)
readHomeSettings
PresentationSettings
metaSettings <- IO (Either String PresentationSettings)
-> ExceptT String IO PresentationSettings
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String PresentationSettings)
-> ExceptT String IO PresentationSettings)
-> IO (Either String PresentationSettings)
-> ExceptT String IO PresentationSettings
forall a b. (a -> b) -> a -> b
$ Either String PresentationSettings
-> IO (Either String PresentationSettings)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String PresentationSettings
-> IO (Either String PresentationSettings))
-> Either String PresentationSettings
-> IO (Either String PresentationSettings)
forall a b. (a -> b) -> a -> b
$ Text -> Either String PresentationSettings
readMetaSettings Text
src
let settings :: PresentationSettings
settings = PresentationSettings
metaSettings PresentationSettings
-> PresentationSettings -> PresentationSettings
forall a. Semigroup a => a -> a -> a
<> PresentationSettings
homeSettings PresentationSettings
-> PresentationSettings -> PresentationSettings
forall a. Semigroup a => a -> a -> a
<> PresentationSettings
defaultPresentationSettings
let pexts :: ExtensionList
pexts = ExtensionList -> Maybe ExtensionList -> ExtensionList
forall a. a -> Maybe a -> a
fromMaybe ExtensionList
defaultExtensionList (PresentationSettings -> Maybe ExtensionList
psPandocExtensions PresentationSettings
settings)
Text -> Either PandocError Pandoc
reader <- case ExtensionList
-> String -> Maybe (Text -> Either PandocError Pandoc)
readExtension ExtensionList
pexts String
ext of
Maybe (Text -> Either PandocError Pandoc)
Nothing -> String -> ExceptT String IO (Text -> Either PandocError Pandoc)
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO (Text -> Either PandocError Pandoc))
-> String -> ExceptT String IO (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ String
"Unknown file extension: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
ext
Just Text -> Either PandocError Pandoc
x -> (Text -> Either PandocError Pandoc)
-> ExceptT String IO (Text -> Either PandocError Pandoc)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text -> Either PandocError Pandoc
x
Pandoc
doc <- case Text -> Either PandocError Pandoc
reader Text
src of
Left PandocError
e -> String -> ExceptT String IO Pandoc
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO Pandoc)
-> String -> ExceptT String IO Pandoc
forall a b. (a -> b) -> a -> b
$ String
"Could not parse document: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PandocError -> String
forall a. Show a => a -> String
show PandocError
e
Right Pandoc
x -> Pandoc -> ExceptT String IO Pandoc
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
x
Presentation
pres <- IO (Either String Presentation) -> ExceptT String IO Presentation
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String Presentation) -> ExceptT String IO Presentation)
-> IO (Either String Presentation)
-> ExceptT String IO Presentation
forall a b. (a -> b) -> a -> b
$ Either String Presentation -> IO (Either String Presentation)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Presentation -> IO (Either String Presentation))
-> Either String Presentation -> IO (Either String Presentation)
forall a b. (a -> b) -> a -> b
$ String
-> PresentationSettings -> Pandoc -> Either String Presentation
pandocToPresentation String
filePath PresentationSettings
settings Pandoc
doc
IO Presentation -> ExceptT String IO Presentation
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Presentation -> ExceptT String IO Presentation)
-> IO Presentation -> ExceptT String IO Presentation
forall a b. (a -> b) -> a -> b
$ Presentation -> IO Presentation
eval Presentation
pres
where
ext :: String
ext = String -> String
takeExtension String
filePath
readExtension
:: ExtensionList -> String
-> Maybe (T.Text -> Either Pandoc.PandocError Pandoc.Pandoc)
readExtension :: ExtensionList
-> String -> Maybe (Text -> Either PandocError Pandoc)
readExtension (ExtensionList Extensions
extensions) String
fileExt = case String
fileExt of
String
".markdown" -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".md" -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".mdown" -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".mdtext" -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".mdtxt" -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".mdwn" -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".mkd" -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".mkdn" -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".lhs" -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
lhsOpts
String
"" -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".org" -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readOrg ReaderOptions
readerOpts
String
_ -> Maybe (Text -> Either PandocError Pandoc)
forall a. Maybe a
Nothing
where
readerOpts :: ReaderOptions
readerOpts = ReaderOptions
forall a. Default a => a
Pandoc.def
{ readerExtensions :: Extensions
Pandoc.readerExtensions =
Extensions
extensions Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<> Extensions
absolutelyRequiredExtensions
}
lhsOpts :: ReaderOptions
lhsOpts = ReaderOptions
readerOpts
{ readerExtensions :: Extensions
Pandoc.readerExtensions =
ReaderOptions -> Extensions
Pandoc.readerExtensions ReaderOptions
readerOpts Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<>
[Extension] -> Extensions
Pandoc.extensionsFromList [Extension
Pandoc.Ext_literate_haskell]
}
absolutelyRequiredExtensions :: Extensions
absolutelyRequiredExtensions =
[Extension] -> Extensions
Pandoc.extensionsFromList [Extension
Pandoc.Ext_yaml_metadata_block]
pandocToPresentation
:: FilePath -> PresentationSettings -> Pandoc.Pandoc
-> Either String Presentation
pandocToPresentation :: String
-> PresentationSettings -> Pandoc -> Either String Presentation
pandocToPresentation String
pFilePath PresentationSettings
pSettings pandoc :: Pandoc
pandoc@(Pandoc.Pandoc Meta
meta [Block]
_) = do
let !pTitle :: [Inline]
pTitle = case Meta -> [Inline]
Pandoc.docTitle Meta
meta of
[] -> [Text -> Inline
Pandoc.Str (Text -> Inline)
-> ((String, String) -> Text) -> (String, String) -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> ((String, String) -> String) -> (String, String) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> Inline) -> (String, String) -> Inline
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
splitFileName String
pFilePath]
[Inline]
title -> [Inline]
title
!pSlides :: [Slide]
pSlides = PresentationSettings -> Pandoc -> [Slide]
pandocToSlides PresentationSettings
pSettings Pandoc
pandoc
!pBreadcrumbs :: [Breadcrumbs]
pBreadcrumbs = [Slide] -> [Breadcrumbs]
collectBreadcrumbs [Slide]
pSlides
!pActiveFragment :: (Int, Int)
pActiveFragment = (Int
0, Int
0)
!pAuthor :: [Inline]
pAuthor = [[Inline]] -> [Inline]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Meta -> [[Inline]]
Pandoc.docAuthors Meta
meta)
Presentation -> Either String Presentation
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Presentation {String
[Breadcrumbs]
[Inline]
[Slide]
(Int, Int)
PresentationSettings
pFilePath :: String
pSettings :: PresentationSettings
pTitle :: [Inline]
pSlides :: [Slide]
pBreadcrumbs :: [Breadcrumbs]
pActiveFragment :: (Int, Int)
pAuthor :: [Inline]
pFilePath :: String
pTitle :: [Inline]
pAuthor :: [Inline]
pSettings :: PresentationSettings
pSlides :: [Slide]
pBreadcrumbs :: [Breadcrumbs]
pActiveFragment :: (Int, Int)
..}
parseMetadataBlock :: T.Text -> Maybe (Either String A.Value)
parseMetadataBlock :: Text -> Maybe (Either String Value)
parseMetadataBlock Text
src = case Text -> [Text]
T.lines Text
src of
(Text
"---" : [Text]
ls) -> case (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"---", Text
"..."]) [Text]
ls of
([Text]
_, []) -> Maybe (Either String Value)
forall a. Maybe a
Nothing
([Text]
block, (Text
_ : [Text]
_)) -> Either String Value -> Maybe (Either String Value)
forall a. a -> Maybe a
Just (Either String Value -> Maybe (Either String Value))
-> ([Text] -> Either String Value)
-> [Text]
-> Maybe (Either String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseException -> String)
-> Either ParseException Value -> Either String Value
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseException -> String
Yaml.prettyPrintParseException (Either ParseException Value -> Either String Value)
-> ([Text] -> Either ParseException Value)
-> [Text]
-> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ByteString -> Either ParseException Value
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' (ByteString -> Either ParseException Value)
-> ([Text] -> ByteString) -> [Text] -> Either ParseException Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> ([Text] -> Text) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Maybe (Either String Value))
-> [Text] -> Maybe (Either String Value)
forall a b. (a -> b) -> a -> b
$! [Text]
block
[Text]
_ -> Maybe (Either String Value)
forall a. Maybe a
Nothing
readMetaSettings :: T.Text -> Either String PresentationSettings
readMetaSettings :: Text -> Either String PresentationSettings
readMetaSettings Text
src = case Text -> Maybe (Either String Value)
parseMetadataBlock Text
src of
Maybe (Either String Value)
Nothing -> PresentationSettings -> Either String PresentationSettings
forall a b. b -> Either a b
Right PresentationSettings
forall a. Monoid a => a
mempty
Just (Left String
err) -> String -> Either String PresentationSettings
forall a b. a -> Either a b
Left String
err
Just (Right (A.Object Object
obj)) | Just Value
val <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
AKM.lookup Key
"patat" Object
obj ->
Result PresentationSettings -> Either String PresentationSettings
forall a. Result a -> Either String a
resultToEither (Result PresentationSettings -> Either String PresentationSettings)
-> Result PresentationSettings
-> Either String PresentationSettings
forall a b. (a -> b) -> a -> b
$! Value -> Result PresentationSettings
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
val
Just (Right Value
_) -> PresentationSettings -> Either String PresentationSettings
forall a b. b -> Either a b
Right PresentationSettings
forall a. Monoid a => a
mempty
where
resultToEither :: A.Result a -> Either String a
resultToEither :: forall a. Result a -> Either String a
resultToEither (A.Success a
x) = a -> Either String a
forall a b. b -> Either a b
Right a
x
resultToEither (A.Error String
e) = String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$!
String
"Error parsing patat settings from metadata: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
readHomeSettings :: IO (Either String PresentationSettings)
readHomeSettings :: IO (Either String PresentationSettings)
readHomeSettings = do
String
home <- IO String
getHomeDirectory
let path :: String
path = String
home String -> String -> String
</> String
".patat.yaml"
Bool
exists <- String -> IO Bool
doesFileExist String
path
if Bool -> Bool
not Bool
exists
then Either String PresentationSettings
-> IO (Either String PresentationSettings)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PresentationSettings -> Either String PresentationSettings
forall a b. b -> Either a b
Right PresentationSettings
forall a. Monoid a => a
mempty)
else do
Either ParseException PresentationSettings
errOrPs <- String -> IO (Either ParseException PresentationSettings)
forall a. FromJSON a => String -> IO (Either ParseException a)
Yaml.decodeFileEither String
path
Either String PresentationSettings
-> IO (Either String PresentationSettings)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String PresentationSettings
-> IO (Either String PresentationSettings))
-> Either String PresentationSettings
-> IO (Either String PresentationSettings)
forall a b. (a -> b) -> a -> b
$! case Either ParseException PresentationSettings
errOrPs of
Left ParseException
err -> String -> Either String PresentationSettings
forall a b. a -> Either a b
Left (ParseException -> String
forall a. Show a => a -> String
show ParseException
err)
Right PresentationSettings
ps -> PresentationSettings -> Either String PresentationSettings
forall a b. b -> Either a b
Right PresentationSettings
ps
pandocToSlides :: PresentationSettings -> Pandoc.Pandoc -> [Slide]
pandocToSlides :: PresentationSettings -> Pandoc -> [Slide]
pandocToSlides PresentationSettings
settings Pandoc
pandoc =
let slideLevel :: Int
slideLevel = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Pandoc -> Int
detectSlideLevel Pandoc
pandoc) (PresentationSettings -> Maybe Int
psSlideLevel PresentationSettings
settings)
unfragmented :: [Slide]
unfragmented = Int -> Pandoc -> [Slide]
splitSlides Int
slideLevel Pandoc
pandoc
fragmented :: [Slide]
fragmented =
[ case Slide
slide of
TitleSlide Int
_ [Inline]
_ -> Slide
slide
ContentSlide Instructions Block
instrs0 -> Instructions Block -> Slide
ContentSlide (Instructions Block -> Slide) -> Instructions Block -> Slide
forall a b. (a -> b) -> a -> b
$
FragmentSettings -> Instructions Block -> Instructions Block
fragmentInstructions FragmentSettings
fragmentSettings Instructions Block
instrs0
| Slide
slide <- [Slide]
unfragmented
] in
[Slide]
fragmented
where
fragmentSettings :: FragmentSettings
fragmentSettings = FragmentSettings
{ fsIncrementalLists :: Bool
fsIncrementalLists = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (PresentationSettings -> Maybe Bool
psIncrementalLists PresentationSettings
settings)
}
detectSlideLevel :: Pandoc.Pandoc -> Int
detectSlideLevel :: Pandoc -> Int
detectSlideLevel (Pandoc.Pandoc Meta
_meta [Block]
blocks0) =
Int -> [Block] -> Int
go Int
6 [Block]
blocks0
where
go :: Int -> [Block] -> Int
go Int
level (Pandoc.Header Int
n Attr
_ [Inline]
_ : Block
x : [Block]
xs)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
level Bool -> Bool -> Bool
&& Block -> Bool
nonHeader Block
x = Int -> [Block] -> Int
go Int
n [Block]
xs
| Bool
otherwise = Int -> [Block] -> Int
go Int
level (Block
xBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
xs)
go Int
level (Block
_ : [Block]
xs) = Int -> [Block] -> Int
go Int
level [Block]
xs
go Int
level [] = Int
level
nonHeader :: Block -> Bool
nonHeader (Pandoc.Header Int
_ Attr
_ [Inline]
_) = Bool
False
nonHeader Block
_ = Bool
True
splitSlides :: Int -> Pandoc.Pandoc -> [Slide]
splitSlides :: Int -> Pandoc -> [Slide]
splitSlides Int
slideLevel (Pandoc.Pandoc Meta
_meta [Block]
blocks0)
| (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Block -> Block -> Bool
forall a. Eq a => a -> a -> Bool
== Block
Pandoc.HorizontalRule) [Block]
blocks0 = [Block] -> [Slide]
splitAtRules [Block]
blocks0
| Bool
otherwise = [Block] -> [Block] -> [Slide]
splitAtHeaders [] [Block]
blocks0
where
mkContentSlide :: [Pandoc.Block] -> [Slide]
mkContentSlide :: [Block] -> [Slide]
mkContentSlide [] = []
mkContentSlide [Block]
bs =
[Instructions Block -> Slide
ContentSlide (Instructions Block -> Slide) -> Instructions Block -> Slide
forall a b. (a -> b) -> a -> b
$ [Instruction Block] -> Instructions Block
forall a. [Instruction a] -> Instructions a
Instruction.fromList [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Instruction.Append [Block]
bs]]
splitAtRules :: [Block] -> [Slide]
splitAtRules [Block]
blocks = case (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Block -> Block -> Bool
forall a. Eq a => a -> a -> Bool
== Block
Pandoc.HorizontalRule) [Block]
blocks of
([Block]
xs, []) -> [Block] -> [Slide]
mkContentSlide [Block]
xs
([Block]
xs, (Block
_rule : [Block]
ys)) -> [Block] -> [Slide]
mkContentSlide [Block]
xs [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++ [Block] -> [Slide]
splitAtRules [Block]
ys
splitAtHeaders :: [Block] -> [Block] -> [Slide]
splitAtHeaders [Block]
acc [] =
[Block] -> [Slide]
mkContentSlide ([Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
acc)
splitAtHeaders [Block]
acc (b :: Block
b@(Pandoc.Header Int
i Attr
_ [Inline]
txt) : [Block]
bs)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
slideLevel = [Block] -> [Block] -> [Slide]
splitAtHeaders (Block
b Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
acc) [Block]
bs
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slideLevel =
[Block] -> [Slide]
mkContentSlide ([Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
acc) [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++ [Block] -> [Block] -> [Slide]
splitAtHeaders [Block
b] [Block]
bs
| Bool
otherwise =
[Block] -> [Slide]
mkContentSlide ([Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
acc) [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++ [Int -> [Inline] -> Slide
TitleSlide Int
i [Inline]
txt] [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++
[Block] -> [Block] -> [Slide]
splitAtHeaders [] [Block]
bs
splitAtHeaders [Block]
acc (Block
b : [Block]
bs) =
[Block] -> [Block] -> [Slide]
splitAtHeaders (Block
b Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
acc) [Block]
bs
collectBreadcrumbs :: [Slide] -> [Breadcrumbs]
collectBreadcrumbs :: [Slide] -> [Breadcrumbs]
collectBreadcrumbs = Breadcrumbs -> [Slide] -> [Breadcrumbs]
go []
where
go :: Breadcrumbs -> [Slide] -> [Breadcrumbs]
go Breadcrumbs
breadcrumbs = \case
[] -> []
ContentSlide Instructions Block
_ : [Slide]
slides -> Breadcrumbs
breadcrumbs Breadcrumbs -> [Breadcrumbs] -> [Breadcrumbs]
forall a. a -> [a] -> [a]
: Breadcrumbs -> [Slide] -> [Breadcrumbs]
go Breadcrumbs
breadcrumbs [Slide]
slides
TitleSlide Int
lvl [Inline]
inlines : [Slide]
slides ->
let parent :: Breadcrumbs
parent = ((Int, [Inline]) -> Bool) -> Breadcrumbs -> Breadcrumbs
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lvl) (Int -> Bool)
-> ((Int, [Inline]) -> Int) -> (Int, [Inline]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Inline]) -> Int
forall a b. (a, b) -> a
fst) Breadcrumbs
breadcrumbs in
Breadcrumbs
parent Breadcrumbs -> [Breadcrumbs] -> [Breadcrumbs]
forall a. a -> [a] -> [a]
: Breadcrumbs -> [Slide] -> [Breadcrumbs]
go (Breadcrumbs
parent Breadcrumbs -> Breadcrumbs -> Breadcrumbs
forall a. [a] -> [a] -> [a]
++ [(Int
lvl, [Inline]
inlines)]) [Slide]
slides