ogmarkup 4.0 → 5.0
raw patch · 9 files changed
+149/−58 lines, 9 files
Files
- ogmarkup.cabal +2/−2
- src/Text/Ogmarkup.hs +4/−0
- src/Text/Ogmarkup/Private/Ast.hs +2/−0
- src/Text/Ogmarkup/Private/Config.hs +1/−1
- src/Text/Ogmarkup/Private/Parser.hs +4/−0
- src/Text/Ogmarkup/Private/Typography.hs +131/−53
- test/GeneratorSpec.hs +1/−1
- test/OgmarkupSpec.hs +1/−1
- test/ParserSpec.hs +3/−0
ogmarkup.cabal view
@@ -1,10 +1,10 @@ name: ogmarkup-version: 4.0+version: 5.0 cabal-version: >=1.10 build-type: Simple license: MIT license-file: LICENSE-copyright: 2016 - 2017 Ogma Project+copyright: 2016 - 2018 Ogma Project maintainer: contact@thomasletan.fr homepage: https://nest.pijul.com/lthms/ogmarkup synopsis: A lightweight markup language for story writers
src/Text/Ogmarkup.hs view
@@ -32,7 +32,11 @@ -- * Typography Typo.frenchTypo,+ Typo.unicodeFrenchTypo,+ Typo.htmlFrenchTypo, Typo.englishTypo,+ Typo.unicodeEnglishTypo,+ Typo.htmlEnglishTypo, Typo.Typography (..), -- * Punctuation marks and space
src/Text/Ogmarkup/Private/Ast.hs view
@@ -88,4 +88,6 @@ | Hyphen -- ^ The character @-@ | SuspensionPoints -- ^ Two or more @.@ or the character … | Apostrophe -- ^ The characters @'@ or @’@+ | Interrobang -- ^ The strange character @‽@, obtained @?!@ or @?!@+ | Irony -- ^ The character @؟@, obtained with @??@ deriving (Show, Eq)
src/Text/Ogmarkup/Private/Config.hs view
@@ -46,7 +46,7 @@ -- -- * __Default implementation:__ returns 'englishTypo'. typography :: Typography o- typography = englishTypo+ typography = unicodeEnglishTypo -- | This template is used once the output has been completely generated. --
src/Text/Ogmarkup/Private/Parser.hs view
@@ -360,6 +360,8 @@ => OgmarkupParser a (Ast.Atom b) mark = Ast.Punctuation `fmap` (semicolon <|> colon+ <|> try interrobang+ <|> try irony <|> question <|> exclamation <|> try longDash@@ -372,6 +374,8 @@ where parseMark p m = p >> return m + irony = parseMark (char '?' >> char '?') Ast.Irony+ interrobang = parseMark ((char '?' >> char '!') <|> (char '!' >> char '?')) Ast.Interrobang semicolon = parseMark (char ';') Ast.Semicolon colon = parseMark (char ':') Ast.Colon question = parseMark (char '?') Ast.Question
src/Text/Ogmarkup/Private/Typography.hs view
@@ -8,6 +8,7 @@ for French and English. -} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Text.Ogmarkup.Private.Typography where@@ -32,35 +33,36 @@ -- | A Typography is a data type that tells the caller what space -- should be privileged before and after a text. data Typography a = Typography {- decide :: Ast.Mark -> (Space, Space, a), -- ^ For a given 'Ast.Mark',- -- returns a tuple with the- -- spaces to use before- -- and after the- -- punctuation mark and- -- its output value.- openDialogue :: Bool -> Maybe Ast.Mark, -- ^ Which mark to use to- -- open a dialogue. If- -- the parameter is True,- -- there were another- -- dialogue just before.- closeDialogue :: Bool -> Maybe Ast.Mark -- ^ Which mark to use to- -- close a dialogue. If- -- the parameter is True,- -- there is another- -- dialogue just after.+ decide :: Ast.Mark -> (Space, Space) -- ^ For a given 'Ast.Mark',+ -- returns a tuple with the+ -- spaces to use before+ -- and after the+ -- punctuation mark.+ , output :: Ast.Mark -> a -- ^ Give an output+ -- representation of the+ -- punctuation mark+ , openDialogue :: Bool -> Maybe Ast.Mark -- ^ Which mark to use to+ -- open a dialogue. If+ -- the parameter is True,+ -- there were another+ -- dialogue just before.+ , closeDialogue :: Bool -> Maybe Ast.Mark -- ^ Which mark to use to+ -- close a dialogue. If+ -- the parameter is True,+ -- there is another+ -- dialogue just after. } -- | Apply the function to each 'Ast.Mark' output value instance Functor Typography where- f `fmap` (Typography d o c) = let d' m = let (s1, s2, x) = d m in (s1, s2, f x)- in Typography d' o c+ f `fmap` (Typography d op o c) = Typography d (f . op) o c -- | From a Typography, it gives the space to privilege before the -- input Text. beforeAtom :: Typography a -> Ast.Atom a -> Space-beforeAtom t (Ast.Punctuation m) = case decide t m of (r, _, _) -> r+beforeAtom t (Ast.Punctuation m) = case decide t m of (r, _) -> r beforeAtom t _ = Normal -- | From a Typography, it gives the space to privilege after the@@ -68,14 +70,14 @@ afterAtom :: Typography a -> Ast.Atom a -> Space-afterAtom t (Ast.Punctuation m) = case decide t m of (_, r, _) -> r+afterAtom t (Ast.Punctuation m) = case decide t m of (_, r) -> r 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.Punctuation m) = output t m normalizeAtom t (Ast.Word w) = w -- * Ready-to-use Typography@@ -83,23 +85,25 @@ -- | A proposal for the French typography. It can be used with several generation -- approaches, as it remains very generic. Requires the output type to be an -- instance of 'IsString'.-frenchTypo :: IsString a => Typography a-frenchTypo = Typography t prevT nextT+frenchTypo :: (Ast.Mark -> a) -> Typography a+frenchTypo op = Typography t op 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.SuspensionPoints = (None, Normal, "…")+ t :: Ast.Mark -> (Space, Space)+ t Ast.Semicolon = (Nbsp, Normal)+ t Ast.Colon = (Nbsp, Normal)+ t Ast.OpenQuote = (Normal, Nbsp)+ t Ast.CloseQuote = (Nbsp, Normal)+ t Ast.Irony = (Nbsp, Normal)+ t Ast.Interrobang = (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 False = Just Ast.OpenQuote@@ -107,23 +111,97 @@ nextT True = Nothing nextT False = Just Ast.CloseQuote +unicodeFrenchTypo :: (IsString a) => Typography a+unicodeFrenchTypo = frenchTypo $ \case+ Ast.Semicolon -> ";"+ Ast.Colon -> ","+ Ast.OpenQuote -> "«"+ Ast.CloseQuote -> "»"+ Ast.Irony -> "⸮"+ Ast.Interrobang -> "‽"+ Ast.Question -> "?"+ Ast.Exclamation -> "!"+ Ast.LongDash -> "—"+ Ast.Dash -> "–"+ Ast.Hyphen -> "-"+ Ast.Comma -> ","+ Ast.Point -> "."+ Ast.Apostrophe -> "’"+ Ast.SuspensionPoints -> "…"++htmlFrenchTypo :: (IsString a) => Typography a+htmlFrenchTypo = frenchTypo $ \case+ Ast.Semicolon -> ";"+ Ast.Colon -> ","+ Ast.OpenQuote -> "«"+ Ast.CloseQuote -> "»"+ Ast.Irony -> "⸮"+ Ast.Interrobang -> "‽"+ Ast.Question -> "?"+ Ast.Exclamation -> "!"+ Ast.LongDash -> "—"+ Ast.Dash -> "–"+ Ast.Hyphen -> "-"+ Ast.Comma -> ","+ Ast.Point -> "."+ Ast.Apostrophe -> "’"+ Ast.SuspensionPoints -> "…"+ -- | A proposal for the English typography. It can be used with several generation -- approaches, as it remains very generic. Requires the output type to be an -- instance of 'IsString'.-englishTypo :: IsString a => Typography a-englishTypo = Typography t (pure $ Just Ast.OpenQuote) (pure $ Just Ast.CloseQuote)+englishTypo :: (Ast.Mark -> a) -> Typography a+englishTypo op = Typography t op (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.SuspensionPoints = (None, Normal, "…")+ t :: Ast.Mark -> (Space, Space)+ t Ast.Semicolon = (None, Normal)+ t Ast.Colon = (None, Normal)+ t Ast.OpenQuote = (Normal, None)+ t Ast.CloseQuote = (None, Normal)+ t Ast.Irony = (None, Normal)+ t Ast.Interrobang = (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)++unicodeEnglishTypo :: (IsString a) => Typography a+unicodeEnglishTypo = englishTypo $ \case+ Ast.Semicolon -> ";"+ Ast.Colon -> ","+ Ast.OpenQuote -> "“"+ Ast.CloseQuote -> "”"+ Ast.Irony -> "⸮"+ Ast.Interrobang -> "‽"+ Ast.Question -> "?"+ Ast.Exclamation -> "!"+ Ast.LongDash -> "—"+ Ast.Dash -> "–"+ Ast.Hyphen -> "-"+ Ast.Comma -> ","+ Ast.Point -> "."+ Ast.Apostrophe -> "’"+ Ast.SuspensionPoints -> "…"++htmlEnglishTypo :: (IsString a) => Typography a+htmlEnglishTypo = englishTypo $ \case+ Ast.Semicolon -> ";"+ Ast.Colon -> ","+ Ast.OpenQuote -> "“"+ Ast.CloseQuote -> "”"+ Ast.Irony -> "⸮"+ Ast.Interrobang -> "‽"+ Ast.Question -> "?"+ Ast.Exclamation -> "!"+ Ast.LongDash -> "—"+ Ast.Dash -> "–"+ Ast.Hyphen -> "-"+ Ast.Comma -> ","+ Ast.Point -> "."+ Ast.Apostrophe -> "’"+ Ast.SuspensionPoints -> "…"
test/GeneratorSpec.hs view
@@ -32,7 +32,7 @@ data TestConf instance GenConf TestConf Text where- typography = frenchTypo+ typography = unicodeFrenchTypo documentTemplate doc = [st|[doc]#{doc}[/doc]|]
test/OgmarkupSpec.hs view
@@ -33,7 +33,7 @@ data TestConf instance GenConf TestConf Text where- typography = englishTypo+ typography = unicodeEnglishTypo documentTemplate doc = [st|[doc]#{doc}[/doc]|]
test/ParserSpec.hs view
@@ -29,6 +29,9 @@ it "should parse one punctuation mark" $ parse' Parser.atom "" exclamationStr `shouldParse` exclamationAtom + it "should parse exotic punctuation marks" $+ parse' Parser.atom "" "??" `shouldParse` Ast.Punctuation Ast.Irony+ describe "format" $ do it "should parse one quote" $ parse' Parser.format "" quoteStr `shouldParse` quoteFormat