New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

GenConf becomes a typeclass #35

Merged
merged 3 commits into from Apr 16, 2016
Jump to file or symbol
Failed to load files and symbols.
+110 −60
Diff settings

Always

Just for now

Next

GenConfig becomes a typeclass

  • Loading branch information...
Iky
Iky committed Apr 15, 2016
commit 888a86dc139da0a3f81f2fded66354ceec5cb4c1
Copy path View file
@@ -29,8 +29,9 @@ import qualified Text.Ogmarkup.Private.Typography as Typo
-- | From a String, parse and generate an output according to a generation configuration.
-- The inner definitions of the parser and the generator implies the output
-- type has to be an instance of the 'IsString' and 'Monoid' classes.
ogmarkup :: (IsString a, Monoid a) => String
-> Conf.GenConf a
ogmarkup :: (IsString a, Monoid a, Conf.GenConf c a)
=> String
-> c
-> Either ParseError a
ogmarkup input conf = let res = Parser.parse Parser.document
""
@@ -1,28 +1,77 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
module Text.Ogmarkup.Private.Config where
import Data.Monoid
import Data.String
import Text.Ogmarkup.Private.Typography
type Template a = a -> a
-- | A data type to carry out the generation configuration. In
-- particular, it works well to define a Typography and some
-- marker such as HTML tags.
data GenConf a = GenConf { -- | The Typography to use for the generation
typography :: Typography a,
documentTemplate :: Template a,
errorTemplate :: Template a,
storyTemplate :: Template a,
asideTemplate :: Maybe a -> Template a,
paragraphTemplate :: Template a,
tellerTemplate :: Template a,
dialogueTemplate :: a -> Template a,
thoughtTemplate :: a -> Template a,
replyTemplate :: Template a,
betweenDialogue :: a,
emphTemplate :: Template a,
strongEmphTemplate :: Template a,
authorNormalize :: Maybe a -> a,
printSpace :: Space -> a }
class (IsString o, Monoid o) => GenConf c o | c -> o where
typography :: c
-> Typography o
typography _ = englishTypo
documentTemplate :: c
-> Template o
documentTemplate _ = id
errorTemplate :: c
-> Template o
errorTemplate _ = id
storyTemplate :: c
-> Template o
storyTemplate _ = id
asideTemplate :: c
-> Maybe o
-> Template o
asideTemplate _ _ = id
paragraphTemplate :: c
-> Template o
paragraphTemplate _ = id
tellerTemplate :: c
-> Template o
tellerTemplate _ = id
dialogueTemplate :: c
-> o
-> Template o
dialogueTemplate _ _ = id
thoughtTemplate :: c
-> o
-> Template o
thoughtTemplate _ _ = id
replyTemplate :: c
-> Template o
replyTemplate _ = id
betweenDialogue :: c
-> o
betweenDialogue _ = mempty
emphTemplate :: c
-> Template o
emphTemplate _ = id
strongEmphTemplate :: c
-> Template o
strongEmphTemplate _ = id
authorNormalize :: c
-> Maybe o
-> o
authorNormalize _ (Just auth) = auth
authorNormalize _ Nothing = mempty
printSpace :: c
-> Space
-> o
@@ -16,33 +16,33 @@ import Text.Ogmarkup.Private.Typography
-- | The 'Generator' Monad is eventually used to generate an output from a
-- given 'Ast.Document. Internally, it keeps track of the previous processed
-- 'Ast.Atom' in order to deal with atom separation.
newtype Generator a x = Generator { getState :: StateT (a, Maybe (Ast.Atom a)) (Reader (GenConf a)) x }
deriving (Functor, Applicative, Monad, MonadState (a, Maybe (Ast.Atom a)), MonadReader (GenConf a))
newtype Generator c a x = Generator { getState :: StateT (a, Maybe (Ast.Atom a)) (Reader c) x }
deriving (Functor, Applicative, Monad, MonadState (a, Maybe (Ast.Atom a)), MonadReader c)
-- | Run a 'Generator' monad and get the generated output. The output
-- type has to implement the class 'Monoid' because the 'Generator' monad
-- uses the 'mempty' constant as the initial state of the output and then
-- uses 'mappend' to expand the result as it process the generation.
runGenerator :: Monoid a
=> Generator a x -- ^ The 'Generator' to run
-> GenConf a -- ^ The configuration to use during the generation
-> a -- ^ The output
=> Generator c a x -- ^ The 'Generator' to run
-> c -- ^ The configuration to use during the generation
-> a -- ^ The output
runGenerator gen conf = fst $ runReader (execStateT (getState gen) (mempty, Nothing)) conf
-- * Low-level 'Generator's
-- | Retreive a configuration parameter. Let the output untouched.
askConf :: (GenConf a -> b) -- ^ The function to apply to the 'GenConf' variable
-- To retreive the wanted parameter.
-> Generator a b
askConf :: (c -> b) -- ^ The function to apply to the 'GenConf' variable
-- to retreive the wanted parameter.
-> Generator c a b
askConf f = f <$> ask
-- | Apply a template to the result of a given 'Generator' before appending it
-- to the previously generated output.
apply :: Monoid a
=> Template a -- ^ The 'Template' to apply.
-> Generator a x -- ^ The 'Generator' to run.
-> Generator a ()
-> Generator c a x -- ^ The 'Generator' to run.
-> Generator c a ()
apply app gen = do
(str, maybe) <- get
put (mempty, maybe)
@@ -52,15 +52,15 @@ apply app gen = do
-- | Forget about the past and consider the next 'Ast.Atom' is the
-- first to be processed.
reset :: Generator a ()
reset :: Generator c a ()
reset = do
(str, _) <- get
put (str, Nothing)
-- | Append a new sub-output to the generated output
raw :: Monoid a
=> a -- ^ A sub-output to append
-> Generator a ()
-> Generator c a ()
raw str' = do
(str, maybePrev) <- get
put (str `mappend` str', maybePrev)
@@ -70,9 +70,9 @@ raw str' = do
-- | Process an 'Ast.Atom' and deal with the space to use to separate it from
-- the paramter of the previous call (that is the previous processed
-- 'Ast.Atom').
atom :: Monoid a
atom :: (Monoid a, GenConf c a)
=> Ast.Atom a
-> Generator a ()
-> Generator c a ()
atom text = do
(str, maybePrev) <- get
typo <- askConf typography
@@ -88,25 +88,25 @@ atom text = do
Nothing -> put (str `mappend` normalizeAtom typo text, Just text)
-- | Call 'atom' if the parameter is not 'Nothing'. Otherwise, do nothing.
maybeAtom :: Monoid a
maybeAtom :: (Monoid a, GenConf c a)
=> Maybe (Ast.Atom a)
-> Generator a ()
-> Generator c a ()
maybeAtom (Just text) = atom text
maybeAtom Nothing = return ()
-- | Process a sequence of 'Ast.Atom'.
atoms :: Monoid a
atoms :: (Monoid a, GenConf c a)
=> [Ast.Atom a]
-> Generator a ()
-> Generator c a ()
atoms (f:rst) = do
atom f
atoms rst
atoms [] = return ()
-- | Process a 'Ast.Format'.
format :: Monoid a
format :: (Monoid a, GenConf c a)
=> Ast.Format a
-> Generator a ()
-> Generator c a ()
format (Ast.Raw as) = atoms as
@@ -126,20 +126,20 @@ format (Ast.Quote fs) = do
atom $ Ast.Punctuation Ast.CloseQuote
-- | Process a sequence of 'Ast.Format'.
formats :: Monoid a
formats :: (Monoid a, GenConf c a)
=> [Ast.Format a]
-> Generator a ()
-> Generator c a ()
formats (f:rst) = do
format f
formats rst
formats [] = return ()
-- | Process a 'Ast.Reply'.
reply :: Monoid a
reply :: (Monoid a, GenConf c a)
=> Maybe (Ast.Atom a)
-> Maybe (Ast.Atom a)
-> Ast.Reply a
-> Generator a ()
-> Generator c a ()
reply begin end (Ast.Simple d) = do
temp <- askConf replyTemplate
@@ -161,11 +161,11 @@ reply begin end (Ast.WithSay d ws d') = do
maybeAtom end
-- | Process a 'Ast.Component'.
component :: Monoid a
component :: (Monoid a, GenConf c a)
=> Bool -- ^ Was the last component an audible dialog?
-> Bool -- ^ Will the next component be an audible dialog?
-> Ast.Component a -- ^ The current to process.
-> Generator a ()
-> Generator c a ()
component p n (Ast.Dialogue d a) = do
typo <- askConf typography
auth <- askConf authorNormalize
@@ -188,9 +188,9 @@ component p n (Ast.IllFormed ws) = do
apply temp (raw ws)
-- | Process a 'Ast.Paragraph' and deal with sequence of 'Ast.Reply'.
paragraph :: Monoid a
paragraph :: (Monoid a, GenConf c a)
=> Ast.Paragraph a
-> Generator a ()
-> Generator c a ()
paragraph l@(h:r) = do
temp <- askConf paragraphTemplate
between <- askConf betweenDialogue
@@ -204,12 +204,12 @@ paragraph l@(h:r) = do
willBeDialogue (h:n:r) = isDialogue n
willBeDialogue _ = False
recGen :: Monoid a
recGen :: (Monoid a, GenConf c a)
=> a
-> Bool
-> Bool
-> [Ast.Component a]
-> Generator a ()
-> Generator c a ()
recGen between p n (c:rst) = do
case (p, isDialogue c) of (True, True) -> do raw between
reset
@@ -219,36 +219,36 @@ paragraph l@(h:r) = do
recGen _ _ _ [] = return ()
-- | Process a sequence of 'Ast.Paragraph'.
paragraphs :: Monoid a
paragraphs :: (Monoid a, GenConf c a)
=> [Ast.Paragraph a]
-> Generator a ()
-> Generator c a ()
paragraphs (h:r) = do paragraph h
reset
paragraphs r
paragraphs [] = return ()
-- | Process a 'Ast.Section'.
section :: Monoid a
section :: (Monoid a, GenConf c a)
=> Ast.Section a
-> Generator a ()
-> Generator c a ()
section (Ast.Story ps) = do temp <- askConf storyTemplate
apply temp (paragraphs ps)
section (Ast.Aside cls ps) = do temp <- askConf asideTemplate
apply (temp cls) (paragraphs ps)
-- | Process a sequence of 'Ast.Section'.
sections :: Monoid a
sections :: (Monoid a, GenConf c a)
=> [Ast.Section a]
-> Generator a ()
-> Generator c a ()
sections (s:r) = do section s
sections r
sections [] = return ()
-- | Process a 'Ast.Document', that is a complete Ogmarkup document
document :: Monoid a
document :: (Monoid a, GenConf c a)
=> Ast.Document a
-> Generator a ()
-> Generator c a ()
document d = do temp <- askConf documentTemplate
apply temp (sections d)
ProTip! Use n and p to navigate between commits in a pull request.