ogmarkup 3.1.0 → 4.0
raw patch · 11 files changed
+327/−292 lines, 11 filessetup-changed
Files
- Setup.hs +1/−1
- bench/Bench.hs +32/−21
- ogmarkup.cabal +9/−6
- src/Text/Ogmarkup.hs +33/−20
- src/Text/Ogmarkup/Private/Config.hs +33/−48
- src/Text/Ogmarkup/Private/Generator.hs +39/−55
- src/Text/Ogmarkup/Private/Parser.hs +85/−49
- src/Text/Ogmarkup/Private/Typography.hs +29/−29
- test/GeneratorSpec.hs +27/−27
- test/OgmarkupSpec.hs +27/−25
- test/ParserSpec.hs +12/−11
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple+import Distribution.Simple main = defaultMain
bench/Bench.hs view
@@ -1,30 +1,41 @@-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeSynonymInstances #-} -import Criterion.Main-import Text.Ogmarkup-import Data.Text (Text)-import Data.FileEmbed+import Criterion.Main+import Data.FileEmbed+import Data.Text (Text, append)+import Text.Ogmarkup -main = defaultMain [ bench "nf ogmarkup text -> text" $ nf (ogmarkup inputText) ConfText- , bench "whnf ogmarkup text -> text" $ whnf (ogmarkup inputText) ConfText- , bench "nf ogmarkup string -> string" $ nf (ogmarkup inputString) ConfString- , bench "whnf ogmarkup string -> string" $ whnf (ogmarkup inputString) ConfString+main = defaultMain+ [ bench "reference" $ nf (ogmarkup @ConfText) inputText+ , bgroup "complexity"+ [ bench "5" $ nf (ogmarkup @ConfText) inT5+ , bench "10" $ nf (ogmarkup @ConfText) inT10+ , bench "15" $ nf (ogmarkup @ConfText) inT15+ , bench "20" $ nf (ogmarkup @ConfText) inT20+ , bench "25" $ nf (ogmarkup @ConfText) inT25+ , bench "30" $ nf (ogmarkup @ConfText) inT30+ ]+ ]+ where app :: Monoid a => Int -> a -> a+ app 1 x = x+ app n x = x `mappend` app (n-1) x - ]+ !inT5 = app 5 inputText+ !inT10 = app 10 inputText+ !inT15 = app 15 inputText+ !inT20 = app 20 inputText+ !inT25 = app 25 inputText+ !inT30 = app 30 inputText -inputString :: String-inputString = $(embedFile "bench/test.up") inputText :: Text inputText = $(embedFile "bench/test.up") -data ConfText = ConfText+data ConfText instance GenConf ConfText Text where- printSpace _ _ = " "--data ConfString = ConfString-instance GenConf ConfString String where- printSpace _ _ = " "+ printSpace _ = " "
ogmarkup.cabal view
@@ -1,15 +1,18 @@ name: ogmarkup-version: 3.1.0+version: 4.0 cabal-version: >=1.10 build-type: Simple license: MIT license-file: LICENSE-copyright: 2016 Ogma Project+copyright: 2016 - 2017 Ogma Project maintainer: contact@thomasletan.fr-homepage: http://github.com/ogma-project/ogmarkup+homepage: https://nest.pijul.com/lthms/ogmarkup synopsis: A lightweight markup language for story writers description:- Please see README.md+ ogmarkup is a lightweight markup language for story+ writers. `ogmarkup` also refers to a haskell library that provides+ a generic conversion function to transform an ogmarkup document+ into a ready-to-publish document. category: Web author: Thomas Letan, Laurent Georget @@ -18,8 +21,8 @@ default: False source-repository head- type: git- location: https://github.com/ogma-project/ogmarkup+ type: pijul+ location: https://nest.pijul.com/lthms/ogmarkup library exposed-modules:
src/Text/Ogmarkup.hs view
@@ -11,15 +11,20 @@ stability. Be aware the exposed interface may change in future realase. -} -{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-} module Text.Ogmarkup ( -- * Parse and Generate ogmarkup,+ ogmarkup', -- * Generation Configuration Conf.GenConf (..),@@ -35,13 +40,14 @@ Typo.Space (..), ) where -import Data.String-import Data.List hiding (uncons)+import Data.List hiding (uncons) import Data.Monoid+import Data.Proxy (Proxy)+import Data.String import Text.Megaparsec -import qualified Text.Ogmarkup.Private.Config as Conf import qualified Text.Ogmarkup.Private.Ast as Ast+import qualified Text.Ogmarkup.Private.Config as Conf import qualified Text.Ogmarkup.Private.Generator as Gen import qualified Text.Ogmarkup.Private.Parser as Parser import qualified Text.Ogmarkup.Private.Typography as Typo@@ -49,23 +55,30 @@ -- | From a String, parse and generate an output according to a generation configuration. -- The inner definitions of the parser and the generator imply that the output -- type has to be an instance of the 'IsString' and 'Monoid' classes.-ogmarkup :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString a, Eq a, Monoid a, IsString b, Monoid b, Conf.GenConf c b)+ogmarkup :: forall c a b. (Stream a, Token a ~ Char, IsString (Tokens a), IsString b, Monoid b, Conf.GenConf c b) => a -- ^ The input string- -> c -- ^ The generator configuration -> b-ogmarkup input conf = case Parser.parse Parser.document "" input of- Right ast -> Gen.runGenerator (Gen.document $ merge ast) conf+ogmarkup input = case Parser.parse Parser.document "" input of+ Right ast -> Gen.runGenerator (Gen.document @c @b $ merge ast) Left _ -> error "failed to parse an ogmarkup document even with best effort"- where merge :: Ast.Document a -> Ast.Document a- merge ((Ast.Story x):rest) = (Ast.Story $ mergep x):rest- merge ((Ast.Aside cls x):rest) = (Ast.Aside cls (mergep x)):rest- merge (x:rest) = x:(merge rest)- merge [] = []+ where merge :: Ast.Document b -> Ast.Document b+ merge (Ast.Story x:rest) = (Ast.Story $ mergep x):rest+ merge (Ast.Aside cls x:rest) = Ast.Aside cls (mergep x):rest+ merge (x:rest) = x:merge rest+ merge [] = [] - mergep :: [Ast.Paragraph a] -> [Ast.Paragraph a]- mergep (x@(_:_):y@((Ast.Dialogue _ _):_):rest) =+ mergep :: [Ast.Paragraph b] -> [Ast.Paragraph b]+ mergep (x@(_:_):y@(Ast.Dialogue _ _:_):rest) = case last x of Ast.Dialogue _ _ -> mergep $ (x `mappend` y):rest- _ -> x:(mergep $ y:rest)- mergep (x:y:rest) = x:(mergep $ y:rest)+ _ -> x:mergep (y:rest)+ mergep (x:y:rest) = x:mergep (y:rest) mergep x = x++-- | If you don’t want to use the `TypeApplications` pragma, you can use this+-- functions insead (but of course, it itself uses the pragma)+ogmarkup' :: forall c a b. (Stream a, Token a ~ Char, IsString (Tokens a), IsString b, Monoid b, Conf.GenConf c b)+ => Proxy c+ -> a -- ^ The input string+ -> b+ogmarkup' _ = ogmarkup @c
src/Text/Ogmarkup/Private/Config.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-| Module : Text.Ogmarkup.Private.Config Copyright : (c) Ogma Project, 2016@@ -8,15 +9,14 @@ 'Text.Ogmarkup.Private.Generator's monad. -} -{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-} module Text.Ogmarkup.Private.Config where +import Data.Maybe import Data.Monoid import Data.String-import Data.Maybe import Text.Ogmarkup.Private.Typography -- | A 'Template' is just synonym for a template of one argument.@@ -45,35 +45,31 @@ -- 'Text.Ogmarkup.Private.Generator.Generator'. -- -- * __Default implementation:__ returns 'englishTypo'.- typography :: c- -> Typography o- typography _ = englishTypo+ typography :: Typography o+ typography = englishTypo -- | This template is used once the output has been completely generated. --- -- * __Layout:__ block + -- * __Layout:__ block -- * __Default implementation:__ the identity function- documentTemplate :: c- -> Template o- documentTemplate _ = id+ documentTemplate :: Template o+ documentTemplate = id -- | This template is used on the ill-formed portion of the ogmarkup -- document which have been ignored during the best-effort compilation. -- -- * __Layout:__ inline -- * __Default implementation:__ the identity function- errorTemplate :: c- -> Template o- errorTemplate _ = id+ errorTemplate :: Template o+ errorTemplate = id -- | This template is used on regular sections which focus on telling the -- story. -- -- * __Layout:__ block -- * __Default implementation:__ the identity function- storyTemplate :: c- -> Template o- storyTemplate _ = id+ storyTemplate :: Template o+ storyTemplate = id -- | This template is used on aside sections which may comprised -- flashbacks, letters or songs, for instance.@@ -81,27 +77,24 @@ -- * __Layout:__ block -- * __Default implementation:__ the identity function (it ignores the -- class name)- asideTemplate :: c- -> Maybe o -- ^ An optional class name+ asideTemplate :: Maybe o -- ^ An optional class name -> Template o- asideTemplate _ _ = id+ asideTemplate _ = id -- | This template is used on paragraphs within a section. -- -- * __Layout:__ block -- * __Default implementation:__ the identity function- paragraphTemplate :: c- -> Template o- paragraphTemplate _ = id+ paragraphTemplate :: Template o+ paragraphTemplate = id -- | This template is used on the narrative portion of an ogmarkup -- document. -- -- * __Layout:__ inline -- * __Default implementation:__ the identity function- tellerTemplate :: c- -> Template o- tellerTemplate _ = id+ tellerTemplate :: Template o+ tellerTemplate = id -- | This template is used on audible dialogue. The class name is -- mandatory even if the character name is optional for dialogues and@@ -111,10 +104,9 @@ -- -- * __Layout:__ inline -- * __Default implementation:__ the identity function- dialogueTemplate :: c- -> o -- ^ The class name produced by 'authorNormalize'+ dialogueTemplate :: o -- ^ The class name produced by 'authorNormalize' -> Template o- dialogueTemplate _ _ = id+ dialogueTemplate _ = id -- | This template is used on unaudible dialogue. See 'dialogueTemplate' to -- get more information on why the class name is not@@ -122,15 +114,13 @@ -- -- * __Layout:__ inline -- * __Default implementation:__ the identity function- thoughtTemplate :: c- -> o -- ^ The class name produced by 'authorNormalize'+ thoughtTemplate :: o -- ^ The class name produced by 'authorNormalize' -> Template o- thoughtTemplate _ _ = id+ thoughtTemplate _ = id -- __Default implementation:__ the identity function- replyTemplate :: c- -> Template o- replyTemplate _ = id+ replyTemplate :: Template o+ replyTemplate = id -- | Return a marker to insert between two consecutive dialogues. The -- default use case is to return the concatenation of the ending mark and@@ -139,36 +129,31 @@ -- -- * __Layout:__ inline -- * __Default implementation:__ `mempty`- betweenDialogue :: c- -> o- betweenDialogue _ = mempty+ betweenDialogue :: o+ betweenDialogue = mempty -- | A template to apply emphasis to an piece of text. -- -- __Default implementation:__ the identity function- emphTemplate :: c- -> Template o- emphTemplate _ = id+ emphTemplate :: Template o+ emphTemplate = id -- | A template to apply stong emphasis (often bold) to a piece of text. -- -- * __Layout:__ inline -- * __Default implementation:__ `mempty`- strongEmphTemplate :: c- -> Template o- strongEmphTemplate _ = id+ strongEmphTemplate :: Template o+ strongEmphTemplate = id -- | This function is called by a Generator to derive a class name for an -- optional character name. -- -- * __Default implementation:__ simply unwrap the Maybe value, if -- Nothing return 'mempty'.- authorNormalize :: c- -> Maybe o+ authorNormalize :: Maybe o -> o- authorNormalize _ = maybe mempty id+ authorNormalize = fromMaybe mempty -- | Generate an output from a 'Space'.- printSpace :: c- -> Space+ printSpace :: Space -> o
src/Text/Ogmarkup/Private/Generator.hs view
@@ -10,7 +10,10 @@ -} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module Text.Ogmarkup.Private.Generator where @@ -27,8 +30,8 @@ -- | 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 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)+newtype Generator c a x = Generator { getState :: State (a, Maybe (Ast.Atom a)) x }+ deriving (Functor, Applicative, Monad, MonadState (a, Maybe (Ast.Atom a))) -- | Run a 'Generator' monad and get the generated output. The output -- type has to implement the class 'Monoid' because the 'Generator' monad@@ -36,18 +39,11 @@ -- uses 'mappend' to expand the result as it processes the generation. runGenerator :: Monoid a => 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+ -> a -- ^ The output+runGenerator gen = fst $ execState (getState gen) (mempty, Nothing) -- * Low-level 'Generator's --- | Retrieve a configuration parameter. Let the output untouched.-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@@ -81,13 +77,13 @@ -- | Process an 'Ast.Atom' and deal with the space to use to separate it from -- the paramter of the previous call (that is the last processed -- 'Ast.Atom').-atom :: (Monoid a, GenConf c a)+atom :: forall c a. (Monoid a, GenConf c a) => Ast.Atom a -> Generator c a () atom text = do (str, maybePrev) <- get- typo <- askConf typography- ptrSpace <- askConf printSpace+ let typo = typography @c+ let ptrSpace = printSpace @c case maybePrev of Just prev ->@@ -103,7 +99,7 @@ => Maybe (Ast.Atom a) -> Generator c a () maybeAtom (Just text) = atom text-maybeAtom Nothing = return ()+maybeAtom Nothing = return () -- | Process a sequence of 'Ast.Atom'. atoms :: (Monoid a, GenConf c a)@@ -115,21 +111,15 @@ atoms [] = return () -- | Process a 'Ast.Format'.-format :: (Monoid a, GenConf c a)+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) = do- temp <- askConf emphTemplate-- apply temp (formats fs)--format (Ast.StrongEmph fs) = do- temp <- askConf strongEmphTemplate+format (Ast.Emph fs) = apply (emphTemplate @c) (formats fs) - apply temp (formats fs)+format (Ast.StrongEmph fs) = apply (strongEmphTemplate @c) (formats fs) format (Ast.Quote fs) = do atom $ Ast.Punctuation Ast.OpenQuote@@ -146,41 +136,37 @@ formats [] = return () -- | Process a 'Ast.Reply'.-reply :: (Monoid a, GenConf c a)+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- temp <- askConf replyTemplate- maybeAtom begin- apply temp (formats d)+ apply (replyTemplate @c) (formats d) maybeAtom end reply begin end (Ast.WithSay d ws d') = do- temp <- askConf replyTemplate- maybeAtom begin- apply temp (formats d)+ apply (replyTemplate @c) (formats d) case d' of [] -> do maybeAtom end formats ws l -> do formats ws- apply temp (formats d')+ apply (replyTemplate @c) (formats d') maybeAtom end -- | Process a 'Ast.Component'.-component :: (Monoid a, GenConf c a)+component :: forall c a. (Monoid a, GenConf c a) => Bool -- ^ Was the last component a piece of dialog? -> Bool -- ^ Will the next component be a piece of dialog? -> Ast.Component a -- ^ The current component to process -> Generator c a () component p n (Ast.Dialogue d a) = do- typo <- askConf typography- auth <- askConf authorNormalize- temp <- askConf dialogueTemplate+ let typo = typography @c+ let auth = authorNormalize @c+ let temp = dialogueTemplate @c let open = openDialogue typo@@ -189,31 +175,29 @@ apply (temp $ auth a) (reply (Ast.Punctuation <$> open p) (Ast.Punctuation <$> close n) d) component p n (Ast.Thought d a) = do- auth <- askConf authorNormalize- temp <- askConf thoughtTemplate+ 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) = do- temp <- askConf errorTemplate- apply temp (raw ws)+component p n (Ast.IllFormed ws) = apply (errorTemplate @c) (raw ws) -- | Process a 'Ast.Paragraph' and deal with sequence of 'Ast.Reply'.-paragraph :: (Monoid a, GenConf c a)+paragraph :: forall c a. (Monoid a, GenConf c a) => Ast.Paragraph a -> Generator c a () paragraph l@(h:r) = do- temp <- askConf paragraphTemplate- between <- askConf betweenDialogue+ let temp = paragraphTemplate @c+ let between = betweenDialogue @c apply temp (recGen between False (willBeDialogue l) l) where isDialogue (Ast.Dialogue _ _) = True- isDialogue _ = False+ isDialogue _ = False willBeDialogue (h:n:r) = isDialogue n- willBeDialogue _ = False+ willBeDialogue _ = False recGen :: (Monoid a, GenConf c a) => a@@ -239,18 +223,18 @@ paragraphs [] = return () -- | Process a 'Ast.Section'.-section :: (Monoid a, GenConf c a)+section :: forall c a. (Monoid a, GenConf c a) => Ast.Section a -> Generator c a ()-section (Ast.Story ps) = do temp <- askConf storyTemplate+section (Ast.Story ps) = do let temp = storyTemplate @c apply temp (paragraphs ps)-section (Ast.Aside cls ps) = do temp <- askConf asideTemplate+section (Ast.Aside cls ps) = do let temp = asideTemplate @c apply (temp cls) (paragraphs ps) section (Ast.Failing f) = do- temp <- askConf errorTemplate- temp2 <- askConf storyTemplate+ let temp = errorTemplate @c+ let temp2 = storyTemplate @c apply (temp2 . temp) (raw f) -- | Process a sequence of 'Ast.Section'.@@ -262,9 +246,9 @@ sections [] = return () -- | Process a 'Ast.Document', that is a complete Ogmarkup document.-document :: (Monoid a, GenConf c a)- => Ast.Document a+document :: forall c a. (Monoid a, GenConf c a)+ => Ast.Document a -> Generator c a ()-document d = do temp <- askConf documentTemplate+document d = do let temp = documentTemplate @c apply temp (sections d)
src/Text/Ogmarkup/Private/Parser.hs view
@@ -11,28 +11,28 @@ module. -} -{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-} module Text.Ogmarkup.Private.Parser where -import Text.Megaparsec-import Text.Megaparsec.Char import Control.Monad.State import Data.String-import Data.Void (Void)+import Data.Void (Void)+import Text.Megaparsec+import Text.Megaparsec.Char -import qualified Text.Ogmarkup.Private.Ast as Ast+import qualified Text.Ogmarkup.Private.Ast as Ast -- | Keep track of the currently opened formats. data ParserState = ParserState { -- | Already parsing text with emphasis- parseWithEmph :: Bool+ parseWithEmph :: Bool -- | Already parsing text with strong -- emphasis- , parseWithStrongEmph :: Bool+ , parseWithStrongEmph :: Bool -- | Already parsing a quote- , parseWithinQuote :: Bool+ , parseWithinQuote :: Bool } -- | An ogmarkup parser processes 'Char' tokens and carries a 'ParserState'.@@ -102,12 +102,12 @@ -- | A wrapper around the 'runParser' function of Megaparsec. It uses -- 'initParserState' as an initial state.-parse :: (Stream a, Token a ~ Char, IsString (Tokens a))+parse :: Stream a => OgmarkupParser a b -> String -> a -> Either (ParseError (Token a) Void) b-parse ogma file = runParser (evalStateT ogma initParserState) file+parse ogma = runParser (evalStateT ogma initParserState) -- | Try its best to parse an ogmarkup document. When it encounters an -- error, it returns an Ast and the remaining input.@@ -130,12 +130,12 @@ recover ast = do failure <- someTill anyChar (char '\n') return $ ast `mappend` [Ast.Failing $ fromString failure] -- | See 'Ast.Section'.-section :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+section :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Section b) section = aside <|> story -- | See 'Ast.Aside'.-aside :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+aside :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Section b) aside = do asideSeparator cls <- optional asideClass@@ -147,7 +147,7 @@ return $ Ast.Aside cls ps where- asideClass :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+ asideClass :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a b asideClass = do cls <- some letterChar asideSeparator@@ -155,29 +155,29 @@ return $ fromString cls -- | See 'Ast.Story'.-story :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+story :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Section b) story = Ast.Story `fmap` some (paragraph <* space) -- | See 'Ast.Paragraph'.-paragraph :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+paragraph :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Paragraph b) paragraph = some component <* blank -- | See 'Ast.Component'.-component :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+component :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Component b) component = try (dialogue <|> thought <|> teller) <|> illformed -- | See 'Ast.IllFormed'.-illformed :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+illformed :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Component b) illformed = Ast.IllFormed `fmap` restOfParagraph -- | Parse the rest of the current paragraph with no regards for the -- ogmarkup syntax. This Parser is used when the document is ill-formed, to -- find a new point of synchronization.-restOfParagraph :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+restOfParagraph :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a b restOfParagraph = do lookAhead anyChar notFollowedBy endOfParagraph@@ -185,23 +185,23 @@ return $ fromString str -- | See 'Ast.Teller'.-teller :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+teller :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Component b) teller = Ast.Teller `fmap` some format -- | See 'Ast.Dialogue'.-dialogue :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+dialogue :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Component b) dialogue = talk '[' ']' Ast.Dialogue -- | See 'Ast.Thought'.-thought :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+thought :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Component b) thought = talk '<' '>' Ast.Thought -- | @'talk' c c' constr@ wraps a reply surrounded by @c@ and @c'@ inside -- @constr@ (either 'Ast.Dialogue' or 'Ast.Thought').-talk :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+talk :: (Stream a, Token a ~ Char, IsString b) => Char -- ^ A character to mark the begining of a reply -> Char -- ^ A character to mark the end of a reply -> (Ast.Reply b -> Maybe b -> Ast.Component b) -- ^ Either 'Ast.Dialogue' or 'Ast.Thought' according to the situation@@ -215,7 +215,7 @@ -- | Parse the name of the character which speaks or thinks. According to -- the ogmarkup syntax, it is surrounded by parentheses.-characterName :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+characterName :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a b characterName = do char '('@@ -225,7 +225,7 @@ return $ fromString auth -- | 'reply' parses a 'Ast.Reply'.-reply :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+reply :: (Stream a, Token a ~ Char, IsString b) => Char -> Char -> OgmarkupParser a (Ast.Reply b)@@ -245,7 +245,7 @@ _ -> return $ Ast.Simple p1 -- | See 'Ast.Format'.-format :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+format :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Format b) format = choice [ raw , emph@@ -254,12 +254,12 @@ ] -- | See 'Ast.Raw'.-raw :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+raw :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Format b) raw = Ast.Raw `fmap` some atom -- | See 'Ast.Emph'.-emph :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+emph :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Format b) emph = do char '*' blank@@ -270,7 +270,7 @@ return . Ast.Emph $ (f:fs) -- | See 'Ast.StrongEmph'.-strongEmph :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+strongEmph :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Format b) strongEmph = do char '+' blank@@ -281,7 +281,7 @@ return . Ast.StrongEmph $ (f:fs) -- | See 'Ast.Quote'.-quote :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+quote :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Format b) quote = do openQuote enterQuote@@ -291,24 +291,54 @@ return . Ast.Quote $ (f:fs) -- | See 'Ast.Atom'.-atom :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+atom :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Atom b) atom = (word <|> mark <|> longword) <* blank+{-# INLINE atom #-} -- | See 'Ast.Word'. This parser does not consume the following spaces, so -- the caller needs to take care of it.-word :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+word :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Atom b) word = do notFollowedBy endOfWord str <- manyTill anyChar (lookAhead $ try endOfWord) return $ Ast.Word (fromString str) where- endOfWord :: (Stream a, Token a ~ Char, IsString (Tokens a))+ endOfWord :: (Stream a, Token a ~ Char) => OgmarkupParser a ()- endOfWord = eof <|> (skip spaceChar) <|> (skip $ oneOf specChar)- specChar = "\"«»`+*[]<>|_\'’.,;-–—!?:"+ endOfWord = eof <|> skip spaceChar <|> skip (satisfy specChar) + specChar :: Char -> Bool+ specChar x =+ case x of+ '"' -> True+ '«' -> True+ '»' -> True+ '`' -> True+ '+' -> True+ '*' -> True+ '[' -> True+ ']' -> True+ '<' -> True+ '>' -> True+ '|' -> True+ '_' -> True+ '\'' -> True+ '’' -> True+ '.' -> True+ ',' -> True+ ';' -> True+ '-' -> True+ '–' -> True+ '—' -> True+ '!' -> True+ '?' -> True+ ':' -> True+ _ -> False +{-# INLINE word #-}++ -- | Wrap a raw string surrounded by @`@ inside a 'Ast.Word'. -- -- >>> parse longword "" "`test *ei*`"@@ -316,16 +346,17 @@ -- -- Therefore, @`@ can be used to insert normally reserved symbol -- inside a generated document.-longword :: (Stream a, Token a ~ Char, IsString (Tokens a), IsString b)+longword :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Atom b) longword = do char '`' notFollowedBy (char '`') str <- manyTill anyChar (char '`') return $ Ast.Word (fromString str)+{-# INLINE longword #-} -- | See 'Ast.Punctuation'. Be aware that 'mark' does not parse the quotes -- because they are processed 'quote'.-mark :: (Stream a, Token a ~ Char, IsString (Tokens a))+mark :: (Stream a, Token a ~ Char) => OgmarkupParser a (Ast.Atom b) mark = Ast.Punctuation `fmap` (semicolon <|> colon@@ -345,24 +376,25 @@ colon = parseMark (char ':') Ast.Colon question = parseMark (char '?') Ast.Question exclamation = parseMark (char '!') Ast.Exclamation- longDash = parseMark (string "—" <|> string "---") Ast.LongDash- dash = parseMark (string "–" <|> string "--") Ast.Dash+ longDash = parseMark (char '—' <|> (char '-' >> char '-' >> char '-')) Ast.LongDash+ dash = parseMark (char '–' <|> (char '-' >> char '-')) Ast.Dash hyphen = parseMark (char '-') Ast.Hyphen comma = parseMark (char ',') Ast.Comma point = parseMark (char '.') Ast.Point apostrophe = parseMark (char '\'' <|> char '’') Ast.Apostrophe- suspensionPoints = parseMark (string ".." >> many (char '.')) Ast.SuspensionPoints+ suspensionPoints = parseMark (char '.' >> char '.' >> many (char '.')) Ast.SuspensionPoints+{-# INLINE mark #-} -- | See 'Ast.OpenQuote'. This parser consumes the following blank (see 'blank') -- and skip the result.-openQuote :: (Stream a, Token a ~ Char, IsString (Tokens a))+openQuote :: (Stream a, Token a ~ Char) => OgmarkupParser a () openQuote = do char '«' <|> char '"' blank -- | See 'Ast.CloseQuote'. This parser consumes the following blank (see 'blank') -- and skip the result.-closeQuote :: (Stream a, Token a ~ Char, IsString (Tokens a))+closeQuote :: (Stream a, Token a ~ Char) => OgmarkupParser a () closeQuote = do char '»' <|> char '"' blank@@ -370,32 +402,35 @@ -- | An aside section (see 'Ast.Aside') is a particular region -- surrounded by two lines of underscores (at least three). -- This parser consumes one such line.-asideSeparator :: (Stream a, Token a ~ Char, IsString (Tokens a))+asideSeparator :: (Stream a, Token a ~ Char) => OgmarkupParser a ()-asideSeparator = do string "__"- some (char '_')+asideSeparator = do char '_'+ char '_'+ takeWhile1P Nothing (== '_') return () -- | The end of a paragraph is the end of the document or two blank lines -- or an aside separator, that is a line of underscores.-endOfParagraph :: (Stream a, Token a ~ Char, IsString (Tokens a))+endOfParagraph :: (Stream a, Token a ~ Char) => OgmarkupParser a () endOfParagraph = try betweenTwoSections <|> asideSeparator <|> eof where- betweenTwoSections :: (Stream a, Token a ~ Char, IsString (Tokens a))+ betweenTwoSections :: (Stream a, Token a ~ Char) => OgmarkupParser a () betweenTwoSections = do count 2 $ manyTill spaceChar (eof <|> skip (char '\n')) space+{-# INLINE endOfParagraph #-} -- | This parser consumes all the white spaces until it finds either an aside -- surrounding marker (see 'Ast.Aside'), the end of the document or -- one blank line. The latter marks the end of the current paragraph.-blank :: (Stream a, Token a ~ Char, IsString (Tokens a))+blank :: (Stream a, Token a ~ Char) => OgmarkupParser a ()-blank = do skip $ optional (notFollowedBy endOfParagraph >> space)+blank = skip $ optional (notFollowedBy endOfParagraph >> space)+{-# INLINE blank #-} -- | @skip p@ parses @p@ and skips the result.@@ -403,3 +438,4 @@ => OgmarkupParser a b -> OgmarkupParser a () skip = (>> return ())+{-# INLINE skip #-}
src/Text/Ogmarkup/Private/Typography.hs view
@@ -61,7 +61,7 @@ -> Ast.Atom a -> Space beforeAtom t (Ast.Punctuation m) = case decide t m of (r, _, _) -> r-beforeAtom t _ = Normal+beforeAtom t _ = Normal -- | From a Typography, it gives the space to privilege after the -- input Text.@@ -69,14 +69,14 @@ -> Ast.Atom a -> Space afterAtom t (Ast.Punctuation m) = case decide t m of (_, r, _) -> r-afterAtom t _ = Normal+afterAtom t _ = Normal -- | Normalize the input in order to add it to a generated Text. normalizeAtom :: Typography a -> Ast.Atom a -> a normalizeAtom t (Ast.Punctuation m) = case decide t m of (_, _, r) -> r-normalizeAtom t (Ast.Word w) = w+normalizeAtom t (Ast.Word w) = w -- * Ready-to-use Typography @@ -87,24 +87,24 @@ frenchTypo = Typography t prevT nextT where t :: IsString a => Ast.Mark -> (Space, Space, a)- t Ast.Semicolon = (Nbsp, Normal, ";")- t Ast.Colon = (Nbsp, Normal, ":")- t Ast.OpenQuote = (Normal, Nbsp, "«")- t Ast.CloseQuote = (Nbsp, Normal, "»")- t Ast.Question = (Nbsp, Normal, "?")- t Ast.Exclamation = (Nbsp, Normal, "!")- t Ast.LongDash = (Normal, Normal, "—")- t Ast.Dash = (None, None, "–")- t Ast.Hyphen = (None, None, "-")- t Ast.Comma = (None, Normal, ",")- t Ast.Point = (None, Normal, ".")- t Ast.Apostrophe = (None, None, "’")+ t Ast.Semicolon = (Nbsp, Normal, ";")+ t Ast.Colon = (Nbsp, Normal, ":")+ t Ast.OpenQuote = (Normal, Nbsp, "«")+ t Ast.CloseQuote = (Nbsp, Normal, "»")+ t Ast.Question = (Nbsp, Normal, "?")+ t Ast.Exclamation = (Nbsp, Normal, "!")+ t Ast.LongDash = (Normal, Normal, "—")+ t Ast.Dash = (None, None, "–")+ t Ast.Hyphen = (None, None, "-")+ t Ast.Comma = (None, Normal, ",")+ t Ast.Point = (None, Normal, ".")+ t Ast.Apostrophe = (None, None, "’") t Ast.SuspensionPoints = (None, Normal, "…") - prevT True = Just Ast.LongDash+ prevT True = Just Ast.LongDash prevT False = Just Ast.OpenQuote - nextT True = Nothing+ nextT True = Nothing nextT False = Just Ast.CloseQuote -- | A proposal for the English typography. It can be used with several generation@@ -114,16 +114,16 @@ englishTypo = Typography t (pure $ Just Ast.OpenQuote) (pure $ Just Ast.CloseQuote) where t :: IsString a => Ast.Mark -> (Space, Space, a)- t Ast.Semicolon = (None, Normal, ";")- t Ast.Colon = (None, Normal, ":")- t Ast.OpenQuote = (Normal, None, "“")- t Ast.CloseQuote = (None, Normal, "”")- t Ast.Question = (None, Normal, "?")- t Ast.Exclamation = (None, Normal, "!")- t Ast.LongDash = (Normal, None, "—")- t Ast.Dash = (None, None, "–")- t Ast.Hyphen = (None, None, "-")- t Ast.Comma = (None, Normal, ",")- t Ast.Point = (None, Normal, ".")- t Ast.Apostrophe = (None, None, "'")+ t Ast.Semicolon = (None, Normal, ";")+ t Ast.Colon = (None, Normal, ":")+ t Ast.OpenQuote = (Normal, None, "“")+ t Ast.CloseQuote = (None, Normal, "”")+ t Ast.Question = (None, Normal, "?")+ t Ast.Exclamation = (None, Normal, "!")+ t Ast.LongDash = (Normal, None, "—")+ t Ast.Dash = (None, None, "–")+ t Ast.Hyphen = (None, None, "-")+ t Ast.Comma = (None, Normal, ",")+ t Ast.Point = (None, Normal, ".")+ t Ast.Apostrophe = (None, None, "'") t Ast.SuspensionPoints = (None, Normal, "…")
test/GeneratorSpec.hs view
@@ -1,12 +1,13 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeApplications #-} module GeneratorSpec where -import Text.Shakespeare.Text import Data.Maybe+import Text.Shakespeare.Text import Data.Text (Text) import Test.Hspec@@ -18,52 +19,51 @@ import qualified Text.Ogmarkup.Private.Generator as Gen spec :: Spec-spec = do describe "format" $ do+spec = do describe "format" $ it "should deal with raw input" $- Gen.runGenerator (Gen.format sentence) TestConf+ Gen.runGenerator (Gen.format @TestConf sentence) `shouldBe` "Bonjour toi." - describe "component" $ do+ describe "component" $ it "should deal with thought" $- Gen.runGenerator (Gen.component False False (Ast.Thought simpleReply Nothing))- TestConf+ Gen.runGenerator (Gen.component @TestConf False False (Ast.Thought simpleReply Nothing)) `shouldBe` "[thou-anonymous][reply]Bonjour toi.[/reply][/thou-anonymous]" -data TestConf = TestConf+data TestConf instance GenConf TestConf Text where- typography _ = frenchTypo+ typography = frenchTypo - documentTemplate _ doc = [st|[doc]#{doc}[/doc]|]+ documentTemplate doc = [st|[doc]#{doc}[/doc]|] - errorTemplate _ err = [st|[error]#{err}[/error]|]+ errorTemplate err = [st|[error]#{err}[/error]|] - storyTemplate _ story = [st|[story]#{story}[/story]|]+ storyTemplate story = [st|[story]#{story}[/story]|] - asideTemplate _ (Just cls) aside = [st|[aside-#{cls}]#{aside}[/aside-#{cls}]|]- asideTemplate _ _ aside = [st|[aside]#{aside}[/aside]|]+ asideTemplate (Just cls) aside = [st|[aside-#{cls}]#{aside}[/aside-#{cls}]|]+ asideTemplate _ aside = [st|[aside]#{aside}[/aside]|] - paragraphTemplate _ par = [st|[par]#{par}[/par]|]+ paragraphTemplate par = [st|[par]#{par}[/par]|] - tellerTemplate _ teller = [st|[tell]#{teller}[/tell]|]+ tellerTemplate teller = [st|[tell]#{teller}[/tell]|] - dialogueTemplate _ auth dial = [st|[dial-#{auth}]#{dial}[/dial-#{auth}]|]+ dialogueTemplate auth dial = [st|[dial-#{auth}]#{dial}[/dial-#{auth}]|] - thoughtTemplate _ auth thou = [st|[thou-#{auth}]#{thou}[/thou-#{auth}]|]+ thoughtTemplate auth thou = [st|[thou-#{auth}]#{thou}[/thou-#{auth}]|] - replyTemplate _ rep = [st|[reply]#{rep}[/reply]|]+ replyTemplate rep = [st|[reply]#{rep}[/reply]|] - betweenDialogue _ = "[br]"+ betweenDialogue = "[br]" - emphTemplate _ txt = [st|[em]#{txt}[/em]|]+ emphTemplate txt = [st|[em]#{txt}[/em]|] - strongEmphTemplate _ txt = [st|[strong]#{txt}[/strong]|]+ strongEmphTemplate txt = [st|[strong]#{txt}[/strong]|] - authorNormalize _ = maybe "anonymous" id+ authorNormalize = fromMaybe "anonymous" - printSpace _ None = ""- printSpace _ Normal = " "- printSpace _ Nbsp = "_"+ printSpace None = ""+ printSpace Normal = " "+ printSpace Nbsp = "_" sentence :: Ast.Format Text sentence = Ast.Raw [ Ast.Word "Bonjour"
test/OgmarkupSpec.hs view
@@ -1,24 +1,26 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeApplications #-} module OgmarkupSpec where -import Data.Text (Text)+import Data.Maybe (fromMaybe)+import Data.Text (Text) import Test.Hspec import Text.Shakespeare.Text import Text.Ogmarkup spec :: Spec-spec = do+spec = describe "ogmarkup" $ do it "should merge paragraphs with consecutive dialogues" $- ogmarkup consecutiveDialogues TestConf `shouldBe`+ ogmarkup @TestConf consecutiveDialogues `shouldBe` "[doc][story][par][dial-anonymous]“[reply]This is a test.[/reply]”[/dial-anonymous][br][dial-anonymous]“[reply]May it works.[/reply]”[/dial-anonymous][/par][/story][/doc]" it "should not merge other paragraphs" $- ogmarkup notConsecutiveDialogues TestConf `shouldBe`+ ogmarkup @TestConf notConsecutiveDialogues `shouldBe` "[doc][story][par][dial-anonymous]“[reply]This is a test.[/reply]”[/dial-anonymous][/par][par]May it works.[/par][/story][/doc]" @@ -28,38 +30,38 @@ notConsecutiveDialogues :: Text notConsecutiveDialogues = "[This is a test.]\n\nMay it works." -data TestConf = TestConf+data TestConf instance GenConf TestConf Text where- typography _ = englishTypo+ typography = englishTypo - documentTemplate _ doc = [st|[doc]#{doc}[/doc]|]+ documentTemplate doc = [st|[doc]#{doc}[/doc]|] - errorTemplate _ err = [st|[error]#{err}[/error]|]+ errorTemplate err = [st|[error]#{err}[/error]|] - storyTemplate _ story = [st|[story]#{story}[/story]|]+ storyTemplate story = [st|[story]#{story}[/story]|] - asideTemplate _ (Just cls) aside = [st|[aside-#{cls}]#{aside}[/aside-#{cls}]|]- asideTemplate _ _ aside = [st|[aside]#{aside}[/aside]|]+ asideTemplate (Just cls) aside = [st|[aside-#{cls}]#{aside}[/aside-#{cls}]|]+ asideTemplate _ aside = [st|[aside]#{aside}[/aside]|] - paragraphTemplate _ par = [st|[par]#{par}[/par]|]+ paragraphTemplate par = [st|[par]#{par}[/par]|] - tellerTemplate _ teller = [st|[tell]#{teller}[/tell]|]+ tellerTemplate teller = [st|[tell]#{teller}[/tell]|] - dialogueTemplate _ auth dial = [st|[dial-#{auth}]#{dial}[/dial-#{auth}]|]+ dialogueTemplate auth dial = [st|[dial-#{auth}]#{dial}[/dial-#{auth}]|] - thoughtTemplate _ auth thou = [st|[thou-#{auth}]#{thou}[/thou-#{auth}]|]+ thoughtTemplate auth thou = [st|[thou-#{auth}]#{thou}[/thou-#{auth}]|] - replyTemplate _ rep = [st|[reply]#{rep}[/reply]|]+ replyTemplate rep = [st|[reply]#{rep}[/reply]|] - betweenDialogue _ = "[br]"+ betweenDialogue = "[br]" - emphTemplate _ txt = [st|[em]#{txt}[/em]|]+ emphTemplate txt = [st|[em]#{txt}[/em]|] - strongEmphTemplate _ txt = [st|[strong]#{txt}[/strong]|]+ strongEmphTemplate txt = [st|[strong]#{txt}[/strong]|] - authorNormalize _ = maybe "anonymous" id+ authorNormalize = fromMaybe "anonymous" - printSpace _ None = ""- printSpace _ Normal = " "- printSpace _ Nbsp = "_"+ printSpace None = ""+ printSpace Normal = " "+ printSpace Nbsp = "_"
test/ParserSpec.hs view
@@ -1,21 +1,22 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies #-} module ParserSpec where import Data.Either+import Data.Void (Void) import Test.Hspec import Test.Hspec.Megaparsec import Text.Megaparsec -import qualified Text.Ogmarkup.Private.Ast as Ast-import qualified Text.Ogmarkup.Private.Parser as Parser+import qualified Text.Ogmarkup.Private.Ast as Ast+import qualified Text.Ogmarkup.Private.Parser as Parser parse' :: (Show b, Eq b) => Parser.OgmarkupParser String b -> String -> String- -> Either (ParseError Char Dec) b+ -> Either (ParseError Char Void) b parse' = Parser.parse spec :: Spec@@ -32,7 +33,7 @@ it "should parse one quote" $ parse' Parser.format "" quoteStr `shouldParse` quoteFormat - it "should support french quotes" $ do+ it "should support french quotes" $ parse' Parser.format "" frenchQuoteStr `shouldParse` frenchQuoteFormat it "should fail if the quote is ill-formed (no closing quote)" $@@ -45,16 +46,16 @@ parse' Parser.format "" `shouldFailOn` nestedEmphStr parse' Parser.format "" `shouldFailOn` nestedStrongEmphStr - describe "reply" $ do+ describe "reply" $ it "should accept spaces at the beginning of dialogs" $ do parse' (Parser.reply '[' ']') "" dialogStartingWithSpaceStr `shouldParse` dialogStartingWithSpaceReply parse' (Parser.reply '[' ']') "" clauseStartingWithSpaceStr `shouldParse` clauseStartingWithSpaceReply describe "section" $ do- it "should parse aside with class" $ do+ it "should parse aside with class" $ parse' Parser.section "" asideWithClassStr `shouldParse` asideWithClassAst - it "should parse aside without class" $ do+ it "should parse aside without class" $ parse' Parser.section "" asideWithoutClassStr `shouldParse` asideWithoutClassAst describe "ill-formed paragraphs" $ do@@ -62,11 +63,11 @@ parse' Parser.component "" illQuoteStr `shouldParse` Ast.IllFormed illQuoteStr parse' Parser.component "" nestedEmphStr `shouldParse` Ast.IllFormed nestedEmphStr parse' Parser.component "" nestedStrongEmphStr `shouldParse` Ast.IllFormed nestedStrongEmphStr- it "an ill-formed paragraph should not prevent parsing correctly the others" $ do+ it "an ill-formed paragraph should not prevent parsing correctly the others" $ parse' Parser.story "" secondParagraphIllFormed `shouldParse` secondParagraphIllFormedPartialCompilation - describe "document" $ do- it "should try its best to compile an ill-formed document" $ do+ describe "document" $+ it "should try its best to compile an ill-formed document" $ parse' Parser.document "" (storyStr ++ "\n\n" ++ asideIllFormed) `shouldParse` [ storyAst , Ast.Failing "_______letter______"