ogmarkup 3.0.0 → 3.0.1
raw patch · 5 files changed
+140/−11 lines, 5 filesdep +criteriondep +file-embed-polydep ~base
Dependencies added: criterion, file-embed-poly
Dependency ranges changed: base
Files
- bench/Bench.hs +30/−0
- ogmarkup.cabal +24/−3
- src/Text/Ogmarkup.hs +14/−1
- src/Text/Ogmarkup/Private/Parser.hs +7/−7
- test/OgmarkupSpec.hs +65/−0
+ bench/Bench.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}++import Criterion.Main+import Text.Ogmarkup+import Data.Text (Text)+import Data.FileEmbed++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++ ]++inputString :: String+inputString = $(embedFile "bench/test.up")+inputText :: Text+inputText = $(embedFile "bench/test.up")++data ConfText = ConfText+instance GenConf ConfText Text where+ printSpace _ _ = " "++data ConfString = ConfString+instance GenConf ConfString String where+ printSpace _ _ = " "
ogmarkup.cabal view
@@ -1,5 +1,5 @@ name: ogmarkup-version: 3.0.0+version: 3.0.1 cabal-version: >=1.10 build-type: Simple license: MIT@@ -13,6 +13,10 @@ category: Web author: Thomas Letan, Laurent Georget +flag bench+ description: "a benchmark application"+ default: False+ source-repository head type: git location: https://github.com/ogma-project/ogmarkup@@ -46,6 +50,23 @@ default-language: Haskell2010 other-modules: ParserSpec,- GeneratorSpec+ GeneratorSpec,+ OgmarkupSpec hs-source-dirs: test- ghc-options: -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -threaded -rtsopts -with-rtsopts=-N1++benchmark ogmarkup-bench+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Bench.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N1+ type: exitcode-stdio-1.0+ if flag(bench)+ build-depends: base -any+ , criterion -any+ , ogmarkup -any+ , file-embed-poly+ , text -any+ buildable: True+ else+ buildable: False
src/Text/Ogmarkup.hs view
@@ -53,5 +53,18 @@ -> c -- ^ The generator configuration -> b ogmarkup input conf = case Parser.parse Parser.document "" input of- Right ast -> Gen.runGenerator (Gen.document ast) conf+ Right ast -> Gen.runGenerator (Gen.document $ merge ast) conf 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 [] = []++ mergep :: [Ast.Paragraph a] -> [Ast.Paragraph a]+ 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)+ mergep x = x
src/Text/Ogmarkup/Private/Parser.hs view
@@ -215,8 +215,8 @@ => OgmarkupParser a b characterName = do char '('- notFollowedBy (char ')') <?> "Empty character names are not allowed"- auth <- manyTill anyChar (char ')') <?> "Missing closing )"+ notFollowedBy (char ')')+ auth <- manyTill anyChar (char ')') return $ fromString auth @@ -232,7 +232,7 @@ case x of '|' -> do blank ws <- some format- char '|' <?> "Missing | to close the with say"+ char '|' blank p2 <- many format char c'@@ -289,7 +289,7 @@ -- | See 'Ast.Atom'. atom :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Atom b)-atom = (mark <|> longword <|> word) <* blank+atom = (word <|> mark <|> longword) <* blank -- | See 'Ast.Word'. This parser does not consume the following spaces, so -- the caller needs to take care of it.@@ -301,8 +301,8 @@ where endOfWord :: (Stream a, Token a ~ Char) => OgmarkupParser a ()- endOfWord = eof <|> (skip spaceChar) <|> (skip $ oneOf specChar) <|> (skip mark)- specChar = "\"«»`+*[]<>|_\'’"+ endOfWord = eof <|> (skip spaceChar) <|> (skip $ oneOf specChar)+ specChar = "\"«»`+*[]<>|_\'’.,;-–—!?:" -- | Wrap a raw string surrounded by @`@ inside a 'Ast.Word'.@@ -315,7 +315,7 @@ longword :: (Stream a, Token a ~ Char, IsString b) => OgmarkupParser a (Ast.Atom b) longword = do char '`'- notFollowedBy (char '`') <?> "empty raw string are not accepted"+ notFollowedBy (char '`') str <- manyTill anyChar (char '`') return $ Ast.Word (fromString str)
+ test/OgmarkupSpec.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module OgmarkupSpec where++import Data.Text (Text)+import Test.Hspec+import Text.Shakespeare.Text++import Text.Ogmarkup++spec :: Spec+spec = do+ describe "ogmarkup" $ do+ it "should merge paragraphs with consecutive dialogues" $+ ogmarkup consecutiveDialogues TestConf `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`+ "[doc][story][par][dial-anonymous]“[reply]This is a test.[/reply]”[/dial-anonymous][/par][par]May it works.[/par][/story][/doc]"+++consecutiveDialogues :: Text+consecutiveDialogues = "[This is a test.]\n\n[May it works.]"++notConsecutiveDialogues :: Text+notConsecutiveDialogues = "[This is a test.]\n\nMay it works."++data TestConf = TestConf++instance GenConf TestConf Text where+ typography _ = englishTypo++ 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 = "_"