module Text.Ogmarkup.Private.Generator where
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Monoid
import qualified Text.Ogmarkup.Private.Ast as Ast
import Text.Ogmarkup.Private.Config as Conf
import Text.Ogmarkup.Private.Typography
newtype Generator c a x = Generator { getState :: State (a, Maybe (Ast.Atom a)) x }
deriving (Functor, Applicative, Monad, MonadState (a, Maybe (Ast.Atom a)))
runGenerator :: Monoid a
=> Generator c a x
-> a
runGenerator gen = fst $ execState (getState gen) (mempty, Nothing)
apply :: Monoid a
=> Template a
-> Generator c a x
-> Generator c a ()
apply app gen = do
(str, maybe) <- get
put (mempty, maybe)
gen
(str', maybe') <- get
put (str `mappend` app str', maybe')
reset :: Generator c a ()
reset = do
(str, _) <- get
put (str, Nothing)
raw :: Monoid a
=> a
-> Generator c a ()
raw str' = do
(str, maybePrev) <- get
put (str `mappend` str', maybePrev)
atom :: forall c a. (Monoid a, GenConf c a)
=> Ast.Atom a
-> Generator c a ()
atom text = do
(str, maybePrev) <- get
let typo = typography @c
let ptrSpace = printSpace @c
case maybePrev of
Just prev ->
let
spc = (ptrSpace $ max (afterAtom typo prev) (beforeAtom typo text))
str' = spc `mappend` normalizeAtom typo text
in
put (str `mappend` str', Just text)
Nothing -> put (str `mappend` normalizeAtom typo text, Just text)
maybeAtom :: (Monoid a, GenConf c a)
=> Maybe (Ast.Atom a)
-> Generator c a ()
maybeAtom (Just text) = atom text
maybeAtom Nothing = return ()
atoms :: (Monoid a, GenConf c a)
=> [Ast.Atom a]
-> Generator c a ()
atoms (f:rst) = do
atom f
atoms rst
atoms [] = return ()
format :: forall c a. (Monoid a, GenConf c a)
=> Ast.Format a
-> Generator c a ()
format (Ast.Raw as) = atoms as
format (Ast.Emph fs) = apply (emphTemplate @c) (formats fs)
format (Ast.StrongEmph fs) = apply (strongEmphTemplate @c) (formats fs)
format (Ast.Quote fs) = do
atom $ Ast.Punctuation Ast.OpenQuote
formats fs
atom $ Ast.Punctuation Ast.CloseQuote
formats :: (Monoid a, GenConf c a)
=> [Ast.Format a]
-> Generator c a ()
formats (f:rst) = do
format f
formats rst
formats [] = return ()
reply :: forall c a. (Monoid a, GenConf c a)
=> Maybe (Ast.Atom a)
-> Maybe (Ast.Atom a)
-> Ast.Reply a
-> Generator c a ()
reply begin end (Ast.Simple d) = do
maybeAtom begin
apply (replyTemplate @c) (formats d)
maybeAtom end
reply begin end (Ast.WithSay d ws d') = do
maybeAtom begin
apply (replyTemplate @c) (formats d)
case d' of [] -> do
maybeAtom end
formats ws
l -> do
formats ws
apply (replyTemplate @c) (formats d')
maybeAtom end
component :: forall c a. (Monoid a, GenConf c a)
=> Bool
-> Bool
-> Ast.Component a
-> Generator c a()
component p n (Ast.Dialogue d a) = do
let typo = typography @c
let auth = authorNormalize @c
let temp = dialogueTemplate @c
let
open = openDialogue typo
close = closeDialogue typo
apply (temp $ auth a) (reply (Ast.Punctuation <$> open p) (Ast.Punctuation <$> close n) d)
component p n (Ast.Thought d a) = do
let auth = authorNormalize @c
let temp = thoughtTemplate @c
apply (temp $ auth a) (reply Nothing Nothing d)
component p n (Ast.Teller fs) = formats fs
component p n (Ast.IllFormed ws) = apply (errorTemplate @c) (raw ws)
paragraph :: forall c a. (Monoid a, GenConf c a)
=> Ast.Paragraph a
-> Generator c a ()
paragraph l@(h:r) = do
let temp = paragraphTemplate @c
let between = betweenDialogue @c
apply temp (recGen between False (willBeDialogue l) l)
where
isDialogue (Ast.Dialogue _ _) = True
isDialogue _ = False
willBeDialogue (h:n:r) = isDialogue n
willBeDialogue _ = False
recGen :: (Monoid a, GenConf c a)
=> a
-> Bool
-> Bool
-> [Ast.Component a]
-> Generator c a ()
recGen between p n (c:rst) = do
case (p, isDialogue c) of (True, True) -> do raw between
reset
_ -> return ()
component p n c
recGen between (isDialogue c) (willBeDialogue rst) rst
recGen _ _ _ [] = return ()
paragraphs :: (Monoid a, GenConf c a)
=> [Ast.Paragraph a]
-> Generator c a ()
paragraphs (h:r) = do paragraph h
reset
paragraphs r
paragraphs [] = return ()
section :: forall c a. (Monoid a, GenConf c a)
=> Ast.Section a
-> Generator c a ()
section (Ast.Story ps) = do let temp = storyTemplate @c
apply temp (paragraphs ps)
section (Ast.Aside cls ps) = do let temp = asideTemplate @c
apply (temp cls) (paragraphs ps)
section (Ast.Failing f) = do
let temp = errorTemplate @c
let temp2 = storyTemplate @c
apply (temp2 . temp) (raw f)
sections :: (Monoid a, GenConf c a)
=> [Ast.Section a]
-> Generator c a ()
sections (s:r) = do section s
sections r
sections [] = return ()
document :: forall c a. (Monoid a, GenConf c a)
=> Ast.Document a
-> Generator c a ()
document d = do let temp = documentTemplate @c
apply temp (sections d)