diff --git a/ogmarkup.cabal b/ogmarkup.cabal --- a/ogmarkup.cabal +++ b/ogmarkup.cabal @@ -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 diff --git a/src/Text/Ogmarkup.hs b/src/Text/Ogmarkup.hs --- a/src/Text/Ogmarkup.hs +++ b/src/Text/Ogmarkup.hs @@ -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" diff --git a/src/Text/Ogmarkup/Private/Parser.hs b/src/Text/Ogmarkup/Private/Parser.hs --- a/src/Text/Ogmarkup/Private/Parser.hs +++ b/src/Text/Ogmarkup/Private/Parser.hs @@ -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) diff --git a/test/GeneratorSpec.hs b/test/GeneratorSpec.hs new file mode 100644 --- /dev/null +++ b/test/GeneratorSpec.hs @@ -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 ] diff --git a/test/ParserSpec.hs b/test/ParserSpec.hs new file mode 100644 --- /dev/null +++ b/test/ParserSpec.hs @@ -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____________"