diff --git a/.travis.yml b/.travis.yml new file mode 100644 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,1 @@ +language: haskell diff --git a/Text/Hyphenation.hs b/Text/Hyphenation.hs deleted file mode 100644 --- a/Text/Hyphenation.hs +++ /dev/null @@ -1,23 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Text.Hyphenation --- Copyright : (C) 2012 Edward Kmett, --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- Stability : provisional --- Portability : portable --- --- Hyphenation based on the Knuth-Liang algorithm as used by TeX. --- --- The implementation is based on Ned Batchelder's public domain @hyphenate.py@ --- and simplified to remove the need for a manual exception list. ----------------------------------------------------------------------------- -module Text.Hyphenation - ( module Text.Hyphenation.Hyphenator - , module Text.Hyphenation.Language - ) where - -import Text.Hyphenation.Hyphenator -import Text.Hyphenation.Language - diff --git a/Text/Hyphenation/Exception.hs b/Text/Hyphenation/Exception.hs deleted file mode 100644 --- a/Text/Hyphenation/Exception.hs +++ /dev/null @@ -1,58 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Text.Hyphenation.Exception --- Copyright : (C) 2012 Edward Kmett, --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- Stability : provisional --- Portability : portable --- ----------------------------------------------------------------------------- -module Text.Hyphenation.Exception - ( - -- * Pattern file support - Exceptions - , addException - , lookupException - , scoreException - , parseExceptions - ) where - -import qualified Data.HashMap.Strict as HM -import Data.Monoid -import Prelude hiding (lookup) - --- manually supplied hyphenations -newtype Exceptions = Exceptions (HM.HashMap String [Int]) - deriving Show - -zipMin :: [Int] -> [Int] -> [Int] -zipMin (x:xs) (y:ys) = min x y : zipMin xs ys -zipMin _ _ = [] - --- | Exceptions permit an exact list of hyphenation locations --- but merging exceptions is used to restrict the set when both contain the same word -instance Monoid Exceptions where - mempty = Exceptions mempty - Exceptions m `mappend` Exceptions n = Exceptions (HM.unionWith zipMin m n) - --- | add an exception to the exception table. --- if it is already present, this will restrict the set of hyphenations to the --- intersection of the set provided and the set present. -addException :: String -> Exceptions -> Exceptions -addException s (Exceptions m) = Exceptions $ - HM.insertWith zipMin (filter (/= '-') s) (scoreException s) m - -lookupException :: String -> Exceptions -> Maybe [Int] -lookupException s (Exceptions m) = HM.lookup s m - -scoreException :: String -> [Int] -scoreException [] = [0] -scoreException (x:ys) - | x == '-' = 1 : if null ys then [] else scoreException (tail ys) - | otherwise = 0 : scoreException ys - --- parse one exception per line from an input string -parseExceptions :: String -> Exceptions -parseExceptions = foldr addException mempty . lines diff --git a/Text/Hyphenation/Hyphenator.hs b/Text/Hyphenation/Hyphenator.hs deleted file mode 100644 --- a/Text/Hyphenation/Hyphenator.hs +++ /dev/null @@ -1,59 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Text.Hyphenation.Hyphenator --- Copyright : (C) 2012 Edward Kmett, --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- Stability : provisional --- Portability : portable --- --- Hyphenation based on the Knuth-Liang algorithm as used by TeX. ----------------------------------------------------------------------------- -module Text.Hyphenation.Hyphenator - ( Hyphenator(..) - -- * Hyphenate with a given set of patterns - , hyphenate - , defaultLeftMin - , defaultRightMin - ) where - -import Text.Hyphenation.Pattern -import Text.Hyphenation.Exception - -defaultLeftMin, defaultRightMin :: Int -defaultLeftMin = 2 -defaultRightMin = 3 - -data Hyphenator = Hyphenator - { hyphenatorChars :: Char -> Char -- ^ a normalization function applied to input characters before applying patterns or exceptions - , hyphenatorPatterns :: Patterns -- ^ hyphenation patterns stored in a trie - , hyphenatorExceptions :: Exceptions -- ^ exceptions to the general hyphenation rules, hyphenated manually - , hyphenatorLeftMin :: {-# UNPACK #-} !Int -- ^ the number of characters as the start of a word to skip hyphenating, by default: 2 - , hyphenatorRightMin :: {-# UNPACK #-} !Int -- ^ the number of characters at the end of the word to skip hyphenating, by default: 3 - } - -hyphenationScore :: Hyphenator -> String -> [Int] -hyphenationScore (Hyphenator nf ps es l r) s - | l + r >= n = replicate (n + 1) 0 - | otherwise = case lookupException ls es of - Just pts -> trim pts - Nothing -> trim (lookupPattern ls ps) - where - trim result = replicate l 0 ++ take (n - l - r) (drop l result) - n = length s - ls = map nf s - --- | hyphenate a single word using the specified Hyphenator. Returns a set of candidate breakpoints by decomposing the input --- into substrings. --- --- > ghci> hyphenate english_US "supercalifragilisticexpialadocious" --- > ["su","per","cal","ifrag","ilis","tic","ex","pi","al","ado","cious"] --- > ghci> hyphenate english_US "hyphenation" --- > ["hy","phen","ation"] -hyphenate :: Hyphenator -> String -> [String] -hyphenate h s0 = go [] s0 $ tail $ hyphenationScore h s0 where - go acc (w:ws) (p:ps) - | odd p = reverse (w:acc) : go [] ws ps - | otherwise = go (w:acc) ws ps - go acc ws _ = [reverse acc ++ ws] diff --git a/Text/Hyphenation/Language.hs b/Text/Hyphenation/Language.hs deleted file mode 100644 --- a/Text/Hyphenation/Language.hs +++ /dev/null @@ -1,365 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Text.Hyphenation.Language --- Copyright : (C) 2012 Edward Kmett, --- (C) 2007 Ned Batchelder --- License : BSD-style (see the languageAffix LICENSE) --- --- Maintainer : Edward Kmett --- Stability : provisional --- Portability : portable --- ----------------------------------------------------------------------------- -module Text.Hyphenation.Language - ( - -- * Pattern file support - Language(..) - , languageHyphenator - -- * Provided language hyphenators - , afrikaans, basque, bengali, bulgarian, catalan, chinese - , coptic, croatian, czech, danish, dutch, english_US, english_GB, esperanto - , estonian, ethiopic, farsi, finnish, french, galician, german_1901, german_1996 - , german_Swiss, greek_Ancient, greek_Mono, greek_Poly, gujarati, hindi, hungarian - , icelandic, indonesian, interlingua, irish, italian, kannada, kurmanji, lao, latin - , latvian, lithuanian, malayalam, marathi, mongolian, norwegian_Bokmal - , norwegian_Nynorsk, oriya, panjabi, polish, portuguese, romanian - , russian, sanskrit, serbian_Cyrillic, serbocroatian_Cyrillic - , serbocroatian_Latin, slovak, slovenian, spanish, swedish, tamil - , telugu, turkish, turkmen, ukrainian, uppersorbian, welsh - , loadHyphenator - , languageAffix - ) where - -import Data.Maybe (fromMaybe) -import qualified Data.IntMap as IM -import Text.Hyphenation.Hyphenator -import Text.Hyphenation.Pattern -import Text.Hyphenation.Exception -import System.IO.Unsafe -import Paths_hyphenation - -chrLine :: String -> [(Int, Char)] -chrLine (x:xs) = map (\y -> (fromEnum y, x)) xs -chrLine [] = [] - --- | Read a built-in language file from the data directory where cabal installed this package. --- --- (e.g. @hyphenateLanguage \"en-us\"@ opens @\"\/Users\/ekmett\/.cabal\/share\/hyphenation-0.2\/ghc-7.4.1\/hyph-en-us.hyp.txt\"@ --- among others when run on the author's local machine) -loadHyphenator :: String -> IO Hyphenator -loadHyphenator language = do - hyp <- getDataFileName ("hyph-" ++ language ++ ".hyp.txt") >>= readFile - pat <- getDataFileName ("hyph-" ++ language ++ ".pat.txt") >>= readFile - chr <- getDataFileName ("hyph-" ++ language ++ ".chr.txt") >>= readFile - let chrMap = IM.fromList (lines chr >>= chrLine) - tryLookup x = fromMaybe x $ IM.lookup (fromEnum x) chrMap - return $ Hyphenator tryLookup (parsePatterns pat) (parseExceptions hyp) defaultLeftMin defaultRightMin - -data Language - = Afrikaans - | Basque - | Bengali - | Bulgarian - | Catalan - | Chinese - | Coptic - | Croatian - | Czech - | Danish - | Dutch - | English_US | English_GB - | Esperanto - | Estonian - | Ethiopic - | Farsi - | Finnish - | French - | Galician - | German_1901 | German_1996 | German_Swiss - | Greek_Ancient - | Greek_Mono - | Greek_Poly - | Gujarati - | Hindi - | Hungarian - | Icelandic - | Indonesian - | Interlingua - | Irish - | Italian - | Kannada - | Kurmanji - | Lao - | Latin - | Latvian - | Lithuanian - | Malayalam - | Marathi - | Mongolian - | Norwegian_Bokmal | Norwegian_Nynorsk - | Oriya - | Panjabi - | Polish - | Portuguese - | Romanian - | Russian - | Sanskrit - | Serbian_Cyrillic - | Serbocroatian_Cyrillic | Serbocroatian_Latin - | Slovak - | Slovenian - | Spanish - | Swedish - | Tamil - | Telugu - | Turkish - | Turkmen - | Ukrainian - | Uppersorbian - | Welsh - deriving (Eq,Ord,Show,Bounded,Enum) - - --- | the infix portion of the data file names used for this language -languageAffix :: Language -> String -languageAffix s = case s of - Afrikaans -> "af" - Basque -> "eu" - Bengali -> "bn" - Bulgarian -> "bg" - Catalan -> "ca" - Chinese -> "zh-latn-pinyin" - Coptic -> "cop" - Croatian -> "hr" - Czech -> "cs" - Danish -> "da" - Dutch -> "nl" - English_US -> "en-us" - English_GB -> "en-gb" - Esperanto -> "eo" - Estonian -> "et" - Ethiopic -> "mul-ethi" - Farsi -> "fa" - Finnish -> "fi" - French -> "fr" - Galician -> "gl" - German_1901 -> "de-1901" - German_1996 -> "de-1996" - German_Swiss -> "de-ch-1901" - Greek_Ancient -> "grc" - Greek_Mono -> "el-monoton" - Greek_Poly -> "el-polyton" - Gujarati -> "gu" - Hindi -> "hi" - Hungarian -> "hu" - Icelandic -> "is" - Indonesian -> "id" - Interlingua -> "ia" - Irish -> "ga" - Italian -> "it" - Kannada -> "kn" - Kurmanji -> "kmr" - Lao -> "lo" - Latin -> "la" - Latvian -> "lv" - Lithuanian -> "lt" - Malayalam -> "ml" - Marathi -> "mr" - Mongolian -> "mn-cyrl" - Norwegian_Bokmal -> "nb" - Norwegian_Nynorsk -> "nn" - Oriya -> "or" - Panjabi -> "pa" - Polish -> "pl" - Portuguese -> "pt" - Romanian -> "ro" - Russian -> "ru" - Sanskrit -> "sa" - Serbian_Cyrillic -> "sr-cyrl" - Serbocroatian_Cyrillic -> "sh-cyrl" - Serbocroatian_Latin -> "sh-latn" - Slovak -> "sk" - Slovenian -> "sl" - Spanish -> "es" - Swedish -> "sv" - Tamil -> "ta" - Telugu -> "te" - Turkish -> "tr" - Turkmen -> "tk" - Ukrainian -> "uk" - Uppersorbian -> "hsb" - Welsh -> "cy" - - --- | --- > ghci> hyphenate english_US "supercalifragilisticexpialadocious" --- > ["su","per","cal","ifrag","ilis","tic","ex","pi","al","ado","cious"] --- --- favors US hyphenation -english_US :: Hyphenator - --- | --- > ghci> hyphenate english_GB "supercalifragilisticexpialadocious" --- > ["su","per","cal","ifrag","ilis","tic","ex","pi","al","ado","cious"] --- --- favors UK hyphenation -english_GB :: Hyphenator - --- | --- > ghci> hyphenate french "anticonstitutionnellement" --- > ["an","ti","cons","ti","tu","tion","nel","le","ment"] -french :: Hyphenator - --- | --- > ghci> hyphenate icelandic "vaðlaheiðavegavinnuverkfærageymsluskúr" --- > ["va\240la","hei\240a","vega","vinnu","verk","f\230ra","geymslu","sk\250r"] -icelandic :: Hyphenator - - -afrikaans, basque, bengali, bulgarian, catalan, chinese, - coptic, croatian, czech, danish, dutch, esperanto, - estonian, ethiopic, farsi, finnish, galician, german_1901, german_1996, - german_Swiss, greek_Ancient, greek_Mono, greek_Poly, gujarati, hindi, hungarian, - indonesian, interlingua, irish, italian, kannada, kurmanji, lao, latin, - latvian, lithuanian, malayalam, marathi, mongolian, norwegian_Bokmal, - norwegian_Nynorsk, oriya, panjabi, polish, portuguese, romanian, - russian, sanskrit, serbian_Cyrillic, serbocroatian_Cyrillic, - serbocroatian_Latin, slovak, slovenian, spanish, swedish, tamil, - telugu, turkish, turkmen, ukrainian, uppersorbian, welsh :: Hyphenator - -afrikaans = unsafePerformIO (loadHyphenator (languageAffix Afrikaans)) -basque = unsafePerformIO (loadHyphenator (languageAffix Basque)) -bengali = unsafePerformIO (loadHyphenator (languageAffix Bengali)) -bulgarian = unsafePerformIO (loadHyphenator (languageAffix Bulgarian)) -catalan = unsafePerformIO (loadHyphenator (languageAffix Catalan)) -chinese = unsafePerformIO (loadHyphenator (languageAffix Chinese)) -coptic = unsafePerformIO (loadHyphenator (languageAffix Coptic)) -croatian = unsafePerformIO (loadHyphenator (languageAffix Croatian)) -czech = unsafePerformIO (loadHyphenator (languageAffix Czech)) -danish = unsafePerformIO (loadHyphenator (languageAffix Danish)) -dutch = unsafePerformIO (loadHyphenator (languageAffix Dutch)) -english_US = unsafePerformIO (loadHyphenator (languageAffix English_US)) -english_GB = unsafePerformIO (loadHyphenator (languageAffix English_GB)) -esperanto = unsafePerformIO (loadHyphenator (languageAffix Esperanto)) -estonian = unsafePerformIO (loadHyphenator (languageAffix Estonian)) -ethiopic = unsafePerformIO (loadHyphenator (languageAffix Ethiopic)) -farsi = unsafePerformIO (loadHyphenator (languageAffix Farsi)) -finnish = unsafePerformIO (loadHyphenator (languageAffix Finnish)) -french = unsafePerformIO (loadHyphenator (languageAffix French)) -galician = unsafePerformIO (loadHyphenator (languageAffix Galician)) -german_1901 = unsafePerformIO (loadHyphenator (languageAffix German_1901)) -german_1996 = unsafePerformIO (loadHyphenator (languageAffix German_1996)) -german_Swiss = unsafePerformIO (loadHyphenator (languageAffix German_Swiss)) -greek_Ancient = unsafePerformIO (loadHyphenator (languageAffix Greek_Ancient)) -greek_Mono = unsafePerformIO (loadHyphenator (languageAffix Greek_Mono)) -greek_Poly = unsafePerformIO (loadHyphenator (languageAffix Greek_Poly)) -gujarati = unsafePerformIO (loadHyphenator (languageAffix Gujarati)) -hindi = unsafePerformIO (loadHyphenator (languageAffix Hindi)) -hungarian = unsafePerformIO (loadHyphenator (languageAffix Hungarian)) -icelandic = unsafePerformIO (loadHyphenator (languageAffix Icelandic)) -indonesian = unsafePerformIO (loadHyphenator (languageAffix Indonesian)) -interlingua = unsafePerformIO (loadHyphenator (languageAffix Interlingua)) -irish = unsafePerformIO (loadHyphenator (languageAffix Irish)) -italian = unsafePerformIO (loadHyphenator (languageAffix Italian)) -kannada = unsafePerformIO (loadHyphenator (languageAffix Kannada)) -kurmanji = unsafePerformIO (loadHyphenator (languageAffix Kurmanji)) -lao = unsafePerformIO (loadHyphenator (languageAffix Lao)) -latin = unsafePerformIO (loadHyphenator (languageAffix Latin)) -latvian = unsafePerformIO (loadHyphenator (languageAffix Latvian)) -lithuanian = unsafePerformIO (loadHyphenator (languageAffix Lithuanian)) -malayalam = unsafePerformIO (loadHyphenator (languageAffix Malayalam)) -marathi = unsafePerformIO (loadHyphenator (languageAffix Marathi)) -mongolian = unsafePerformIO (loadHyphenator (languageAffix Mongolian)) -norwegian_Bokmal = unsafePerformIO (loadHyphenator (languageAffix Norwegian_Bokmal)) -norwegian_Nynorsk = unsafePerformIO (loadHyphenator (languageAffix Norwegian_Nynorsk)) -oriya = unsafePerformIO (loadHyphenator (languageAffix Oriya)) -panjabi = unsafePerformIO (loadHyphenator (languageAffix Panjabi)) -polish = unsafePerformIO (loadHyphenator (languageAffix Polish)) -portuguese = unsafePerformIO (loadHyphenator (languageAffix Portuguese)) -romanian = unsafePerformIO (loadHyphenator (languageAffix Romanian)) -russian = unsafePerformIO (loadHyphenator (languageAffix Russian)) -sanskrit = unsafePerformIO (loadHyphenator (languageAffix Sanskrit)) -serbian_Cyrillic = unsafePerformIO (loadHyphenator (languageAffix Serbian_Cyrillic)) -serbocroatian_Cyrillic = unsafePerformIO (loadHyphenator (languageAffix Serbocroatian_Cyrillic)) -serbocroatian_Latin = unsafePerformIO (loadHyphenator (languageAffix Serbocroatian_Latin)) -slovak = unsafePerformIO (loadHyphenator (languageAffix Slovak)) -slovenian = unsafePerformIO (loadHyphenator (languageAffix Slovenian)) -spanish = unsafePerformIO (loadHyphenator (languageAffix Spanish)) -swedish = unsafePerformIO (loadHyphenator (languageAffix Swedish)) -tamil = unsafePerformIO (loadHyphenator (languageAffix Tamil)) -telugu = unsafePerformIO (loadHyphenator (languageAffix Telugu)) -turkish = unsafePerformIO (loadHyphenator (languageAffix Turkish)) -turkmen = unsafePerformIO (loadHyphenator (languageAffix Turkmen)) -ukrainian = unsafePerformIO (loadHyphenator (languageAffix Ukrainian)) -uppersorbian = unsafePerformIO (loadHyphenator (languageAffix Uppersorbian)) -welsh = unsafePerformIO (loadHyphenator (languageAffix Welsh)) - -languageHyphenator :: Language -> Hyphenator -languageHyphenator s = case s of - Afrikaans -> afrikaans - Basque -> basque - Bengali -> bengali - Bulgarian -> bulgarian - Catalan -> catalan - Chinese -> chinese - Coptic -> coptic - Croatian -> croatian - Czech -> czech - Danish -> danish - Dutch -> dutch - English_US -> english_US - English_GB -> english_GB - Esperanto -> esperanto - Estonian -> estonian - Ethiopic -> ethiopic - Farsi -> farsi - Finnish -> finnish - French -> french - Galician -> galician - German_1901 -> german_1901 - German_1996 -> german_1996 - German_Swiss -> german_Swiss - Greek_Ancient -> greek_Ancient - Greek_Mono -> greek_Mono - Greek_Poly -> greek_Poly - Gujarati -> gujarati - Hindi -> hindi - Hungarian -> hungarian - Icelandic -> icelandic - Indonesian -> indonesian - Interlingua -> interlingua - Irish -> irish - Italian -> italian - Kannada -> kannada - Kurmanji -> kurmanji - Lao -> lao - Latin -> latin - Latvian -> latvian - Lithuanian -> lithuanian - Malayalam -> malayalam - Marathi -> marathi - Mongolian -> mongolian - Norwegian_Bokmal -> norwegian_Bokmal - Norwegian_Nynorsk -> norwegian_Nynorsk - Oriya -> oriya - Panjabi -> panjabi - Polish -> polish - Portuguese -> portuguese - Romanian -> romanian - Russian -> russian - Sanskrit -> sanskrit - Serbian_Cyrillic -> serbian_Cyrillic - Serbocroatian_Cyrillic -> serbocroatian_Cyrillic - Serbocroatian_Latin -> serbocroatian_Latin - Slovak -> slovak - Slovenian -> slovenian - Spanish -> spanish - Swedish -> swedish - Tamil -> tamil - Telugu -> telugu - Turkish -> turkish - Turkmen -> turkmen - Ukrainian -> ukrainian - Uppersorbian -> uppersorbian - Welsh -> welsh - diff --git a/Text/Hyphenation/Pattern.hs b/Text/Hyphenation/Pattern.hs deleted file mode 100644 --- a/Text/Hyphenation/Pattern.hs +++ /dev/null @@ -1,81 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Text.Hyphenation.Pattern --- Copyright : (C) 2012 Edward Kmett, --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- Stability : provisional --- Portability : portable --- ----------------------------------------------------------------------------- -module Text.Hyphenation.Pattern - ( - -- * Pattern file support - Patterns - , insertPattern - , lookupPattern - , scorePattern - , parsePatterns - ) where - -import qualified Data.IntMap as IM -import Data.Monoid -import Prelude hiding (lookup) -import Data.Char (digitToInt, isDigit) - -data Patterns = Patterns [Int] (IM.IntMap Patterns) - deriving Show - -instance Monoid Patterns where - mempty = Patterns [] IM.empty - Patterns ps m `mappend` Patterns qs n = Patterns (zipMax ps qs) (IM.unionWith mappend m n) - --- | Tallies the hyphenation scores for a word considering all tails. -lookupPattern :: String -> Patterns -> [Int] -lookupPattern xs0 = init . tail . go ('.' : xs0 ++ ".") where - go [] (Patterns ys _) = ys - go xxs@(_:xs) t = zipMax (go1 xxs t) (0:go xs t) - go1 [] (Patterns ys _) = ys - go1 (x:xs) (Patterns ys m) = case IM.lookup (fromEnum x) m of - Just t' -> zipMax ys (go1 xs t') - Nothing -> ys - --- | Insert a Knuth-Liang hyphenation pattern into the trie --- --- 1. @.@ denotes the start or end of the input --- --- 2. @0-9@ are used to denote hyphenation or dehyphenation depending on whether or not they are even (no hyphen) or odd (hyphen allowed). --- --- Patterns are overlaid and the maximum value at each location is used. --- this allows you to implement a finite number of precedences between hyphenation rules --- --- (e.g. @3foo.@ indicates that the suffix '-foo' should be hyphenated with precedence 3.) -insertPattern :: String -> Patterns -> Patterns -insertPattern s0 = go (chars s0) where - pts = scorePattern s0 - go [] (Patterns _ m) = Patterns pts m - go (x:xs) (Patterns n m) = Patterns n (IM.insertWith (\_ -> go xs) (fromEnum x) (mk xs) m) - mk [] = Patterns pts IM.empty - mk (x:xs) = Patterns [] (IM.singleton (fromEnum x) (mk xs)) - --- | Parse one pattern per line from an input string --- --- @hyph-utf8@ supplies these files UTF-8 encoded in the @txt@ folder with a @.pat.txt@ extension -parsePatterns :: String -> Patterns -parsePatterns = foldr insertPattern mempty . lines - -chars :: String -> String -chars = filter (\x -> (x < '0' || x > '9')) - -scorePattern :: String -> [Int] -scorePattern [] = [0] -scorePattern (x:ys) - | isDigit x = digitToInt x : if null ys then [] else scorePattern (tail ys) - | otherwise = 0 : scorePattern ys - -zipMax :: [Int] -> [Int] -> [Int] -zipMax (x:xs) (y:ys) = max x y : zipMax xs ys -zipMax [] ys = ys -zipMax xs [] = xs - diff --git a/hyphenation.cabal b/hyphenation.cabal --- a/hyphenation.cabal +++ b/hyphenation.cabal @@ -1,13 +1,14 @@ name: hyphenation category: Text -version: 0.2.1.1 +version: 0.2.1.3 license: BSD3 -cabal-version: >= 1.6 +cabal-version: >= 1.8 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/hyphenation +bug-reports: http://github.com/ekmett/hyphenation/issues copyright: (C) 2012 Edward A. Kmett synopsis: Configurable Knuth-Liang hyphenation description: @@ -19,18 +20,19 @@ . Usage: . - > ghci> hyphenate english_US "supercalifragilisticexpialadocious" - > ["su","per","cal","ifrag","ilis","tic","ex","pi","al","ado","cious"] + >>> hyphenate english_US "supercalifragilisticexpialadocious" + ["su","per","cal","ifrag","ilis","tic","ex","pi","al","ado","cious"] . - > ghci> hyphenate english_US "hyphenation" - > ["hy","phen","ation"] + >>> hyphenate english_US "hyphenation" + ["hy","phen","ation"] . - > ghci> hyphenate icelandic "vaðlaheiðavegavinnuverkfærageymsluskúr" - > ["va\240la","hei\240a","vega","vinnu","verk","f\230ra","geymslu","sk\250r"] + >>> hyphenate icelandic "vaðlaheiðavegavinnuverkfærageymsluskúr" + ["va\240la","hei\240a","vega","vinnu","verk","f\230ra","geymslu","sk\250r"] build-type: Simple data-dir: data data-files: *.hyp.txt, *.pat.txt, *.lic.txt, *.chr.txt +extra-source-files: .travis.yml source-repository head type: git @@ -46,11 +48,23 @@ Text.Hyphenation Text.Hyphenation.Hyphenator Text.Hyphenation.Language - Text.Hyphenation.Exception Text.Hyphenation.Pattern other-modules: Paths_hyphenation + hs-source-dirs: src ghc-options: -Wall + +-- Verify the results of the examples +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + build-depends: + base == 4.*, + directory >= 1.0 && < 1.2, + doctest >= 0.8 && <= 0.9, + filepath >= 1.3 && < 1.4 + ghc-options: -Wall -Werror -threaded + hs-source-dirs: tests diff --git a/src/Text/Hyphenation.hs b/src/Text/Hyphenation.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hyphenation.hs @@ -0,0 +1,23 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Hyphenation +-- Copyright : (C) 2012 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : portable +-- +-- Hyphenation based on the Knuth-Liang algorithm as used by TeX. +-- +-- The implementation is based on Ned Batchelder's public domain @hyphenate.py@ +-- and simplified to remove the need for a manual exception list. +---------------------------------------------------------------------------- +module Text.Hyphenation + ( module Text.Hyphenation.Hyphenator + , module Text.Hyphenation.Language + ) where + +import Text.Hyphenation.Hyphenator +import Text.Hyphenation.Language + diff --git a/src/Text/Hyphenation/Exception.hs b/src/Text/Hyphenation/Exception.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hyphenation/Exception.hs @@ -0,0 +1,60 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Hyphenation.Exception +-- Copyright : (C) 2012 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : portable +-- +---------------------------------------------------------------------------- +module Text.Hyphenation.Exception + ( + -- * Pattern file support + Exceptions + , addException + , lookupException + , scoreException + , parseExceptions + ) where + +import qualified Data.HashMap.Strict as HM +import Data.Monoid +import Prelude hiding (lookup) + +-- | Hyphenation exceptions are special cases that should use the specified hyphenation points. +newtype Exceptions = Exceptions (HM.HashMap String [Int]) + deriving Show + +zipMin :: [Int] -> [Int] -> [Int] +zipMin (x:xs) (y:ys) = min x y : zipMin xs ys +zipMin _ _ = [] + +-- | Exceptions permit an exact list of hyphenation locations +-- but merging exceptions is used to restrict the set when both contain the same word +instance Monoid Exceptions where + mempty = Exceptions mempty + Exceptions m `mappend` Exceptions n = Exceptions (HM.unionWith zipMin m n) + +-- | add an exception to the exception table. +-- if it is already present, this will restrict the set of hyphenations to the +-- intersection of the set provided and the set present. +addException :: String -> Exceptions -> Exceptions +addException s (Exceptions m) = Exceptions $ + HM.insertWith zipMin (filter (/= '-') s) (scoreException s) m + +-- | Try to find a matching hyphenation exception. +lookupException :: String -> Exceptions -> Maybe [Int] +lookupException s (Exceptions m) = HM.lookup s m + +-- | Convert an exception string to a score. +scoreException :: String -> [Int] +scoreException [] = [0] +scoreException (x:ys) + | x == '-' = 1 : if null ys then [] else scoreException (tail ys) + | otherwise = 0 : scoreException ys + +-- | Parse one exception per line from an input string +parseExceptions :: String -> Exceptions +parseExceptions = foldr addException mempty . lines diff --git a/src/Text/Hyphenation/Hyphenator.hs b/src/Text/Hyphenation/Hyphenator.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hyphenation/Hyphenator.hs @@ -0,0 +1,74 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Hyphenation.Hyphenator +-- Copyright : (C) 2012 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : portable +-- +-- Hyphenation based on the Knuth-Liang algorithm as used by TeX. +---------------------------------------------------------------------------- +module Text.Hyphenation.Hyphenator + ( Hyphenator(..) + -- * Hyphenate with a given set of patterns + , hyphenate + , defaultLeftMin + , defaultRightMin + ) where + +import Text.Hyphenation.Pattern +import Text.Hyphenation.Exception + +-- | By default, do not insert hyphens in the first two characters +-- +-- >>> defaultLeftMin +-- 2 +defaultLeftMin :: Int +defaultLeftMin = 2 +-- | By default, do not insert hyphens in the last three characters. +-- +-- >>> defaultRightMin +-- 3 +defaultRightMin :: Int +defaultRightMin = 3 + +-- | A @Hyphenator@ is combination of an alphabet normalization scheme, a set of 'Patterns', a set of 'Exceptions' to those patterns +-- and a number of characters at each end to skip hyphenating. +data Hyphenator = Hyphenator + { hyphenatorChars :: Char -> Char -- ^ a normalization function applied to input characters before applying patterns or exceptions + , hyphenatorPatterns :: Patterns -- ^ hyphenation patterns stored in a trie + , hyphenatorExceptions :: Exceptions -- ^ exceptions to the general hyphenation rules, hyphenated manually + , hyphenatorLeftMin :: {-# UNPACK #-} !Int -- ^ the number of characters as the start of a word to skip hyphenating, by default: 2 + , hyphenatorRightMin :: {-# UNPACK #-} !Int -- ^ the number of characters at the end of the word to skip hyphenating, by default: 3 + } + +-- | Using a 'Hyphenator', compute the score of a string. +hyphenationScore :: Hyphenator -> String -> [Int] +hyphenationScore (Hyphenator nf ps es l r) s + | l + r >= n = replicate (n + 1) 0 + | otherwise = case lookupException ls es of + Just pts -> trim pts + Nothing -> trim (lookupPattern ls ps) + where + trim result = replicate l 0 ++ take (n - l - r) (drop l result) + n = length s + ls = map nf s + +-- | hyphenate a single word using the specified Hyphenator. Returns a set of candidate breakpoints by decomposing the input +-- into substrings. +-- +-- >>> import Text.Hyphenation +-- +-- >>> hyphenate english_US "supercalifragilisticexpialadocious" +-- ["su","per","cal","ifrag","ilis","tic","ex","pi","al","ado","cious"] +-- +-- >>> hyphenate english_US "hyphenation" +-- ["hy","phen","ation"] +hyphenate :: Hyphenator -> String -> [String] +hyphenate h s0 = go [] s0 $ tail $ hyphenationScore h s0 where + go acc (w:ws) (p:ps) + | odd p = reverse (w:acc) : go [] ws ps + | otherwise = go (w:acc) ws ps + go acc ws _ = [reverse acc ++ ws] diff --git a/src/Text/Hyphenation/Language.hs b/src/Text/Hyphenation/Language.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hyphenation/Language.hs @@ -0,0 +1,367 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Hyphenation.Language +-- Copyright : (C) 2012 Edward Kmett, +-- (C) 2007 Ned Batchelder +-- License : BSD-style (see the languageAffix LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : portable +-- +---------------------------------------------------------------------------- +module Text.Hyphenation.Language + ( + -- * Pattern file support + Language(..) + , languageHyphenator + -- * Provided language hyphenators + , afrikaans, basque, bengali, bulgarian, catalan, chinese + , coptic, croatian, czech, danish, dutch, english_US, english_GB, esperanto + , estonian, ethiopic, farsi, finnish, french, galician, german_1901, german_1996 + , german_Swiss, greek_Ancient, greek_Mono, greek_Poly, gujarati, hindi, hungarian + , icelandic, indonesian, interlingua, irish, italian, kannada, kurmanji, lao, latin + , latvian, lithuanian, malayalam, marathi, mongolian, norwegian_Bokmal + , norwegian_Nynorsk, oriya, panjabi, polish, portuguese, romanian + , russian, sanskrit, serbian_Cyrillic, serbocroatian_Cyrillic + , serbocroatian_Latin, slovak, slovenian, spanish, swedish, tamil + , telugu, turkish, turkmen, ukrainian, uppersorbian, welsh + , loadHyphenator + , languageAffix + ) where + +import Data.Maybe (fromMaybe) +import qualified Data.IntMap as IM +import Text.Hyphenation.Hyphenator +import Text.Hyphenation.Pattern +import Text.Hyphenation.Exception +import System.IO.Unsafe +import Paths_hyphenation + +chrLine :: String -> [(Int, Char)] +chrLine (x:xs) = map (\y -> (fromEnum y, x)) xs +chrLine [] = [] + +-- | Read a built-in language file from the data directory where cabal installed this package. +-- +-- (e.g. @hyphenateLanguage \"en-us\"@ opens @\"\/Users\/ekmett\/.cabal\/share\/hyphenation-0.2\/ghc-7.4.1\/hyph-en-us.hyp.txt\"@ +-- among others when run on the author's local machine) +loadHyphenator :: String -> IO Hyphenator +loadHyphenator language = do + hyp <- getDataFileName ("hyph-" ++ language ++ ".hyp.txt") >>= readFile + pat <- getDataFileName ("hyph-" ++ language ++ ".pat.txt") >>= readFile + chr <- getDataFileName ("hyph-" ++ language ++ ".chr.txt") >>= readFile + let chrMap = IM.fromList (lines chr >>= chrLine) + tryLookup x = fromMaybe x $ IM.lookup (fromEnum x) chrMap + return $ Hyphenator tryLookup (parsePatterns pat) (parseExceptions hyp) defaultLeftMin defaultRightMin + +-- | A strongly typed set of available languages you can use for hyphenation. +data Language + = Afrikaans + | Basque + | Bengali + | Bulgarian + | Catalan + | Chinese + | Coptic + | Croatian + | Czech + | Danish + | Dutch + | English_US | English_GB + | Esperanto + | Estonian + | Ethiopic + | Farsi + | Finnish + | French + | Galician + | German_1901 | German_1996 | German_Swiss + | Greek_Ancient + | Greek_Mono + | Greek_Poly + | Gujarati + | Hindi + | Hungarian + | Icelandic + | Indonesian + | Interlingua + | Irish + | Italian + | Kannada + | Kurmanji + | Lao + | Latin + | Latvian + | Lithuanian + | Malayalam + | Marathi + | Mongolian + | Norwegian_Bokmal | Norwegian_Nynorsk + | Oriya + | Panjabi + | Polish + | Portuguese + | Romanian + | Russian + | Sanskrit + | Serbian_Cyrillic + | Serbocroatian_Cyrillic | Serbocroatian_Latin + | Slovak + | Slovenian + | Spanish + | Swedish + | Tamil + | Telugu + | Turkish + | Turkmen + | Ukrainian + | Uppersorbian + | Welsh + deriving (Eq,Ord,Show,Bounded,Enum) + + +-- | the infix portion of the data file names used for this language +languageAffix :: Language -> String +languageAffix s = case s of + Afrikaans -> "af" + Basque -> "eu" + Bengali -> "bn" + Bulgarian -> "bg" + Catalan -> "ca" + Chinese -> "zh-latn-pinyin" + Coptic -> "cop" + Croatian -> "hr" + Czech -> "cs" + Danish -> "da" + Dutch -> "nl" + English_US -> "en-us" + English_GB -> "en-gb" + Esperanto -> "eo" + Estonian -> "et" + Ethiopic -> "mul-ethi" + Farsi -> "fa" + Finnish -> "fi" + French -> "fr" + Galician -> "gl" + German_1901 -> "de-1901" + German_1996 -> "de-1996" + German_Swiss -> "de-ch-1901" + Greek_Ancient -> "grc" + Greek_Mono -> "el-monoton" + Greek_Poly -> "el-polyton" + Gujarati -> "gu" + Hindi -> "hi" + Hungarian -> "hu" + Icelandic -> "is" + Indonesian -> "id" + Interlingua -> "ia" + Irish -> "ga" + Italian -> "it" + Kannada -> "kn" + Kurmanji -> "kmr" + Lao -> "lo" + Latin -> "la" + Latvian -> "lv" + Lithuanian -> "lt" + Malayalam -> "ml" + Marathi -> "mr" + Mongolian -> "mn-cyrl" + Norwegian_Bokmal -> "nb" + Norwegian_Nynorsk -> "nn" + Oriya -> "or" + Panjabi -> "pa" + Polish -> "pl" + Portuguese -> "pt" + Romanian -> "ro" + Russian -> "ru" + Sanskrit -> "sa" + Serbian_Cyrillic -> "sr-cyrl" + Serbocroatian_Cyrillic -> "sh-cyrl" + Serbocroatian_Latin -> "sh-latn" + Slovak -> "sk" + Slovenian -> "sl" + Spanish -> "es" + Swedish -> "sv" + Tamil -> "ta" + Telugu -> "te" + Turkish -> "tr" + Turkmen -> "tk" + Ukrainian -> "uk" + Uppersorbian -> "hsb" + Welsh -> "cy" + + +-- | +-- >>> hyphenate english_US "supercalifragilisticexpialadocious" +-- ["su","per","cal","ifrag","ilis","tic","ex","pi","al","ado","cious"] +-- +-- favors US hyphenation +english_US :: Hyphenator + +-- | +-- >>> hyphenate english_GB "supercalifragilisticexpialadocious" +-- ["su","per","cal","i","fra","gil","istic","ex","pi","alado","cious"] +-- +-- favors UK hyphenation +english_GB :: Hyphenator + +-- | +-- >>> hyphenate french "anticonstitutionnellement" +-- ["an","ti","cons","ti","tu","tion","nel","le","ment"] +french :: Hyphenator + +-- | +-- >>> hyphenate icelandic "vaðlaheiðavegavinnuverkfærageymsluskúr" +-- ["va\240la","hei\240a","vega","vinnu","verk","f\230ra","geymslu","sk\250r"] +icelandic :: Hyphenator + +-- | Hyphenators for a wide array of languages. +afrikaans, basque, bengali, bulgarian, catalan, chinese, + coptic, croatian, czech, danish, dutch, esperanto, + estonian, ethiopic, farsi, finnish, galician, german_1901, german_1996, + german_Swiss, greek_Ancient, greek_Mono, greek_Poly, gujarati, hindi, hungarian, + indonesian, interlingua, irish, italian, kannada, kurmanji, lao, latin, + latvian, lithuanian, malayalam, marathi, mongolian, norwegian_Bokmal, + norwegian_Nynorsk, oriya, panjabi, polish, portuguese, romanian, + russian, sanskrit, serbian_Cyrillic, serbocroatian_Cyrillic, + serbocroatian_Latin, slovak, slovenian, spanish, swedish, tamil, + telugu, turkish, turkmen, ukrainian, uppersorbian, welsh :: Hyphenator + +afrikaans = unsafePerformIO (loadHyphenator (languageAffix Afrikaans)) +basque = unsafePerformIO (loadHyphenator (languageAffix Basque)) +bengali = unsafePerformIO (loadHyphenator (languageAffix Bengali)) +bulgarian = unsafePerformIO (loadHyphenator (languageAffix Bulgarian)) +catalan = unsafePerformIO (loadHyphenator (languageAffix Catalan)) +chinese = unsafePerformIO (loadHyphenator (languageAffix Chinese)) +coptic = unsafePerformIO (loadHyphenator (languageAffix Coptic)) +croatian = unsafePerformIO (loadHyphenator (languageAffix Croatian)) +czech = unsafePerformIO (loadHyphenator (languageAffix Czech)) +danish = unsafePerformIO (loadHyphenator (languageAffix Danish)) +dutch = unsafePerformIO (loadHyphenator (languageAffix Dutch)) +english_US = unsafePerformIO (loadHyphenator (languageAffix English_US)) +english_GB = unsafePerformIO (loadHyphenator (languageAffix English_GB)) +esperanto = unsafePerformIO (loadHyphenator (languageAffix Esperanto)) +estonian = unsafePerformIO (loadHyphenator (languageAffix Estonian)) +ethiopic = unsafePerformIO (loadHyphenator (languageAffix Ethiopic)) +farsi = unsafePerformIO (loadHyphenator (languageAffix Farsi)) +finnish = unsafePerformIO (loadHyphenator (languageAffix Finnish)) +french = unsafePerformIO (loadHyphenator (languageAffix French)) +galician = unsafePerformIO (loadHyphenator (languageAffix Galician)) +german_1901 = unsafePerformIO (loadHyphenator (languageAffix German_1901)) +german_1996 = unsafePerformIO (loadHyphenator (languageAffix German_1996)) +german_Swiss = unsafePerformIO (loadHyphenator (languageAffix German_Swiss)) +greek_Ancient = unsafePerformIO (loadHyphenator (languageAffix Greek_Ancient)) +greek_Mono = unsafePerformIO (loadHyphenator (languageAffix Greek_Mono)) +greek_Poly = unsafePerformIO (loadHyphenator (languageAffix Greek_Poly)) +gujarati = unsafePerformIO (loadHyphenator (languageAffix Gujarati)) +hindi = unsafePerformIO (loadHyphenator (languageAffix Hindi)) +hungarian = unsafePerformIO (loadHyphenator (languageAffix Hungarian)) +icelandic = unsafePerformIO (loadHyphenator (languageAffix Icelandic)) +indonesian = unsafePerformIO (loadHyphenator (languageAffix Indonesian)) +interlingua = unsafePerformIO (loadHyphenator (languageAffix Interlingua)) +irish = unsafePerformIO (loadHyphenator (languageAffix Irish)) +italian = unsafePerformIO (loadHyphenator (languageAffix Italian)) +kannada = unsafePerformIO (loadHyphenator (languageAffix Kannada)) +kurmanji = unsafePerformIO (loadHyphenator (languageAffix Kurmanji)) +lao = unsafePerformIO (loadHyphenator (languageAffix Lao)) +latin = unsafePerformIO (loadHyphenator (languageAffix Latin)) +latvian = unsafePerformIO (loadHyphenator (languageAffix Latvian)) +lithuanian = unsafePerformIO (loadHyphenator (languageAffix Lithuanian)) +malayalam = unsafePerformIO (loadHyphenator (languageAffix Malayalam)) +marathi = unsafePerformIO (loadHyphenator (languageAffix Marathi)) +mongolian = unsafePerformIO (loadHyphenator (languageAffix Mongolian)) +norwegian_Bokmal = unsafePerformIO (loadHyphenator (languageAffix Norwegian_Bokmal)) +norwegian_Nynorsk = unsafePerformIO (loadHyphenator (languageAffix Norwegian_Nynorsk)) +oriya = unsafePerformIO (loadHyphenator (languageAffix Oriya)) +panjabi = unsafePerformIO (loadHyphenator (languageAffix Panjabi)) +polish = unsafePerformIO (loadHyphenator (languageAffix Polish)) +portuguese = unsafePerformIO (loadHyphenator (languageAffix Portuguese)) +romanian = unsafePerformIO (loadHyphenator (languageAffix Romanian)) +russian = unsafePerformIO (loadHyphenator (languageAffix Russian)) +sanskrit = unsafePerformIO (loadHyphenator (languageAffix Sanskrit)) +serbian_Cyrillic = unsafePerformIO (loadHyphenator (languageAffix Serbian_Cyrillic)) +serbocroatian_Cyrillic = unsafePerformIO (loadHyphenator (languageAffix Serbocroatian_Cyrillic)) +serbocroatian_Latin = unsafePerformIO (loadHyphenator (languageAffix Serbocroatian_Latin)) +slovak = unsafePerformIO (loadHyphenator (languageAffix Slovak)) +slovenian = unsafePerformIO (loadHyphenator (languageAffix Slovenian)) +spanish = unsafePerformIO (loadHyphenator (languageAffix Spanish)) +swedish = unsafePerformIO (loadHyphenator (languageAffix Swedish)) +tamil = unsafePerformIO (loadHyphenator (languageAffix Tamil)) +telugu = unsafePerformIO (loadHyphenator (languageAffix Telugu)) +turkish = unsafePerformIO (loadHyphenator (languageAffix Turkish)) +turkmen = unsafePerformIO (loadHyphenator (languageAffix Turkmen)) +ukrainian = unsafePerformIO (loadHyphenator (languageAffix Ukrainian)) +uppersorbian = unsafePerformIO (loadHyphenator (languageAffix Uppersorbian)) +welsh = unsafePerformIO (loadHyphenator (languageAffix Welsh)) + +-- | Load (and cache) the hyphenator for a given language. +languageHyphenator :: Language -> Hyphenator +languageHyphenator s = case s of + Afrikaans -> afrikaans + Basque -> basque + Bengali -> bengali + Bulgarian -> bulgarian + Catalan -> catalan + Chinese -> chinese + Coptic -> coptic + Croatian -> croatian + Czech -> czech + Danish -> danish + Dutch -> dutch + English_US -> english_US + English_GB -> english_GB + Esperanto -> esperanto + Estonian -> estonian + Ethiopic -> ethiopic + Farsi -> farsi + Finnish -> finnish + French -> french + Galician -> galician + German_1901 -> german_1901 + German_1996 -> german_1996 + German_Swiss -> german_Swiss + Greek_Ancient -> greek_Ancient + Greek_Mono -> greek_Mono + Greek_Poly -> greek_Poly + Gujarati -> gujarati + Hindi -> hindi + Hungarian -> hungarian + Icelandic -> icelandic + Indonesian -> indonesian + Interlingua -> interlingua + Irish -> irish + Italian -> italian + Kannada -> kannada + Kurmanji -> kurmanji + Lao -> lao + Latin -> latin + Latvian -> latvian + Lithuanian -> lithuanian + Malayalam -> malayalam + Marathi -> marathi + Mongolian -> mongolian + Norwegian_Bokmal -> norwegian_Bokmal + Norwegian_Nynorsk -> norwegian_Nynorsk + Oriya -> oriya + Panjabi -> panjabi + Polish -> polish + Portuguese -> portuguese + Romanian -> romanian + Russian -> russian + Sanskrit -> sanskrit + Serbian_Cyrillic -> serbian_Cyrillic + Serbocroatian_Cyrillic -> serbocroatian_Cyrillic + Serbocroatian_Latin -> serbocroatian_Latin + Slovak -> slovak + Slovenian -> slovenian + Spanish -> spanish + Swedish -> swedish + Tamil -> tamil + Telugu -> telugu + Turkish -> turkish + Turkmen -> turkmen + Ukrainian -> ukrainian + Uppersorbian -> uppersorbian + Welsh -> welsh + diff --git a/src/Text/Hyphenation/Pattern.hs b/src/Text/Hyphenation/Pattern.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hyphenation/Pattern.hs @@ -0,0 +1,84 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.Hyphenation.Pattern +-- Copyright : (C) 2012 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : portable +-- +---------------------------------------------------------------------------- +module Text.Hyphenation.Pattern + ( + -- * Pattern file support + Patterns + , insertPattern + , lookupPattern + , scorePattern + , parsePatterns + ) where + +import qualified Data.IntMap as IM +import Data.Monoid +import Prelude hiding (lookup) +import Data.Char (digitToInt, isDigit) + +-- | Hyphenation patterns +data Patterns = Patterns [Int] (IM.IntMap Patterns) + deriving Show + +instance Monoid Patterns where + mempty = Patterns [] IM.empty + Patterns ps m `mappend` Patterns qs n = Patterns (zipMax ps qs) (IM.unionWith mappend m n) + +-- | Tallies the hyphenation scores for a word considering all tails. +lookupPattern :: String -> Patterns -> [Int] +lookupPattern xs0 = init . tail . go ('.' : xs0 ++ ".") where + go [] (Patterns ys _) = ys + go xxs@(_:xs) t = zipMax (go1 xxs t) (0:go xs t) + go1 [] (Patterns ys _) = ys + go1 (x:xs) (Patterns ys m) = case IM.lookup (fromEnum x) m of + Just t' -> zipMax ys (go1 xs t') + Nothing -> ys + +-- | Insert a Knuth-Liang hyphenation pattern into the trie +-- +-- 1. @.@ denotes the start or end of the input +-- +-- 2. @0-9@ are used to denote hyphenation or dehyphenation depending on whether or not they are even (no hyphen) or odd (hyphen allowed). +-- +-- Patterns are overlaid and the maximum value at each location is used. +-- this allows you to implement a finite number of precedences between hyphenation rules +-- +-- (e.g. @3foo.@ indicates that the suffix '-foo' should be hyphenated with precedence 3.) +insertPattern :: String -> Patterns -> Patterns +insertPattern s0 = go (chars s0) where + pts = scorePattern s0 + go [] (Patterns _ m) = Patterns pts m + go (x:xs) (Patterns n m) = Patterns n (IM.insertWith (\_ -> go xs) (fromEnum x) (mk xs) m) + mk [] = Patterns pts IM.empty + mk (x:xs) = Patterns [] (IM.singleton (fromEnum x) (mk xs)) + +-- | Parse one pattern per line from an input string +-- +-- @hyph-utf8@ supplies these files UTF-8 encoded in the @txt@ folder with a @.pat.txt@ extension +parsePatterns :: String -> Patterns +parsePatterns = foldr insertPattern mempty . lines + +chars :: String -> String +chars = filter (\x -> (x < '0' || x > '9')) + +-- | Convert a Pattern string to a Score +scorePattern :: String -> [Int] +scorePattern [] = [0] +scorePattern (x:ys) + | isDigit x = digitToInt x : if null ys then [] else scorePattern (tail ys) + | otherwise = 0 : scorePattern ys + +-- | Zip two scores. +zipMax :: [Int] -> [Int] -> [Int] +zipMax (x:xs) (y:ys) = max x y : zipMax xs ys +zipMax [] ys = ys +zipMax xs [] = xs + diff --git a/tests/doctests.hs b/tests/doctests.hs new file mode 100644 --- /dev/null +++ b/tests/doctests.hs @@ -0,0 +1,28 @@ +module Main where + +import Test.DocTest +import System.Directory +import System.FilePath +import Control.Applicative +import Control.Monad +import Data.List + +main :: IO () +main = getSources >>= \sources -> doctest $ + "-isrc" + : "-idist/build/autogen" + : "-optP-include" + : "-optPdist/build/autogen/cabal_macros.h" + : sources + +getSources :: IO [FilePath] +getSources = filter (isSuffixOf ".hs") <$> go "src" + where + go dir = do + (dirs, files) <- getFilesAndDirectories dir + (files ++) . concat <$> mapM go dirs + +getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) +getFilesAndDirectories dir = do + c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir + (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c