seonbi 0.1.1 → 0.2.0
raw patch · 12 files changed
+516/−101 lines, 12 filesdep +directorydep +interpolatedstring-perl6dep +randomdep ~waidep ~warp
Dependencies added: directory, interpolatedstring-perl6, random
Dependency ranges changed: wai, warp
Files
- CHANGES.md +63/−0
- README.md +19/−13
- app/seonbi-api.hs +3/−0
- app/seonbi.hs +18/−8
- data/ko-kr-stdict.tsv too large to diff
- seonbi.cabal +19/−17
- src/Text/Seonbi/Facade.hs +72/−11
- src/Text/Seonbi/Hanja.hs +20/−11
- src/Text/Seonbi/Html.hs +26/−6
- src/Text/Seonbi/Punctuation.hs +172/−6
- test/Text/Seonbi/FacadeSpec.hs +46/−29
- test/Text/Seonbi/PunctuationSpec.hs +58/−0
CHANGES.md view
@@ -1,6 +1,69 @@ Seonbi changelog ================ +Version 0.2.0+-------------++Released May 26, 2021.++ - Added stops (periods/commas/interpuncts) normalizer.++ Haskell API-wise, the below types and functions were added:++ - `Text.Seonbi.Punctuation.Stops` data type+ - `Text.Seonbi.Punctuation.normalizeStops` function+ - `Text.Seonbi.Punctuation.horizontalStops` function+ - `Text.Seonbi.Punctuation.horizontalStopsWithSlashes` function+ - `Text.Seonbi.Punctuation.verticalStops` function+ - `Text.Seonbi.Facade.StopOption` data type+ - `stop` field in `Text.Seonbi.Facade.Configuration` data constructor++ CLI-wise, the `-s`/`--stop` option was added.++ HTTP API-wise, the optional field `"stop"` was added.++ - `Text.Seonbi.Punctuation.transformEllipsis` became aware of Chinese stops+ (`。。。`) besides Western stops (`...`).++ - Added options to use horizontal/vertical corner brackets for quotes.++ Haskell API-wise, the below functions were added:++ - `Text.Seonbi.Punctuation.verticalCornerBrackets` function+ - `Text.Seonbi.Punctuation.horizontalCornerBrackets` function+ - `Text.Seonbi.Punctuation.verticalCornerBracketsWithQ` function+ - `Text.Seonbi.Punctuation.horizontalCornerBracketsWithQ` function+ - `VerticalCornerBrackets` data constructor for+ `Text.Seonbi.Facade.QuoteOption` type+ - `HorizontalCornerBrackets` data constructor for+ `Text.Seonbi.Facade.QuoteOption` type+ - `VerticalCornerBracketsWithQ` data constructor for+ `Text.Seonbi.Facade.QuoteOption` type+ - `HorizontalCornerBracketsWithQ` data constructor for+ `Text.Seonbi.Facade.QuoteOption` type++ CLI-wise, the `-q`/`--quote` option became to have the below new styles:++ - `vertical-corner-brackets`+ - `horizontal-corner-brakcets`+ - `vertical-corner-brackets-with-q`+ - `horizontal-corner-brakcets-with-q`++ HTTP API-wise, the optional field `"quote"` became to have the below new+ styles:++ - `VerticalCornerBrackets`+ - `HorizontalCornerBrackets`+ - `VerticalCornerBracketsWithQ`+ - `HorizontalCornerBracketsWithQ`++ - The CLI option `-x`/`--xhtml` became usable with the `-p`/`--preset` option+ at a time.++ - Updated the *Standard Korean Language Dictionary* data+ (*data/ko-kr-stdict.tsv*) to the revision 2021-05.++ Version 0.1.1 -------------
README.md view
@@ -3,15 +3,17 @@ [![][releases-badge]][releases] [![][hackage-badge]][hackage] [![][dockerhub-badge]][dockerhub] [![][ci-status-badge]][ci] +[][demo web app]+ (TL;DR: See the [demo web app].) -Seonbi (선비) is is an HTML preprocessor that makes typographic adjustments+Seonbi (선비) is an HTML preprocessor that makes typographic adjustments to an HTML so that the result uses accurate punctuations according to the modern Korean orthography.-(It's similar to what [SmartyPants] does for a text written in English.)+(It's similar to what [SmartyPants] does for text written in English.) -It also transforms a `ko-Kore` text (國漢文混用; [Korean mixed script]) into-a `ko-Hang` text (한글전용; Hangul-only script).+It also transforms `ko-Kore` text (國漢文混用; [Korean mixed script]) into+`ko-Hang` text (한글전용; Hangul-only script). Seonbi provides a Haskell library, a CLI, and an HTTP API; any of them can perform the following transformations:@@ -20,7 +22,9 @@ (e.g., `한자`) - Straight quotes and apostrophes (`"` & `'`) into curly quotes HTML entities (`“`, `”`, `‘`, & `’`)- - Three consecutive periods (`...`) into an ellipsis entity (`…`)+ - Three consecutive periods (`...` or `。。。`) into an ellipsis entity (`…`)+ - Classical (Chinese-style) stops (`。` & `、`) into modern (English-style)+ stops (`.` & `,`) - Pairs of less-than and greater-than inequality symbols (`<` & `>`) into pairs of proper angle quotes (`〈` & `〉`) - Pairs of two consecutive inequality symbols (`<<` & `>>`) into@@ -36,7 +40,7 @@ Since its transformations work in HTML-level, it also plays well with web markup languages like CommonMark, Markdown, and Textile. In a similar way to-SmartyPants, it either does not modify characters within several sensitive+SmartyPants, it does not modify characters within several sensitive HTML elements like `<pre>`/`<code>`/`<script>`/`<kbd>`. [releases]: https://github.com/dahlia/seonbi/releases@@ -55,8 +59,8 @@ Installation ------------ -Seonbi provides the official executable binaries for Linux (x86_64), macOS,-and Windows (64-bit). You can find download them from the [releases] page.+Seonbi provides official executable binaries for Linux (x86_64), macOS,+and Windows (64-bit). You can download them from the [releases] page. It is also distributed as a [Docker image][dockerhub]: @@ -71,7 +75,7 @@ --- The `seonbi` command basically takes the input HTML as standard input, and-then transformes it into the output HTML as standard output:+then transforms it into the output HTML as standard output: seonbi < input.html > output.html @@ -86,7 +90,7 @@ Although it automatically detects text encoding of the input file, you could explicitly specify `-e`/`--encoding`: - seobni -e euc-kr -o output.html input.html+ seonbi -e euc-kr -o output.html input.html Although there are several style options, e.g., `-q`/`--quote`, `-c`/`--cite`, `-r`/`--render-hanja`, in most cases, giving `-p`/`--preset` is enough:@@ -124,7 +128,7 @@ HTTP/1.1 200 OK Content-Type: application/json- Server: Seonbi/0.1.1+ Server: Seonbi/0.2.0 { "success": true,@@ -136,7 +140,7 @@ seonbi-api -o https://example.com -To learn more parameters interactively, try the [demo web app].+To learn more about parameters interactively, try the [demo web app]. [CORS]: https://developer.mozilla.org/en-US/docs/Web/HTTP/CORS @@ -147,7 +151,9 @@ All functions and types lie inside `Text.Seonbi` module and its submodules. The highest-level API is `Text.Seonbi.Facade` module. -See also the API docs on [Hackage].+See also the [API docs] or [Hackage].++[API docs]: https://dahlia.github.io/seonbi/docs/ License
app/seonbi-api.hs view
@@ -56,6 +56,7 @@ arrow' <- v .:? "arrow" ellipsis' <- v .:? "ellipsis" .!= False emDash' <- v .:? "emDash" .!= False+ stop' <- v .:? "stop" hanja' <- v .:? "hanja" .!= Nothing return Configuration { debugLogger = Nothing@@ -65,6 +66,7 @@ , arrow = arrow' , ellipsis = ellipsis' , emDash = emDash'+ , stop = stop' , hanja = hanja' } return $ Input sourceHtml' config@@ -72,6 +74,7 @@ instance FromJSON QuoteOption instance FromJSON CiteOption instance FromJSON ArrowOption+instance FromJSON StopOption instance FromJSON HanjaRenderingOption instance FromJSON HanjaOption where
app/seonbi.hs view
@@ -92,6 +92,7 @@ , config :: Configuration IO () , dictionaries :: [FilePath] , noKrStdict :: Bool+ , xhtml :: Bool , debug :: Bool , version :: Bool , input :: FilePath@@ -165,13 +166,8 @@ "Available presets: " ++ Data.List.intercalate ", " (Data.Map.Strict.keys presets')) )- <|> ( Configuration Nothing- <$> switch- ( long "xhtml"- <> short 'x'- <> help "XHTML mode"- )- <*> ( flag' Nothing+ <|> ( Configuration Nothing False+ <$> ( flag' Nothing ( long "no-quote" <> short 'Q' <> help ("Do not transform any quotes at all. " ++@@ -192,7 +188,7 @@ <> short 'c' <> metavar "CITE_STYLE" <> value Nothing- <> help ("Transform citating quotes. Available styles: " +++ <> help ("Transform citation quotes. Available styles: " ++ enumKeywords (Proxy :: Proxy CiteOption)) ) <*> ( flag' Nothing@@ -225,6 +221,15 @@ <> short 'D' <> help "Do not transform folk em dashes into proper em dashes" )+ <*> option (fmap Just enum)+ ( long "stop"+ <> short 's'+ <> metavar "STOP_STYLE"+ <> value Nothing+ <> help ("Normalize stops (periods/commas/interpuncts). " +++ "Available styles: " +++ enumKeywords (Proxy :: Proxy StopOption))+ ) <*> ( flag' Nothing ( long "maintain-hanja" <> short 'H'@@ -291,6 +296,11 @@ <> short 'S' <> help ("Do not use Standard Korean Language Dictionary " ++ "(標準國語大辭典) by South Korean NIKL (國立國語院)")+ )+ <*> switch+ ( long "xhtml"+ <> short 'x'+ <> help "XHTML mode" ) <*> switch ( long "debug"
data/ko-kr-stdict.tsv view
file too large to diff
seonbi.cabal view
@@ -1,13 +1,11 @@ cabal-version: 1.24 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: 8339f3a5d2f79ad22fe631feda924f87bd347414e314cf9e312d062f4c481d92 name: seonbi-version: 0.1.1+version: 0.2.0 synopsis: SmartyPants for Korean language description: Please see the README.md on GitHub at <https://github.com/dahlia/seonbi>. category: Text@@ -15,7 +13,7 @@ bug-reports: https://github.com/dahlia/seonbi/issues author: Hong Minhee <hong.minhee@gmail.com> maintainer: Hong Minhee <hong.minhee@gmail.com>-copyright: © 2018–2019 Hong Minhee+copyright: © 2018–2021 Hong Minhee license: LGPL-2.1 license-file: LICENSE build-type: Custom@@ -36,7 +34,7 @@ Cabal , base , bytestring- , directory >=1 && <2+ , directory ==1.* , filepath , http-client >=0.5 && <0.7 , temporary >=1.2 && <1.4@@ -86,11 +84,11 @@ , attoparsec >=0.12 && <1 , base >=4.7 && <5 , bytestring- , cassava >=0.5 && <0.6+ , cassava ==0.5.* , containers , data-default >=0.2 && <1 , file-embed >=0.0.10 && <0.0.12- , filepath >=1 && <2+ , filepath ==1.* , text , text-trie >=0.2.5 && <0.3 if os(darwin)@@ -123,15 +121,15 @@ cpp-options: -DICONV build-depends: cases ==0.1.3.2- , html-charset >=0.1 && <0.2- , iconv >=0.4 && <0.5- , optparse-applicative >=0.14 && <0.15+ , html-charset ==0.1.*+ , iconv ==0.4.*+ , optparse-applicative ==0.14.* , seonbi else build-depends: cases ==0.1.3.2- , html-charset >=0.1 && <0.2- , optparse-applicative >=0.14 && <0.15+ , html-charset ==0.1.*+ , optparse-applicative ==0.14.* , seonbi if flag(static) ld-options: -static@@ -154,12 +152,12 @@ , base >=4.7 && <5 , bytestring , containers- , http-types >=0.12 && <0.13- , optparse-applicative >=0.14 && <0.15+ , http-types ==0.12.*+ , optparse-applicative ==0.14.* , seonbi , text- , wai >=3.2 && <3.3- , warp >=3.2 && <3.3+ , wai >=3.2 && <3.4+ , warp >=3.2 && <3.4 if os(darwin) ghc-options: -Wall -fprint-explicit-kinds -optP-Wno-nonportable-include-path else@@ -240,8 +238,12 @@ , base >=4.7 && <5 , bytestring , containers+ , directory ==1.*+ , filepath ==1.* , hspec >=2.4.8 && <3 , hspec-discover >=2.4.8 && <3+ , interpolatedstring-perl6 >=1.0.1 && <2+ , random ==1.1.* , seonbi , text if os(darwin)
src/Text/Seonbi/Facade.hs view
@@ -9,21 +9,26 @@ -- | Provides higher-level APIs. Read 'transformHtmlText' function first, -- and then see also 'Configuration' type. module Text.Seonbi.Facade- ( ArrowOption (..)- , CiteOption (..)+ ( -- * HTML transformation+ transformHtmlText+ , transformHtmlLazyText+ -- * Configuration and presets , Configuration (..)- , HanjaDictionary- , HanjaOption (..)- , HanjaReadingOption (..)- , HanjaRenderingOption (..)- , QuoteOption (..) , ko_KP , ko_KR , presets+ -- * Dictionaries+ , HanjaDictionary , readDictionaryFile , southKoreanDictionary- , transformHtmlText- , transformHtmlLazyText+ -- * Options+ , ArrowOption (..)+ , CiteOption (..)+ , HanjaOption (..)+ , HanjaReadingOption (..)+ , HanjaRenderingOption (..)+ , QuoteOption (..)+ , StopOption (..) ) where import Data.Char@@ -72,7 +77,7 @@ -- If 'Nothing' no quotes are transformed. , quote :: Maybe QuoteOption -- | An option to transform folk-citing quotes (e.g., @\<\<한겨레\>\>@)- -- into proper citing quotes (e.g., @《한겨레》).+ -- into proper citing quotes (e.g., @《한겨레》@). , cite :: Maybe CiteOption -- | Settings to transform arrow-looking punctuations into proper arrows. -- If 'Nothing' no arrows are transformed.@@ -81,6 +86,9 @@ , ellipsis :: Bool -- | Whether to transform folk em dashes into proper em dashes. , emDash :: Bool+ -- | Settings to normalize stops (periods, commas, and interpuncts).+ -- If 'Nothing' stops are never touched.+ , stop :: Maybe StopOption -- | Settings to deal with Sino-Korean words. , hanja :: Maybe HanjaOption }@@ -95,6 +103,7 @@ " cite = " <> show (arrow c) <> "," <> " ellipsis = " <> show (ellipsis c) <> "," <> " emDash = " <> show (emDash c) <> "," <>+ " stop = " <> show (stop c) <> "," <> " hanja = " <> show (hanja c) <> "}" @@ -103,12 +112,24 @@ -- | English-style curved quotes (@‘@: U+2018, @’@: U+2019, @“@: U+201C, -- @”@: U+201D), which are used by South Korean orthography. = CurvedQuotes+ -- | Vertical corner brackets (@﹁@: U+FE41, @﹂@: U+FE42, @﹃@: U+FE43,+ -- @﹄@: U+FE44), which are used by East Asian orthography.+ | VerticalCornerBrackets+ -- | Traditional horizontal corner brackets (@「@: U+300C, @」@: U+300D,+ -- @『@: U+300E, @』@: U+300F), which are used by East Asian orthography.+ | HorizontalCornerBrackets -- | East Asian guillemets (@〈@: U+3008, @〉@: U+3009, @《@: U+300A, @》@: -- U+300B), which are used by North Korean orthography. | Guillemets -- | Use English-style curved quotes (@‘@: U+2018, @’@: U+2019) for single -- quotes, and HTML @\<q\>@ tags for double quotes. | CurvedSingleQuotesWithQ+ -- | Use vertical corner brackets (@﹁@: U+FE41, @﹂@: U+FE42)+ -- for single quotes, and HTML @\<q\>@ tags for double quotes.+ | VerticalCornerBracketsWithQ+ -- | Use horizontal corner brackets (@「@: U+300C, @」@: U+300D)+ -- for single quotes, and HTML @\<q\>@ tags for double quotes.+ | HorizontalCornerBracketsWithQ deriving (Enum, Eq, Generic, Read, Show) -- | An option to transform folk-citing quotes (e.g., @\<\<한겨레\>\>@) into@@ -137,6 +158,25 @@ , doubleArrow :: Bool } deriving (Eq, Generic, Show) +-- | Settings to normalize stops (periods, commas, and interpuncts) in docs.+data StopOption+ -- | Stop sentences in the modern Korean style which follows Western stops.+ -- E.g.:+ --+ -- > 봄·여름·가을·겨울. 어제, 오늘.+ = Horizontal+ -- | Similar to 'horizontalStops' except slashes are used instead of+ -- interpuncts. E.g.:+ --+ -- > 봄/여름/가을/겨울. 어제, 오늘.+ | HorizontalWithSlashes+ -- | Stop sentences in the pre-modern Korean style which follows Chinese+ -- stops. E.g.:+ --+ -- > 봄·여름·가을·겨울。어제、오늘。+ | Vertical+ deriving (Enum, Eq, Generic, Read, Show)+ -- | Settings to deal with Sino-Korean words. data HanjaOption = HanjaOption { -- | How to render Sino-Korean words.@@ -211,14 +251,25 @@ | otherwise = printHtml toTransformers :: Monad m => Configuration m a -> [[HtmlEntity] -> [HtmlEntity]]-toTransformers Configuration { quote, cite, arrow, ellipsis, emDash, hanja } =+toTransformers Configuration { quote+ , cite+ , arrow+ , ellipsis+ , emDash+ , stop+ , hanja+ } = [ case quote of Nothing -> id Just quoteOption -> transformQuote $ case quoteOption of CurvedQuotes -> curvedQuotes Guillemets -> guillemets+ VerticalCornerBrackets -> verticalCornerBrackets+ HorizontalCornerBrackets -> horizontalCornerBrackets CurvedSingleQuotesWithQ -> curvedSingleQuotesWithQ+ VerticalCornerBracketsWithQ -> verticalCornerBracketsWithQ+ HorizontalCornerBracketsWithQ -> horizontalCornerBracketsWithQ , case cite of Nothing -> id Just citeOption -> quoteCitation $@@ -234,6 +285,13 @@ [ if bidirArrow then Just LeftRight else Nothing , if doubleArrow then Just DoubleArrow else Nothing ]+ , case stop of+ Nothing -> id+ Just stopOption -> normalizeStops $+ case stopOption of+ Horizontal -> horizontalStops+ HorizontalWithSlashes -> horizontalStopsWithSlashes+ Vertical -> verticalStops , if ellipsis then transformEllipsis else id , if emDash then transformEmDash else id , case hanja of@@ -279,6 +337,7 @@ , arrow = Just ArrowOption { bidirArrow = True, doubleArrow = True } , ellipsis = True , emDash = True+ , stop = Just Horizontal , hanja = Just HanjaOption { rendering = DisambiguatingHanjaInParentheses , reading = HanjaReadingOption@@ -302,6 +361,8 @@ } } +-- | A mapping of locale code strings (e.g., @"ko-kr"@) to the corresponding+-- 'Configuration' presets (e.g., 'ko_KR'). presets :: (Ord k, IsString k, Monad m) => Map k (Configuration m a) presets = [ ("ko-kp", ko_KP)
src/Text/Seonbi/Hanja.hs view
@@ -2,24 +2,31 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NamedFieldPuns #-}+-- | This module deals with Chinese characters and Sino-Korean words written in+-- hanja. module Text.Seonbi.Hanja- ( HanjaDictionary- , HanjaPhoneticization (..)+ ( -- * Korean mixed-script (國漢文混用) transformation+ HanjaPhoneticization (..)+ , def+ , phoneticizeHanja+ -- * Single character phoneticization+ , phoneticizeHanjaChar+ -- * Word phoneticization+ , HanjaDictionary , HanjaWordPhoneticizer+ , phoneticizeHanjaWord+ , phoneticizeHanjaWordWithInitialSoundLaw+ , withDictionary+ -- * Word rendering , HanjaWordRenderer- , convertInitialSoundLaw- , def , hangulOnly , hanjaInParentheses , hanjaInRuby+ -- * Initial sound law (頭音法則)+ , convertInitialSoundLaw , initialSoundLawTable , initialSoundLawTable'- , phoneticizeHanja- , phoneticizeHanjaChar- , phoneticizeHanjaWord- , phoneticizeHanjaWordWithInitialSoundLaw , revertInitialSoundLaw- , withDictionary ) where import Prelude hiding (lookup)@@ -48,6 +55,8 @@ -- >>> import qualified Text.Show.Unicode -- >>> :set -interactive-print=Text.Show.Unicode.uprint +-- | Settings to transform Sino-Korean words written in hanja into hangul+-- letters. data HanjaPhoneticization = HanjaPhoneticization { -- | A function to phoneticize a hanja word. -- Use 'phoneticizeHanjaWordWithInitialSoundLaw' for South Korean@@ -58,7 +67,7 @@ -- | A function to render a hanja word which should be disambiguated. -- It's used instead of 'wordRenderer' when two or more words in -- a text have the same hangul reading but actually are dictinct- -- each other in hanja characters, e.g., 小數/素數 (소수).+ -- each other in hanja characters, e.g., 小數\/素數 (소수). , homophoneRenderer :: HanjaWordRenderer -- | Whether to insert some HTML comments that contain useful information -- for debugging into the result. This does not affect the rendering@@ -324,7 +333,7 @@ -- "자전거" -- -- But, if it faces any words or characters that are not registered in--- the dictionary, it does the best to interpolate prefixes/infixes/suffixes+-- the dictionary, it does the best to interpolate prefixes\/infixes\/suffixes -- using the fallback phoneticizer: -- -- >>> phone "自轉車道路"
src/Text/Seonbi/Html.hs view
@@ -1,16 +1,36 @@+-- | Since Seonbi's primitive unit to transform is HTML, this module deals with+-- HTML. module Text.Seonbi.Html- ( HtmlEntity (..)+ ( -- * HTML scanner+ --+ -- | See more on "Text.Seonbi.Html.Scanner" module.+ Result (..)+ , scanHtml+ -- * HTML printer+ --+ -- | See more on "Text.Seonbi.Html.Printer" module.+ , printHtml+ , printXhtml+ , -- * HTML entities+ --+ -- | See more on "Text.Seonbi.Html.Entity" module.+ HtmlEntity (..) , HtmlRawAttrs+ -- * HTML tags+ --+ -- | See more on "Text.Seonbi.Html.Tag" module. , HtmlTag (..) , HtmlTagKind (..)- , HtmlTagStack- , Result (..) , htmlTagKind , htmlTagName+ -- * HTML text normalization+ --+ -- | See more on "Text.Seonbi.Html.TextNormalizer" module. , normalizeText- , printHtml- , printXhtml- , scanHtml+ -- * HTML hierarchical stacks+ --+ -- | See more on "Text.Seonbi.Html.TagStack" module.+ , HtmlTagStack ) where import Text.Seonbi.Html.Entity
src/Text/Seonbi/Punctuation.hs view
@@ -3,8 +3,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-}+-- | This module deals with punctuations in Korean text. module Text.Seonbi.Punctuation- ( ArrowTransformationOption (..)+ ( -- * Arrows+ ArrowTransformationOption (..)+ , transformArrow+ -- * Quotes , CitationQuotes (..) , Quotes (..) , QuotePair (..)@@ -13,11 +17,21 @@ , curvedQuotes , curvedSingleQuotesWithQ , guillemets+ , horizontalCornerBrackets+ , horizontalCornerBracketsWithQ , quoteCitation- , transformArrow+ , transformQuote+ , verticalCornerBrackets+ , verticalCornerBracketsWithQ+ -- * Stops: periods, commas, & interpuncts+ , Stops (..)+ , horizontalStops+ , horizontalStopsWithSlashes+ , normalizeStops , transformEllipsis+ , verticalStops+ -- * Dashes , transformEmDash- , transformQuote ) where import Prelude hiding (takeWhile)@@ -28,6 +42,7 @@ import Data.List (minimumBy) import Data.Maybe import Data.Ord+import Numeric import Data.Attoparsec.Text import Data.Set@@ -51,7 +66,7 @@ -- @ data CitationQuotes = CitationQuotes { -- | The leading and trailing punctuations to surround a title of- -- novel, newspaper, magazine, movie, televison program, etc.+ -- novel, newspaper, magazine, movie, television program, etc. title :: (Text, Text) , -- | The leading and trailing punctuations to surround a title of -- short story, chapter, article, episode, etc.@@ -233,6 +248,116 @@ deriving (Eq, Show) +-- | A set of stops—'period', 'comma', and 'interpunct'—to be used by+-- 'normalizeStops' function.+--+-- There are three presets: 'horizontalStops', 'verticalStops', and+-- 'horizontalStopsWithSlashes'.+data Stops = Stops+ { period :: Text+ , comma :: Text+ , interpunct :: Text+ } deriving (Eq, Show)++-- | Stop sentences in the modern Korean style which follows Western stops.+-- E.g.:+--+-- > 봄·여름·가을·겨울. 어제, 오늘.+horizontalStops :: Stops+horizontalStops = Stops+ { period = ". "+ , comma = ", "+ , interpunct = "·"+ }++-- | Stop sentences in the pre-modern Korean style which follows Chinese stops.+-- E.g.:+--+-- > 봄·여름·가을·겨울。어제、오늘。+verticalStops :: Stops+verticalStops = Stops+ { period = "。"+ , comma = "、"+ , interpunct = "·"+ }++-- | Similar to 'horizontalStops' except slashes are used instead of+-- interpuncts. E.g.:+--+-- > 봄/여름/가을/겨울. 어제, 오늘.+horizontalStopsWithSlashes :: Stops+horizontalStopsWithSlashes = Stops+ { period = ". "+ , comma = ", "+ , interpunct = "/"+ }+++-- | Normalizes sentence stops (periods, commas, and interpuncts).+normalizeStops :: Stops -> [HtmlEntity] -> [HtmlEntity]+normalizeStops stops input = (`fmap` normalizeText input) $ \ case+ e@HtmlText { tagStack = stack, rawText = txt } ->+ if isPreservedTagStack stack+ then e+ else e { rawText = replaceText txt }+ e ->+ e+ where+ replaceText :: Text -> Text+ replaceText txt =+ case parseOnly parser txt of+ Left _ -> error "unexpected error: failed to parse text node"+ Right t -> t+ parser :: Parser Text+ parser = do+ chunks <- many' $ choice+ [ stops'+ , Data.Text.singleton <$> anyChar+ ]+ endOfInput+ return $ Data.Text.concat chunks+ stops' :: Parser Text+ stops' = choice+ [ period' >> return (toEntity $ period stops)+ , comma' >> return (toEntity $ comma stops)+ , interpunct' >> return (toEntity $ interpunct stops)+ ]+ toEntity :: Text -> Text+ toEntity = Data.Text.concatMap $ \ c ->+ if c < '\x80' -- ASCII compatible characters+ then Data.Text.singleton c+ else Data.Text.concat ["&#x", pack $ showHex (fromEnum c) "", ";"]+ period' :: Parser ()+ period' = void $ choice+ [ char '.' >> takeWhile isSpace >> return ""+ , char '。' >> return ""+ , string "."+ , string "."+ , string "。"+ , asciiCI "."+ , asciiCI "。"+ ]+ comma' :: Parser ()+ comma' = void $ choice+ [ char '、' >> return ""+ , string ", "+ , string ", "+ , string ", "+ , string "、"+ , asciiCI ", "+ , asciiCI "、"+ ]+ interpunct' :: Parser ()+ interpunct' = void $ choice+ [ char '·' >> return ""+ , string "·"+ , string "·"+ , string "·"+ , string "·"+ , asciiCI "·"+ ]++ -- | Substitution options for 'transformArrow' function. These options can -- be composited as an element of a set. --@@ -361,7 +486,7 @@ parser :: Parser Text parser = do chunks <- many' $ choice- [ takeWhile1 (`notElem` (['&', '.'] :: Set Char))+ [ takeWhile1 (`notElem` (['&', '.', '。'] :: Set Char)) , ellipsis , Data.Text.singleton <$> anyChar ]@@ -369,7 +494,10 @@ return $ Data.Text.concat chunks ellipsis :: Parser Text ellipsis = do- void $ period >> period >> period+ void $ choice+ [ period >> period >> period+ , chinesePeriod >> chinesePeriod >> chinesePeriod+ ] return "…" period :: Parser Text period = choice@@ -378,6 +506,12 @@ , string "." , asciiCI "." ]+ chinesePeriod :: Parser Text+ chinesePeriod = choice+ [ string "。"+ , string "。"+ , asciiCI "。"+ ] -- | Pairs of substitute folk single and double quotes. -- Used by 'transformQuote' function.@@ -414,6 +548,22 @@ , doubleQuotes = QuotePair "“" "”" } +-- | Vertical corner brackets (@﹁@: U+FE41, @﹂@: U+FE42, @﹃@: U+FE43,+-- @﹄@: U+FE44), which are used by East Asian orthography.+verticalCornerBrackets :: Quotes+verticalCornerBrackets = Quotes+ { singleQuotes = QuotePair "﹁" "﹂"+ , doubleQuotes = QuotePair "﹃" "﹄"+ }++-- | Traditional horizontal corner brackets (@「@: U+300C, @」@: U+300D,+-- @『@: U+300E, @』@: U+300F), which are used by East Asian orthography.+horizontalCornerBrackets :: Quotes+horizontalCornerBrackets = Quotes+ { singleQuotes = QuotePair "「" "」"+ , doubleQuotes = QuotePair "『" "』"+ }+ -- | East Asian guillemets (@〈@: U+3008, @〉@: U+3009, @《@: U+300A, @》@: -- U+300B), which are used by North Korean orthography. guillemets :: Quotes@@ -427,6 +577,22 @@ curvedSingleQuotesWithQ :: Quotes curvedSingleQuotesWithQ = Quotes { singleQuotes = QuotePair "‘" "’"+ , doubleQuotes = HtmlElement Q ""+ }++-- | Use vertical corner brackets (@﹁@: U+FE41, @﹂@: U+FE42) for single quotes,+-- and HTML @\<q\>@ tags for double quotes.+verticalCornerBracketsWithQ :: Quotes+verticalCornerBracketsWithQ = Quotes+ { singleQuotes = QuotePair "﹁" "﹂"+ , doubleQuotes = HtmlElement Q ""+ }++-- | Use horizontal corner brackets (@「@: U+300C, @」@: U+300D)+-- for single quotes, and HTML @\<q\>@ tags for double quotes.+horizontalCornerBracketsWithQ :: Quotes+horizontalCornerBracketsWithQ = Quotes+ { singleQuotes = QuotePair "「" "」" , doubleQuotes = HtmlElement Q "" }
test/Text/Seonbi/FacadeSpec.hs view
@@ -2,40 +2,57 @@ {-# LANGUAGE OverloadedStrings #-} module Text.Seonbi.FacadeSpec (spec) where -import Data.String (IsString)+import Control.Monad +import Data.Text.Lazy.IO+import System.Directory+import System.FilePath import Test.Hspec import Text.Seonbi.Facade -input :: (IsString a, Monoid a) => a-input =- "<blockquote><p>아이들에게 하로의 乾燥한 學課로<br>" <>- "해말간 倦怠가 깃들고,<br>" <>- ""矛盾" 두자를 理解치 못하도록<br>" <>- "머리가 單純하였구나.</p>" <>- "</blockquote><p>尹東柱 <이런날></p>"+dataDirPath :: FilePath+dataDirPath = "test" </> "data" -output :: (IsString a, Monoid a) => a-output =- "<blockquote><p>아이들에게 하로의 건조한 학과로<br>" <>- "해말간 권태가 깃들고,<br>" <>- "“모순” 두자를 이해치 못하도록<br>" <>- "머리가 단순하였구나.</p>" <>- "</blockquote><p>윤동주 〈이런날〉</p>"+inputExtension :: String+inputExtension = ".ko-Kore.html" +outputExtensions :: Monad m => [(String, Configuration m a)]+outputExtensions =+ [ (".ko-KR.html", ko_KR)+ , (".ko-KP.html", ko_KP)+ ]++ spec :: Spec-spec =- specify "transformHtmlLazyText" $ do- let noOp = Configuration- { quote = Nothing- , cite = Nothing- , arrow = Nothing- , ellipsis = False- , emDash = False- , hanja = Nothing- , xhtml = False- , debugLogger = Nothing- }- transformHtmlLazyText noOp input `shouldBe` Just input- transformHtmlLazyText ko_KR input `shouldBe` Just output+spec = do+ testData <- runIO $ do+ files <- listDirectory dataDirPath+ let inputFiles = [f | f <- files, inputExtension `isExtensionOf` f]+ testFiles <- filterM+ (\(_, o, _) -> doesFileExist (dataDirPath </> o))+ [ (i, dropExtension i -<.> oExt, oCfg)+ | i <- inputFiles+ , (oExt, oCfg) <- outputExtensions+ ]+ forM testFiles $ \ (input, output, cfg) -> do+ inputData <- Data.Text.Lazy.IO.readFile (dataDirPath </> input)+ outputData <- Data.Text.Lazy.IO.readFile (dataDirPath </> output)+ return (input, output, inputData, outputData, cfg)+ forM_ testData $ \ (iname, oname, input, output, cfg) ->+ specify ("transformHtmlLazyText: " ++ iname ++ " -> " ++ oname) $ do+ transformHtmlLazyText noOp input `shouldBe` Just input+ transformHtmlLazyText cfg input `shouldBe` Just output+ where+ noOp :: Monad m => Configuration m a+ noOp = Configuration+ { quote = Nothing+ , cite = Nothing+ , arrow = Nothing+ , ellipsis = False+ , emDash = False+ , stop = Nothing+ , hanja = Nothing+ , xhtml = False+ , debugLogger = Nothing+ }
test/Text/Seonbi/PunctuationSpec.hs view
@@ -1,13 +1,18 @@+{-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-} module Text.Seonbi.PunctuationSpec (spec) where import Control.Monad import Data.Maybe+import System.IO.Unsafe import Data.Set import Data.Text+import System.Random import Test.Hspec+import Text.InterpolatedString.Perl6 (qc) import Text.Seonbi.Html import Text.Seonbi.Punctuation@@ -319,6 +324,8 @@ ellipsisSample "…" "..." transformEllipsis (sample "...") `shouldBe` ellipsisSample "…" "..."+ transformEllipsis (sample "。。。") `shouldBe`+ ellipsisSample "…" "。。。" describe "transformQuote" $ do it "transforms apostrophes and straight quotes into typographic ones" $@@ -454,3 +461,54 @@ "한글 모음—U+3161 HANGUL LETTER EU—을 줄표로" , HtmlEndTag [] P ]++ describe "normalizeStops" $ do+ let periods =+ [ ". ", ".", ".", "."+ , "。", "。", "。"+ ] :: [Text]+ let commas =+ [ ", ", ", ", ", ", ", "+ , "、", "、", "、"+ ] :: [Text]+ let interpuncts =+ [ "·", "·", "·", "·"+ , "·", "·", "·"+ ] :: [Text]+ let examples =+ [ [qc|봄{i1}여름{i2}가을{i3}겨울{p1}어제{c}오늘{p2}|]+ | p1 <- periods, p2 <- periods+ , c <- commas+ , i1 <- interpuncts, i2 <- interpuncts, i3 <- interpuncts+ ] :: [Text]+ let gen = unsafePerformIO getStdGen :: StdGen+ let randomInts = randomRs (0, 499) gen :: [Int]+ let sampledExamples =+ [ e+ | (e, r) <- Prelude.zip examples randomInts+ , r < 1+ ] :: [Text]+ forM_ sampledExamples $ \ example' ->+ let input =+ [ HtmlStartTag [] P ""+ , HtmlText [P] example'+ , HtmlEndTag [] P+ ] :: [HtmlEntity]+ in specify ("normalizeStops " ++ show (unpack example')) $ do+ normalizeStops horizontalStops input `shouldBe`+ [ HtmlStartTag [] P ""+ , HtmlText [P]+ "봄·여름·가을·겨울. 어제, 오늘. "+ , HtmlEndTag [] P+ ]+ normalizeStops verticalStops input `shouldBe`+ [ HtmlStartTag [] P ""+ , HtmlText [P]+ "봄·여름·가을·겨울。어제、오늘。"+ , HtmlEndTag [] P+ ]+ normalizeStops horizontalStopsWithSlashes input `shouldBe`+ [ HtmlStartTag [] P ""+ , HtmlText [P] "봄/여름/가을/겨울. 어제, 오늘. "+ , HtmlEndTag [] P+ ]