{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Patat.Presentation.SpeakerNotes
( SpeakerNotes
, parse
, toText
, remove
, split
, partition
, Settings
, Handle
, with
, write
) where
import Control.Exception (bracket)
import Control.Monad (when)
import qualified Data.Aeson.TH.Extended as A
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 System.Directory (removeFile)
import qualified System.IO as IO
import qualified Text.Pandoc as Pandoc
newtype SpeakerNotes = SpeakerNotes [T.Text]
deriving (SpeakerNotes -> SpeakerNotes -> Bool
(SpeakerNotes -> SpeakerNotes -> Bool)
-> (SpeakerNotes -> SpeakerNotes -> Bool) -> Eq SpeakerNotes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpeakerNotes -> SpeakerNotes -> Bool
== :: SpeakerNotes -> SpeakerNotes -> Bool
$c/= :: SpeakerNotes -> SpeakerNotes -> Bool
/= :: SpeakerNotes -> SpeakerNotes -> Bool
Eq, Semigroup SpeakerNotes
SpeakerNotes
Semigroup SpeakerNotes
-> SpeakerNotes
-> (SpeakerNotes -> SpeakerNotes -> SpeakerNotes)
-> ([SpeakerNotes] -> SpeakerNotes)
-> Monoid SpeakerNotes
[SpeakerNotes] -> SpeakerNotes
SpeakerNotes -> SpeakerNotes -> SpeakerNotes
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: SpeakerNotes
mempty :: SpeakerNotes
$cmappend :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
mappend :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
$cmconcat :: [SpeakerNotes] -> SpeakerNotes
mconcat :: [SpeakerNotes] -> SpeakerNotes
Monoid, NonEmpty SpeakerNotes -> SpeakerNotes
SpeakerNotes -> SpeakerNotes -> SpeakerNotes
(SpeakerNotes -> SpeakerNotes -> SpeakerNotes)
-> (NonEmpty SpeakerNotes -> SpeakerNotes)
-> (forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes)
-> Semigroup SpeakerNotes
forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
<> :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
$csconcat :: NonEmpty SpeakerNotes -> SpeakerNotes
sconcat :: NonEmpty SpeakerNotes -> SpeakerNotes
$cstimes :: forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes
stimes :: forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes
Semigroup, Int -> SpeakerNotes -> ShowS
[SpeakerNotes] -> ShowS
SpeakerNotes -> String
(Int -> SpeakerNotes -> ShowS)
-> (SpeakerNotes -> String)
-> ([SpeakerNotes] -> ShowS)
-> Show SpeakerNotes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpeakerNotes -> ShowS
showsPrec :: Int -> SpeakerNotes -> ShowS
$cshow :: SpeakerNotes -> String
show :: SpeakerNotes -> String
$cshowList :: [SpeakerNotes] -> ShowS
showList :: [SpeakerNotes] -> ShowS
Show)
parse :: Pandoc.Block -> Maybe SpeakerNotes
parse :: Block -> Maybe SpeakerNotes
parse (Pandoc.RawBlock Format
"html" Text
t0) = do
Text
t1 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"<!--" Text
t0
Text
t2 <- Text -> Text -> Maybe Text
T.stripSuffix Text
"-->" Text
t1
SpeakerNotes -> Maybe SpeakerNotes
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpeakerNotes -> Maybe SpeakerNotes)
-> SpeakerNotes -> Maybe SpeakerNotes
forall a b. (a -> b) -> a -> b
$ [Text] -> SpeakerNotes
SpeakerNotes [Text -> Text
T.strip Text
t2]
parse Block
_ = Maybe SpeakerNotes
forall a. Maybe a
Nothing
toText :: SpeakerNotes -> T.Text
toText :: SpeakerNotes -> Text
toText (SpeakerNotes [Text]
sn) = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
forall a. Monoid a => a
mempty [Text]
sn
remove :: [Pandoc.Block] -> [Pandoc.Block]
remove :: [Block] -> [Block]
remove = (SpeakerNotes, [Block]) -> [Block]
forall a b. (a, b) -> b
snd ((SpeakerNotes, [Block]) -> [Block])
-> ([Block] -> (SpeakerNotes, [Block])) -> [Block] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> (SpeakerNotes, [Block])
partition
split :: [Pandoc.Block] -> (SpeakerNotes, [Pandoc.Block])
split :: [Block] -> (SpeakerNotes, [Block])
split = [SpeakerNotes] -> [Block] -> (SpeakerNotes, [Block])
go []
where
go :: [SpeakerNotes] -> [Block] -> (SpeakerNotes, [Block])
go [SpeakerNotes]
sn [] = ([SpeakerNotes] -> SpeakerNotes
forall a. Monoid a => [a] -> a
mconcat ([SpeakerNotes] -> [SpeakerNotes]
forall a. [a] -> [a]
reverse [SpeakerNotes]
sn), [])
go [SpeakerNotes]
sn (Block
x : [Block]
xs) | Just SpeakerNotes
s <- Block -> Maybe SpeakerNotes
parse Block
x = [SpeakerNotes] -> [Block] -> (SpeakerNotes, [Block])
go (SpeakerNotes
s SpeakerNotes -> [SpeakerNotes] -> [SpeakerNotes]
forall a. a -> [a] -> [a]
: [SpeakerNotes]
sn) [Block]
xs
go [SpeakerNotes]
sn [Block]
xs = ([SpeakerNotes] -> SpeakerNotes
forall a. Monoid a => [a] -> a
mconcat ([SpeakerNotes] -> [SpeakerNotes]
forall a. [a] -> [a]
reverse [SpeakerNotes]
sn), [Block]
xs)
partition :: [Pandoc.Block] -> (SpeakerNotes, [Pandoc.Block])
partition :: [Block] -> (SpeakerNotes, [Block])
partition = [SpeakerNotes] -> [Block] -> [Block] -> (SpeakerNotes, [Block])
go [] []
where
go :: [SpeakerNotes] -> [Block] -> [Block] -> (SpeakerNotes, [Block])
go [SpeakerNotes]
sn [Block]
bs [] = ([SpeakerNotes] -> SpeakerNotes
forall a. Monoid a => [a] -> a
mconcat ([SpeakerNotes] -> [SpeakerNotes]
forall a. [a] -> [a]
reverse [SpeakerNotes]
sn), [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
bs)
go [SpeakerNotes]
sn [Block]
bs (Block
x : [Block]
xs) | Just SpeakerNotes
s <- Block -> Maybe SpeakerNotes
parse Block
x = [SpeakerNotes] -> [Block] -> [Block] -> (SpeakerNotes, [Block])
go (SpeakerNotes
s SpeakerNotes -> [SpeakerNotes] -> [SpeakerNotes]
forall a. a -> [a] -> [a]
: [SpeakerNotes]
sn) [Block]
bs [Block]
xs
go [SpeakerNotes]
sn [Block]
bs (Block
x : [Block]
xs) = [SpeakerNotes] -> [Block] -> [Block] -> (SpeakerNotes, [Block])
go [SpeakerNotes]
sn (Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs) [Block]
xs
data Settings = Settings
{ Settings -> String
sFile :: !FilePath
} deriving (Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
(Int -> Settings -> ShowS)
-> (Settings -> String) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Settings -> ShowS
showsPrec :: Int -> Settings -> ShowS
$cshow :: Settings -> String
show :: Settings -> String
$cshowList :: [Settings] -> ShowS
showList :: [Settings] -> ShowS
Show)
data Handle = Handle
{ Handle -> Settings
hSettings :: !Settings
, Handle -> IORef SpeakerNotes
hActive :: !(IORef.IORef SpeakerNotes)
}
with :: Settings -> (Handle -> IO a) -> IO a
with :: forall a. Settings -> (Handle -> IO a) -> IO a
with Settings
settings = IO Handle -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(Settings -> IORef SpeakerNotes -> Handle
Handle Settings
settings (IORef SpeakerNotes -> Handle)
-> IO (IORef SpeakerNotes) -> IO Handle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpeakerNotes -> IO (IORef SpeakerNotes)
forall a. a -> IO (IORef a)
IORef.newIORef SpeakerNotes
forall a. Monoid a => a
mempty)
(\Handle
_ -> String -> IO ()
removeFile (Settings -> String
sFile Settings
settings))
write :: Handle -> EncodingFallback -> SpeakerNotes -> IO ()
write :: Handle -> EncodingFallback -> SpeakerNotes -> IO ()
write Handle
h EncodingFallback
encodingFallback SpeakerNotes
sn = do
Bool
change <- IORef SpeakerNotes
-> (SpeakerNotes -> (SpeakerNotes, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' (Handle -> IORef SpeakerNotes
hActive Handle
h) ((SpeakerNotes -> (SpeakerNotes, Bool)) -> IO Bool)
-> (SpeakerNotes -> (SpeakerNotes, Bool)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \SpeakerNotes
old -> (SpeakerNotes
sn, SpeakerNotes
old SpeakerNotes -> SpeakerNotes -> Bool
forall a. Eq a => a -> a -> Bool
/= SpeakerNotes
sn)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
change (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile (Settings -> String
sFile (Settings -> String) -> Settings -> String
forall a b. (a -> b) -> a -> b
$ Handle -> Settings
hSettings Handle
h) IOMode
IO.WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
ioh ->
Handle -> EncodingFallback -> IO () -> IO ()
forall a. Handle -> EncodingFallback -> IO a -> IO a
EncodingFallback.withHandle Handle
ioh EncodingFallback
encodingFallback (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> Text -> IO ()
T.hPutStr Handle
ioh (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ SpeakerNotes -> Text
toText SpeakerNotes
sn
$(A.deriveFromJSON A.dropPrefixOptions ''Settings)