diff --git a/lib/Patat/Main.hs b/lib/Patat/Main.hs index c510089..207ac4e 100644 --- a/lib/Patat/Main.hs +++ b/lib/Patat/Main.hs @@ -27,7 +27,7 @@ import qualified Patat.EncodingFallback as EncodingFallback import qualified Patat.Eval as Eval import qualified Patat.Images as Images import Patat.Presentation -import qualified Patat.Presentation.Comments as Comments +import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes import qualified Patat.PrettyPrint as PP import Patat.PrettyPrint.Matrix (hPutMatrix) import Patat.Transition @@ -127,7 +127,7 @@ assertAnsiFeatures = do data App = App { aOptions :: Options , aImages :: Maybe Images.Handle - , aSpeakerNotes :: Maybe Comments.SpeakerNotesHandle + , aSpeakerNotes :: Maybe SpeakerNotes.Handle , aCommandChan :: Chan AppCommand , aPresentation :: Presentation , aView :: AppView @@ -175,7 +175,7 @@ main = do withMaybeHandle Images.withHandle (psImages settings) $ \images -> -- (Maybe) initialize speaker notes. - withMaybeHandle Comments.withSpeakerNotesHandle + withMaybeHandle SpeakerNotes.withHandle (psSpeakerNotes settings) $ \speakerNotes -> -- Read presentation commands @@ -206,7 +206,7 @@ main = do -------------------------------------------------------------------------------- loop :: App -> IO () loop app@App {..} = do - for_ aSpeakerNotes $ \sn -> Comments.writeSpeakerNotes sn + for_ aSpeakerNotes $ \sn -> SpeakerNotes.write sn (pEncodingFallback aPresentation) (activeSpeakerNotes aPresentation) diff --git a/lib/Patat/Presentation/Comments.hs b/lib/Patat/Presentation/Comments.hs deleted file mode 100644 index 90b762a..0000000 --- a/lib/Patat/Presentation/Comments.hs +++ /dev/null @@ -1,97 +0,0 @@ --------------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -module Patat.Presentation.Comments - ( SpeakerNotes (..) - , speakerNotesToText - - , SpeakerNotesHandle - , withSpeakerNotesHandle - , writeSpeakerNotes - - , parseSlideSettings - ) where - - --------------------------------------------------------------------------------- -import Control.Exception (bracket) -import Control.Monad (unless, when) -import qualified Data.IORef as IORef -import Data.List (intercalate, intersperse) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Patat.EncodingFallback (EncodingFallback) -import qualified Patat.EncodingFallback as EncodingFallback -import Patat.Presentation.Settings -import System.Directory (removeFile) -import qualified System.IO as IO - - --------------------------------------------------------------------------------- -newtype SpeakerNotes = SpeakerNotes [T.Text] - deriving (Eq, Monoid, Semigroup, Show) - - --------------------------------------------------------------------------------- -speakerNotesToText :: SpeakerNotes -> T.Text -speakerNotesToText (SpeakerNotes sn) = T.unlines $ intersperse mempty sn - - --------------------------------------------------------------------------------- -data SpeakerNotesHandle = SpeakerNotesHandle - { snhSettings :: !SpeakerNotesSettings - , snhActive :: !(IORef.IORef SpeakerNotes) - } - - --------------------------------------------------------------------------------- -withSpeakerNotesHandle - :: SpeakerNotesSettings -> (SpeakerNotesHandle -> IO a) -> IO a -withSpeakerNotesHandle settings = bracket - (SpeakerNotesHandle settings <$> IORef.newIORef mempty) - (\_ -> removeFile (snsFile settings)) - - --------------------------------------------------------------------------------- -writeSpeakerNotes - :: SpeakerNotesHandle -> EncodingFallback -> SpeakerNotes -> IO () -writeSpeakerNotes h encodingFallback sn = do - change <- IORef.atomicModifyIORef' (snhActive h) $ \old -> (sn, old /= sn) - when change $ IO.withFile (snsFile $ snhSettings h) IO.WriteMode $ \ioh -> - EncodingFallback.withHandle ioh encodingFallback $ - T.hPutStr ioh $ speakerNotesToText sn - - --------------------------------------------------------------------------------- -data Setting where - Setting :: String -> (PresentationSettings -> Maybe a) -> Setting - - --------------------------------------------------------------------------------- -unsupportedSlideSettings :: [Setting] -unsupportedSlideSettings = - [ Setting "incrementalLists" psIncrementalLists - , Setting "autoAdvanceDelay" psAutoAdvanceDelay - , Setting "slideLevel" psSlideLevel - , Setting "pandocExtensions" psPandocExtensions - , Setting "images" psImages - , Setting "eval" psEval - , Setting "speakerNotes" psSpeakerNotes - ] - - --------------------------------------------------------------------------------- -parseSlideSettings :: PresentationSettings -> Either String PresentationSettings -parseSlideSettings settings = do - unless (null unsupported) $ Left $ - "the following settings are not supported in slide config blocks: " ++ - intercalate ", " unsupported - pure settings - where - unsupported = do - setting <- unsupportedSlideSettings - case setting of - Setting name f | Just _ <- f settings -> [name] - Setting _ _ -> [] diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs index 98babee..507fe76 100644 --- a/lib/Patat/Presentation/Display.hs +++ b/lib/Patat/Presentation/Display.hs @@ -22,12 +22,12 @@ import qualified Data.List as L import Data.Maybe (fromMaybe, maybeToList) import qualified Data.Sequence.Extended as Seq import qualified Data.Text as T -import qualified Patat.Presentation.Comments as Comments import Patat.Presentation.Display.CodeBlock import Patat.Presentation.Display.Internal import Patat.Presentation.Display.Table import Patat.Presentation.Internal import Patat.Presentation.Settings +import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes import Patat.Presentation.Syntax import Patat.PrettyPrint ((<$$>), (<+>)) import qualified Patat.PrettyPrint as PP @@ -167,7 +167,7 @@ dumpPresentation pres@Presentation {..} = dumpSpeakerNotes slide = do guard (slideSpeakerNotes slide /= mempty) pure $ PP.text $ "{speakerNotes: " <> - Comments.speakerNotesToText (slideSpeakerNotes slide) <> "}" + SpeakerNotes.toText (slideSpeakerNotes slide) <> "}" dumpFragment :: Index -> [PP.Doc] dumpFragment idx = diff --git a/lib/Patat/Presentation/Internal.hs b/lib/Patat/Presentation/Internal.hs index 5918c65..a63707d 100644 --- a/lib/Patat/Presentation/Internal.hs +++ b/lib/Patat/Presentation/Internal.hs @@ -43,23 +43,23 @@ module Patat.Presentation.Internal -------------------------------------------------------------------------------- -import qualified Data.Aeson.Extended as A -import qualified Data.HashMap.Strict as HMS -import qualified Data.HashSet as HS -import Data.Maybe (fromMaybe) -import Data.Sequence.Extended (Seq) -import qualified Data.Sequence.Extended as Seq -import Patat.EncodingFallback (EncodingFallback) -import qualified Patat.Eval.Internal as Eval -import qualified Patat.Presentation.Comments as Comments +import qualified Data.Aeson.Extended as A +import qualified Data.HashMap.Strict as HMS +import qualified Data.HashSet as HS +import Data.Maybe (fromMaybe) +import Data.Sequence.Extended (Seq) +import qualified Data.Sequence.Extended as Seq +import Patat.EncodingFallback (EncodingFallback) +import qualified Patat.Eval.Internal as Eval import Patat.Presentation.Settings +import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes import Patat.Presentation.Syntax import Patat.Size -import Patat.Transition (TransitionGen) +import Patat.Transition (TransitionGen) import Patat.Unique import Prelude -import qualified Skylighting as Skylighting -import qualified Text.Pandoc as Pandoc +import qualified Skylighting as Skylighting +import qualified Text.Pandoc as Pandoc -------------------------------------------------------------------------------- @@ -108,7 +108,7 @@ margins ps = Margins -------------------------------------------------------------------------------- data Slide = Slide - { slideSpeakerNotes :: !Comments.SpeakerNotes + { slideSpeakerNotes :: !SpeakerNotes.SpeakerNotes , slideSettings :: !(Either String PresentationSettings) , slideContent :: !SlideContent } deriving (Show) @@ -164,7 +164,7 @@ activeFragment presentation = do -------------------------------------------------------------------------------- -activeSpeakerNotes :: Presentation -> Comments.SpeakerNotes +activeSpeakerNotes :: Presentation -> SpeakerNotes.SpeakerNotes activeSpeakerNotes presentation = fromMaybe mempty $ do let (sidx, _) = pActiveFragment presentation slide <- getSlide sidx presentation diff --git a/lib/Patat/Presentation/Read.hs b/lib/Patat/Presentation/Read.hs index 5cf61a2..4f7cb51 100644 --- a/lib/Patat/Presentation/Read.hs +++ b/lib/Patat/Presentation/Read.hs @@ -13,38 +13,39 @@ module Patat.Presentation.Read -------------------------------------------------------------------------------- -import Control.Monad (guard) -import Control.Monad.Except (ExceptT (..), runExceptT, - throwError) -import Control.Monad.Trans (liftIO) -import qualified Data.Aeson.Extended as A -import qualified Data.Aeson.KeyMap as AKM -import Data.Bifunctor (first) -import Data.Maybe (fromMaybe) -import Data.Sequence.Extended (Seq) -import qualified Data.Sequence.Extended as Seq -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.Traversable (for) -import qualified Data.Yaml as Yaml -import Patat.EncodingFallback (EncodingFallback) -import qualified Patat.EncodingFallback as EncodingFallback -import qualified Patat.Eval as Eval -import qualified Patat.Presentation.Comments as Comments +import Control.Monad (guard) +import Control.Monad.Except (ExceptT (..), runExceptT, + throwError) +import Control.Monad.Trans (liftIO) +import qualified Data.Aeson.Extended as A +import qualified Data.Aeson.KeyMap as AKM +import Data.Bifunctor (first) +import Data.Maybe (fromMaybe) +import Data.Sequence.Extended (Seq) +import qualified Data.Sequence.Extended as Seq +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Traversable (for) +import qualified Data.Yaml as Yaml +import Patat.EncodingFallback (EncodingFallback) +import qualified Patat.EncodingFallback as EncodingFallback +import qualified Patat.Eval as Eval import Patat.Presentation.Fragment import Patat.Presentation.Internal +import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes import Patat.Presentation.Syntax -import Patat.Transition (parseTransitionSettings) +import Patat.Transition (parseTransitionSettings) import Patat.Unique import Prelude -import qualified Skylighting as Skylighting -import System.Directory (XdgDirectory (XdgConfig), - doesFileExist, getHomeDirectory, - getXdgDirectory) -import System.FilePath (splitFileName, takeExtension, - ()) -import qualified Text.Pandoc.Error as Pandoc -import qualified Text.Pandoc.Extended as Pandoc +import qualified Skylighting as Skylighting +import System.Directory (XdgDirectory (XdgConfig), + doesFileExist, + getHomeDirectory, + getXdgDirectory) +import System.FilePath (splitFileName, takeExtension, + ()) +import qualified Text.Pandoc.Error as Pandoc +import qualified Text.Pandoc.Extended as Pandoc -------------------------------------------------------------------------------- @@ -242,7 +243,7 @@ splitSlides slideLevel blocks0 mkContentSlide :: [Block] -> [Slide] mkContentSlide bs0 = do let bs1 = filter (not . isComment) bs0 - sns = Comments.SpeakerNotes [s | SpeakerNote s <- bs0] + sns = SpeakerNotes.SpeakerNotes [s | SpeakerNote s <- bs0] cfgs = concatCfgs [cfg | Config cfg <- bs0] guard $ not $ null bs1 -- Never create empty slides pure $ Slide sns cfgs $ ContentSlide bs1 @@ -259,7 +260,7 @@ splitSlides slideLevel blocks0 mkContentSlide (reverse acc) ++ splitAtHeaders [b] bs0 | otherwise = let (cmnts, bs1) = break (not . isComment) bs0 - sns = Comments.SpeakerNotes [s | SpeakerNote s <- cmnts] + sns = SpeakerNotes.SpeakerNotes [s | SpeakerNote s <- cmnts] cfgs = concatCfgs [cfg | Config cfg <- cmnts] in mkContentSlide (reverse acc) ++ [Slide sns cfgs $ TitleSlide i txt] ++ diff --git a/lib/Patat/Presentation/Settings.hs b/lib/Patat/Presentation/Settings.hs index d476540..a47ebcb 100644 --- a/lib/Patat/Presentation/Settings.hs +++ b/lib/Patat/Presentation/Settings.hs @@ -1,4 +1,5 @@ -------------------------------------------------------------------------------- +{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} @@ -22,12 +23,14 @@ module Patat.Presentation.Settings , SpeakerNotesSettings (..) , TransitionSettings (..) + + , parseSlideSettings ) where -------------------------------------------------------------------------------- import Control.Applicative ((<|>)) -import Control.Monad (mplus) +import Control.Monad (mplus, unless) import qualified Data.Aeson.Extended as A import qualified Data.Aeson.TH.Extended as A import qualified Data.Foldable as Foldable @@ -296,3 +299,36 @@ instance A.FromJSON TransitionSettings where $(A.deriveFromJSON A.dropPrefixOptions ''MarginSettings) $(A.deriveFromJSON A.dropPrefixOptions ''SpeakerNotesSettings) $(A.deriveFromJSON A.dropPrefixOptions ''PresentationSettings) + + +-------------------------------------------------------------------------------- +data Setting where + Setting :: String -> (PresentationSettings -> Maybe a) -> Setting + + +-------------------------------------------------------------------------------- +unsupportedSlideSettings :: [Setting] +unsupportedSlideSettings = + [ Setting "incrementalLists" psIncrementalLists + , Setting "autoAdvanceDelay" psAutoAdvanceDelay + , Setting "slideLevel" psSlideLevel + , Setting "pandocExtensions" psPandocExtensions + , Setting "images" psImages + , Setting "eval" psEval + , Setting "speakerNotes" psSpeakerNotes + ] + + +-------------------------------------------------------------------------------- +parseSlideSettings :: PresentationSettings -> Either String PresentationSettings +parseSlideSettings settings = do + unless (null unsupported) $ Left $ + "the following settings are not supported in slide config blocks: " ++ + intercalate ", " unsupported + pure settings + where + unsupported = do + setting <- unsupportedSlideSettings + case setting of + Setting name f | Just _ <- f settings -> [name] + Setting _ _ -> [] diff --git a/lib/Patat/Presentation/SpeakerNotes.hs b/lib/Patat/Presentation/SpeakerNotes.hs new file mode 100644 index 0000000..0ee01b9 --- /dev/null +++ b/lib/Patat/Presentation/SpeakerNotes.hs @@ -0,0 +1,61 @@ +-------------------------------------------------------------------------------- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Patat.Presentation.SpeakerNotes + ( SpeakerNotes (..) + , toText + + , Handle + , withHandle + , write + + , parseSlideSettings + ) where + + +-------------------------------------------------------------------------------- +import Control.Exception (bracket) +import Control.Monad (when) +import qualified Data.IORef as IORef +import Data.List (intersperse) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Patat.EncodingFallback (EncodingFallback) +import qualified Patat.EncodingFallback as EncodingFallback +import Patat.Presentation.Settings +import System.Directory (removeFile) +import qualified System.IO as IO + + +-------------------------------------------------------------------------------- +newtype SpeakerNotes = SpeakerNotes [T.Text] + deriving (Eq, Monoid, Semigroup, Show) + + +-------------------------------------------------------------------------------- +toText :: SpeakerNotes -> T.Text +toText (SpeakerNotes sn) = T.unlines $ intersperse mempty sn + + +-------------------------------------------------------------------------------- +data Handle = Handle + { hSettings :: !SpeakerNotesSettings + , hActive :: !(IORef.IORef SpeakerNotes) + } + + +-------------------------------------------------------------------------------- +withHandle + :: SpeakerNotesSettings -> (Handle -> IO a) -> IO a +withHandle settings = bracket + (Handle settings <$> IORef.newIORef mempty) + (\_ -> removeFile (snsFile settings)) + + +-------------------------------------------------------------------------------- +write + :: Handle -> EncodingFallback -> SpeakerNotes -> IO () +write h encodingFallback sn = do + change <- IORef.atomicModifyIORef' (hActive h) $ \old -> (sn, old /= sn) + when change $ IO.withFile (snsFile $ hSettings h) IO.WriteMode $ \ioh -> + EncodingFallback.withHandle ioh encodingFallback $ + T.hPutStr ioh $ toText sn diff --git a/patat.cabal b/patat.cabal index e80782b..e73da50 100644 --- a/patat.cabal +++ b/patat.cabal @@ -80,7 +80,6 @@ Library Patat.Images.W3m Patat.Main Patat.Presentation - Patat.Presentation.Comments Patat.Presentation.Display Patat.Presentation.Display.CodeBlock Patat.Presentation.Display.Internal @@ -90,6 +89,7 @@ Library Patat.Presentation.Internal Patat.Presentation.Read Patat.Presentation.Settings + Patat.Presentation.SpeakerNotes Patat.Presentation.Syntax Patat.PrettyPrint Patat.PrettyPrint.Internal