ogmarkup 2.3 → 3.0.0
raw patch · 5 files changed
+238/−54 lines, 5 files
Files
- ogmarkup.cabal +4/−1
- src/Text/Ogmarkup.hs +13/−47
- src/Text/Ogmarkup/Private/Parser.hs +14/−6
- test/GeneratorSpec.hs +74/−0
- test/ParserSpec.hs +133/−0
ogmarkup.cabal view
@@ -1,5 +1,5 @@ name: ogmarkup-version: 2.3+version: 3.0.0 cabal-version: >=1.10 build-type: Simple license: MIT@@ -44,5 +44,8 @@ megaparsec -any, text -any default-language: Haskell2010+ other-modules:+ ParserSpec,+ GeneratorSpec hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N
src/Text/Ogmarkup.hs view
@@ -11,10 +11,13 @@ stability. Be aware the exposed interface may change in future realase. -} +{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedStrings #-}+ module Text.Ogmarkup ( -- * Parse and Generate- Strategy (..), ogmarkup, -- * Generation Configuration@@ -32,8 +35,9 @@ ) where import Data.String-import Data.List+import Data.List hiding (uncons) import Data.Monoid+import Text.Megaparsec import qualified Text.Ogmarkup.Private.Config as Conf import qualified Text.Ogmarkup.Private.Ast as Ast@@ -41,51 +45,13 @@ import qualified Text.Ogmarkup.Private.Parser as Parser import qualified Text.Ogmarkup.Private.Typography as Typo --- | With the best-effort compilation feature of ogmarkup, when the parser--- encounters an error, it can apply two different strategies with the--- remaining input to find a new synchronization point. It can search--- character by character or line by line.-data Strategy =- ByLine- | ByChar- -- | 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 :: (IsString a, Monoid a, Conf.GenConf c a)- => Strategy -- ^ Best-effort compilation strategy- -> String -- ^ The input string- -> c -- ^ The generator configuration- -> a-ogmarkup be input conf = Gen.runGenerator (Gen.document (_ogmarkup be "" input [])) conf- where- _ogmarkup :: (IsString a, Monoid a)- => Strategy -- best-effort compilation strategy- -> String -- acc- -> String -- input- -> Ast.Document a- -> Ast.Document a-- _ogmarkup _ "" "" ast = ast-- _ogmarkup _ acc "" ast = ast `mappend` [Ast.Failing . fromString $ acc]-- _ogmarkup be acc input ast =- case Parser.parse Parser.document "" input of- Right (ast', input') ->- if input == input' -- nothing has been parsed- then let (c, rst) = applyStrat be input- in _ogmarkup be (acc `mappend` c) rst ast- else if acc == ""- then _ogmarkup be [] input' (ast `mappend` ast')- else let f = Ast.Failing . fromString $ acc- in _ogmarkup be [] input' (ast `mappend` (f:ast'))- Left err -> error $ show err-- applyStrat :: Strategy- -> String- -> (String, String)-- applyStrat _ [] = ([], [])- applyStrat ByLine input = break (== '\n') input- applyStrat ByChar (c:rst) = ([c], rst)+ogmarkup :: (Stream a, Token a ~ Char, IsString a, Eq a, Monoid 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 ast) conf+ Left _ -> error "failed to parse an ogmarkup document even with best effort"
src/Text/Ogmarkup/Private/Parser.hs view
@@ -110,13 +110,21 @@ -- -- See 'Ast.Document'. document :: (Stream a, Token a ~ Char, IsString b)- => OgmarkupParser a (Ast.Document b, a)-document = do space- sects <- many (try section)- input <- getInput-- return (sects, input)+ => OgmarkupParser a (Ast.Document b)+document = doc []+ where doc :: (Stream a, Token a ~ Char, IsString b)+ => Ast.Document b+ -> OgmarkupParser a (Ast.Document b)+ doc ast = do space+ sects <- many (try section)+ let ast' = ast `mappend` sects+ (eof >> return ast') <|> (recover ast' >>= doc) + recover :: (Stream a, Token a ~ Char, IsString b)+ => Ast.Document b+ -> OgmarkupParser a (Ast.Document b)+ 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 b) => OgmarkupParser a (Ast.Section b)
+ test/GeneratorSpec.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module GeneratorSpec where++import Text.Shakespeare.Text+import Data.Maybe++import Data.Text (Text)+import Test.Hspec++import Text.Ogmarkup.Private.Config+import Text.Ogmarkup.Private.Typography++import qualified Text.Ogmarkup.Private.Ast as Ast+import qualified Text.Ogmarkup.Private.Generator as Gen++spec :: Spec+spec = do describe "format" $ do+ it "should deal with raw input" $+ Gen.runGenerator (Gen.format sentence) TestConf+ `shouldBe` "Bonjour toi."++ describe "component" $ do+ it "should deal with thought" $+ Gen.runGenerator (Gen.component False False (Ast.Thought simpleReply Nothing))+ TestConf+ `shouldBe` "[thou-anonymous][reply]Bonjour toi.[/reply][/thou-anonymous]"++data TestConf = TestConf++instance GenConf TestConf Text where+ typography _ = frenchTypo++ documentTemplate _ doc = [st|[doc]#{doc}[/doc]|]++ errorTemplate _ err = [st|[error]#{err}[/error]|]++ storyTemplate _ story = [st|[story]#{story}[/story]|]++ asideTemplate _ (Just cls) aside = [st|[aside-#{cls}]#{aside}[/aside-#{cls}]|]+ asideTemplate _ _ aside = [st|[aside]#{aside}[/aside]|]++ paragraphTemplate _ par = [st|[par]#{par}[/par]|]++ tellerTemplate _ teller = [st|[tell]#{teller}[/tell]|]++ dialogueTemplate _ auth dial = [st|[dial-#{auth}]#{dial}[/dial-#{auth}]|]++ thoughtTemplate _ auth thou = [st|[thou-#{auth}]#{thou}[/thou-#{auth}]|]++ replyTemplate _ rep = [st|[reply]#{rep}[/reply]|]++ betweenDialogue _ = "[br]"++ emphTemplate _ txt = [st|[em]#{txt}[/em]|]++ strongEmphTemplate _ txt = [st|[strong]#{txt}[/strong]|]++ authorNormalize _ = maybe "anonymous" id++ printSpace _ None = ""+ printSpace _ Normal = " "+ printSpace _ Nbsp = "_"++sentence :: Ast.Format Text+sentence = Ast.Raw [ Ast.Word "Bonjour"+ , Ast.Word "toi"+ , Ast.Punctuation Ast.Point ]++simpleReply :: Ast.Reply Text+simpleReply = Ast.Simple [ sentence ]
+ test/ParserSpec.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++module ParserSpec where++import Data.Either+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++parse' :: (Show b, Eq b)+ => Parser.OgmarkupParser String b+ -> String+ -> String+ -> Either (ParseError Char Dec) b+parse' = Parser.parse++spec :: Spec+spec = do+ describe "atom" $ do+ it "should not parse an empty string" $ parse' Parser.atom "" `shouldFailOn` ""++ it "should parse one word" $ parse' Parser.atom "" hiStr `shouldParse` hiAtom++ it "should parse one punctuation mark" $+ parse' Parser.atom "" exclamationStr `shouldParse` exclamationAtom++ describe "format" $ do+ it "should parse one quote" $+ parse' Parser.format "" quoteStr `shouldParse` quoteFormat++ it "should support french quotes" $ do+ parse' Parser.format "" frenchQuoteStr `shouldParse` frenchQuoteFormat++ it "should fail if the quote is ill-formed (no closing quote)" $+ parse' Parser.format "" `shouldFailOn` illQuoteStr++ it "should parse nested formats" $+ parse' Parser.format "" nestedFormatsStr `shouldParse` nestedFormatsFormat++ it "should fail with nested same format" $ do+ parse' Parser.format "" `shouldFailOn` nestedEmphStr+ parse' Parser.format "" `shouldFailOn` nestedStrongEmphStr++ describe "reply" $ do+ 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+ parse' Parser.section "" asideWithClassStr `shouldParse` asideWithClassAst++ it "should parse aside without class" $ do+ parse' Parser.section "" asideWithoutClassStr `shouldParse` asideWithoutClassAst++ describe "ill-formed paragraphs" $ do+ it "ill-formed components should be accepted as-is" $ do+ 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+ parse' Parser.story "" secondParagraphIllFormed `shouldParse` secondParagraphIllFormedPartialCompilation++ describe "document" $ do+ it "should try its best to compile an ill-formed document" $ do+ parse' Parser.document "" (storyStr ++ "\n\n" ++ asideIllFormed) `shouldParse`+ [ storyAst+ , Ast.Failing "_______letter______"+ , Ast.Aside (Just "letter") [ [ Ast.Teller [ Ast.Raw [ Ast.Word "Test"+ , Ast.Punctuation Ast.Point+ ]+ ]+ ]+ ]+ ]++hiStr = "hi"+hiAtom = Ast.Word "hi"++exclamationStr = "!"+exclamationAtom = Ast.Punctuation Ast.Exclamation++quoteStr = "\"hi everyone.\""+quoteFormat = Ast.Quote [Ast.Raw [hiAtom, Ast.Word "everyone", Ast.Punctuation Ast.Point]]++frenchQuoteStr = "« hi everyone. »"+frenchQuoteFormat = Ast.Quote [Ast.Raw [hiAtom, Ast.Word "everyone", Ast.Punctuation Ast.Point]]++illQuoteStr = "\"hi"++nestedFormatsStr = "*hi.. \"everyone\".*"+nestedFormatsFormat = Ast.Emph [ Ast.Raw [ Ast.Word "hi"+ , Ast.Punctuation Ast.SuspensionPoints+ ]+ , Ast.Quote [ Ast.Raw [ Ast.Word "everyone" ] ]+ , Ast.Raw [ Ast.Punctuation Ast.Point ]+ ]++nestedEmphStr = "*hi \"*miss*\"*"+nestedStrongEmphStr = "+hi \"+miss+\"+"++dialogStartingWithSpaceStr = "[ hi]"+dialogStartingWithSpaceReply = Ast.Simple [ Ast.Raw [hiAtom] ]++clauseStartingWithSpaceStr = "[hi| he said|]"+clauseStartingWithSpaceReply = Ast.WithSay [ Ast.Raw [hiAtom] ]+ [ Ast.Raw [ Ast.Word "he"+ , Ast.Word "said"+ ]+ ]+ [ ]++secondParagraphIllFormed = hiStr ++ "\n\n" ++ illQuoteStr ++ "\n\n" ++ hiStr+secondParagraphIllFormedPartialCompilation =+ Ast.Story [ [ Ast.Teller [ Ast.Raw [ hiAtom ] ] ]+ , [ Ast.IllFormed illQuoteStr ]+ , [ Ast.Teller [ Ast.Raw [ hiAtom ] ] ]+ ]++storyStr = hiStr+storyAst = Ast.Story [ [ Ast.Teller [ Ast.Raw [ hiAtom ] ] ] ]++asideWithClassStr = "____class_____\n\n" ++ hiStr ++ "\n_______"+asideWithClassAst = Ast.Aside (Just "class") [ [ Ast.Teller [ Ast.Raw [ hiAtom ] ] ] ]++asideWithoutClassStr = "_________\n\n" ++ hiStr ++ "\n_______"+asideWithoutClassAst = Ast.Aside Nothing [ [ Ast.Teller [ Ast.Raw [ hiAtom ] ] ] ]++asideIllFormed = "_______letter______\n\n_______letter______\n\nTest.\n\n____________"