{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#if EMBED
{-# LANGUAGE TemplateHaskell #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Hyphenation.Language
-- Copyright   :  (C) 2012-2019 Edward Kmett,
--                (C) 2007 Ned Batchelder
-- License     :  BSD-style (see the languageAffix LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
----------------------------------------------------------------------------
module Text.Hyphenation.Language
  (
  -- * Pattern file support
    Language(..)
  , languageHyphenator
  -- * Provided language hyphenators
  , afrikaans, armenian, assamese, basque, bengali, bulgarian, catalan, chinese
  , coptic, croatian, czech, danish, dutch, english_US, english_GB, esperanto
  , estonian, ethiopic, {- farsi, -} finnish, french, friulan, galician, georgian, german_1901, german_1996
  , german_Swiss, greek_Ancient, greek_Mono, greek_Poly, gujarati, hindi, hungarian
  , icelandic, indonesian, interlingua, irish, italian, kannada, kurmanji, latin, latin_Classic
  , latvian, lithuanian, malayalam, marathi, mongolian, norwegian_Bokmal
  , norwegian_Nynorsk, occitan, oriya, panjabi, piedmontese, polish, portuguese, romanian, romansh
  , russian, sanskrit, serbian_Cyrillic, serbocroatian_Cyrillic
  , serbocroatian_Latin, slovak, slovenian, spanish, swedish, tamil
  , telugu, thai, turkish, turkmen, ukrainian, uppersorbian, welsh
  , loadHyphenator
  , languageAffix
  ) where

import Codec.Compression.GZip
#if __GLASGOW_HASKELL__ < 710
import Data.Functor ((<$>))
#endif
import qualified Data.IntMap as IM
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Text.Hyphenation.ByteStringLazyCompat as Lazy
import Text.Hyphenation.Hyphenator
import Text.Hyphenation.Pattern
import Text.Hyphenation.Exception
import System.IO.Unsafe

#if !EMBED
import Paths_hyphenation
#else
import Data.FileEmbed
import qualified Data.ByteString.Char8 as Strict

hyphenatorFiles :: [(FilePath, Strict.ByteString)]
hyphenatorFiles :: [(FilePath, ByteString)]
hyphenatorFiles = $(embedDir "data")
#endif

-- $setup
-- >>> import Text.Hyphenation.Hyphenator

chrLine :: String -> [(Int, Char)]
chrLine :: FilePath -> [(Int, Char)]
chrLine (Char
x:FilePath
xs) = (Char -> (Int, Char)) -> FilePath -> [(Int, Char)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
y -> (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
y, Char
x)) FilePath
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 :: Language -> IO Hyphenator
#if !EMBED
loadHyphenator language = do
  let affix = languageAffix language
  hyp <- unzipUtf8 <$> (getDataFileName ("hyph-" ++ affix ++ ".hyp.txt.gz") >>= Lazy.readFile)
  pat <- unzipUtf8 <$> (getDataFileName ("hyph-" ++ affix ++ ".pat.txt.gz") >>= Lazy.readFile)
  chr <- unzipUtf8 <$> (getDataFileName ("hyph-" ++ affix ++ ".chr.txt.gz") >>= Lazy.readFile)
  let chrMap = IM.fromList (Prelude.lines chr >>= chrLine)
      tryLookup x = IM.findWithDefault x (fromEnum x) chrMap
      (defaultLeftMin, defaultRightMin) = languageMins language
  return $ Hyphenator tryLookup (parsePatterns pat) (parseExceptions hyp) defaultLeftMin defaultRightMin
#else
loadHyphenator :: Language -> IO Hyphenator
loadHyphenator Language
language = Hyphenator -> IO Hyphenator
forall (m :: * -> *) a. Monad m => a -> m a
return (Hyphenator -> IO Hyphenator) -> Hyphenator -> IO Hyphenator
forall a b. (a -> b) -> a -> b
$ (Char -> Char)
-> Patterns -> Exceptions -> Int -> Int -> Hyphenator
Hyphenator Char -> Char
tryLookup (FilePath -> Patterns
parsePatterns FilePath
pat) (FilePath -> Exceptions
parseExceptions FilePath
hyp) Int
defaultLeftMin Int
defaultRightMin
  where affix :: FilePath
affix = Language -> FilePath
languageAffix Language
language
        Just FilePath
hyp = ByteString -> FilePath
unzipUtf8 (ByteString -> FilePath)
-> (ByteString -> ByteString) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.fromStrict (ByteString -> FilePath) -> Maybe ByteString -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [(FilePath, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath
"hyph-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
affix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".hyp.txt.gz") [(FilePath, ByteString)]
hyphenatorFiles
        Just FilePath
pat = ByteString -> FilePath
unzipUtf8 (ByteString -> FilePath)
-> (ByteString -> ByteString) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.fromStrict (ByteString -> FilePath) -> Maybe ByteString -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [(FilePath, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath
"hyph-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
affix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".pat.txt.gz") [(FilePath, ByteString)]
hyphenatorFiles
        Just FilePath
chr = ByteString -> FilePath
unzipUtf8 (ByteString -> FilePath)
-> (ByteString -> ByteString) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.fromStrict (ByteString -> FilePath) -> Maybe ByteString -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [(FilePath, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath
"hyph-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
affix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".chr.txt.gz") [(FilePath, ByteString)]
hyphenatorFiles
        chrMap :: IntMap Char
chrMap = [(Int, Char)] -> IntMap Char
forall a. [(Int, a)] -> IntMap a
IM.fromList (FilePath -> [FilePath]
Prelude.lines FilePath
chr [FilePath] -> (FilePath -> [(Int, Char)]) -> [(Int, Char)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> [(Int, Char)]
chrLine)
        (Int
defaultLeftMin, Int
defaultRightMin) = Language -> (Int, Int)
languageMins Language
language
        tryLookup :: Char -> Char
tryLookup Char
x = Char -> Int -> IntMap Char -> Char
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault Char
x (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
x) IntMap Char
chrMap
#endif

unzipUtf8 :: ByteString -> String
unzipUtf8 :: ByteString -> FilePath
unzipUtf8 =
  Text -> FilePath
T.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
T.decodeUtf8With (\ FilePath
_ -> (Word8 -> Char) -> Maybe Word8 -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a. Enum a => a -> Int
fromEnum))
  (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decompress

-- | A strongly typed set of available languages you can use for hyphenation.
data Language
  = Afrikaans
  | Armenian
  | Assamese
  | Basque
  | Bengali
  | Bulgarian
  | Catalan
  | Chinese
  | Coptic
  | Croatian
  | Czech
  | Danish
  | Dutch
  | English_US | English_GB
  | Esperanto
  | Estonian
  | Ethiopic
  -- | Farsi
  | Finnish
  | French
  | Friulan
  | Galician
  | Georgian
  | German_1901 | German_1996 | German_Swiss
  | Greek_Ancient
  | Greek_Mono
  | Greek_Poly
  | Gujarati
  | Hindi
  | Hungarian
  | Icelandic
  | Indonesian
  | Interlingua
  | Irish
  | Italian
  | Kannada
  | Kurmanji
  | Latin
  | Latin_Classic
  | Latvian
  | Lithuanian
  | Malayalam
  | Marathi
  | Mongolian
  | Norwegian_Bokmal | Norwegian_Nynorsk
  | Occitan
  | Oriya
  | Panjabi
  | Piedmontese
  | Polish
  | Portuguese
  | Romanian
  | Romansh
  | Russian
  | Sanskrit
  | Serbian_Cyrillic
  | Serbocroatian_Cyrillic | Serbocroatian_Latin
  | Slovak
  | Slovenian
  | Spanish
  | Swedish
  | Tamil
  | Telugu
  | Thai
  | Turkish
  | Turkmen
  | Ukrainian
  | Uppersorbian
  | Welsh
  deriving (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq,Eq Language
Eq Language
-> (Language -> Language -> Ordering)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Language)
-> (Language -> Language -> Language)
-> Ord Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmax :: Language -> Language -> Language
>= :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c< :: Language -> Language -> Bool
compare :: Language -> Language -> Ordering
$ccompare :: Language -> Language -> Ordering
$cp1Ord :: Eq Language
Ord,Int -> Language -> FilePath -> FilePath
[Language] -> FilePath -> FilePath
Language -> FilePath
(Int -> Language -> FilePath -> FilePath)
-> (Language -> FilePath)
-> ([Language] -> FilePath -> FilePath)
-> Show Language
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Language] -> FilePath -> FilePath
$cshowList :: [Language] -> FilePath -> FilePath
show :: Language -> FilePath
$cshow :: Language -> FilePath
showsPrec :: Int -> Language -> FilePath -> FilePath
$cshowsPrec :: Int -> Language -> FilePath -> FilePath
Show,Language
Language -> Language -> Bounded Language
forall a. a -> a -> Bounded a
maxBound :: Language
$cmaxBound :: Language
minBound :: Language
$cminBound :: Language
Bounded,Int -> Language
Language -> Int
Language -> [Language]
Language -> Language
Language -> Language -> [Language]
Language -> Language -> Language -> [Language]
(Language -> Language)
-> (Language -> Language)
-> (Int -> Language)
-> (Language -> Int)
-> (Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> Language -> [Language])
-> Enum Language
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Language -> Language -> Language -> [Language]
$cenumFromThenTo :: Language -> Language -> Language -> [Language]
enumFromTo :: Language -> Language -> [Language]
$cenumFromTo :: Language -> Language -> [Language]
enumFromThen :: Language -> Language -> [Language]
$cenumFromThen :: Language -> Language -> [Language]
enumFrom :: Language -> [Language]
$cenumFrom :: Language -> [Language]
fromEnum :: Language -> Int
$cfromEnum :: Language -> Int
toEnum :: Int -> Language
$ctoEnum :: Int -> Language
pred :: Language -> Language
$cpred :: Language -> Language
succ :: Language -> Language
$csucc :: Language -> Language
Enum)


-- | the infix portion of the data file names used for this language
languageAffix :: Language -> String
languageAffix :: Language -> FilePath
languageAffix Language
s = case Language
s of
  Language
Afrikaans -> FilePath
"af"
  Language
Armenian -> FilePath
"hy"
  Language
Assamese -> FilePath
"as"
  Language
Basque -> FilePath
"eu"
  Language
Bengali -> FilePath
"bn"
  Language
Bulgarian -> FilePath
"bg"
  Language
Catalan -> FilePath
"ca"
  Language
Chinese -> FilePath
"zh-latn-pinyin"
  Language
Coptic -> FilePath
"cop"
  Language
Croatian -> FilePath
"hr"
  Language
Czech -> FilePath
"cs"
  Language
Danish -> FilePath
"da"
  Language
Dutch -> FilePath
"nl"
  Language
English_US -> FilePath
"en-us"
  Language
English_GB -> FilePath
"en-gb"
  Language
Esperanto -> FilePath
"eo"
  Language
Estonian -> FilePath
"et"
  Language
Ethiopic -> FilePath
"mul-ethi"
  -- Farsi -> "fa"
  Language
Finnish -> FilePath
"fi"
  Language
French -> FilePath
"fr"
  Language
Friulan -> FilePath
"fur"
  Language
Galician -> FilePath
"gl"
  Language
Georgian -> FilePath
"ka"
  Language
German_1901  -> FilePath
"de-1901"
  Language
German_1996  -> FilePath
"de-1996"
  Language
German_Swiss -> FilePath
"de-ch-1901"
  Language
Greek_Ancient -> FilePath
"grc"
  Language
Greek_Mono -> FilePath
"el-monoton"
  Language
Greek_Poly -> FilePath
"el-polyton"
  Language
Gujarati -> FilePath
"gu"
  Language
Hindi -> FilePath
"hi"
  Language
Hungarian -> FilePath
"hu"
  Language
Icelandic -> FilePath
"is"
  Language
Indonesian -> FilePath
"id"
  Language
Interlingua -> FilePath
"ia"
  Language
Irish -> FilePath
"ga"
  Language
Italian -> FilePath
"it"
  Language
Kannada -> FilePath
"kn"
  Language
Kurmanji -> FilePath
"kmr"
  Language
Latin -> FilePath
"la"
  Language
Latin_Classic -> FilePath
"la-x-classic"
  Language
Latvian -> FilePath
"lv"
  Language
Lithuanian -> FilePath
"lt"
  Language
Malayalam -> FilePath
"ml"
  Language
Marathi -> FilePath
"mr"
  Language
Mongolian -> FilePath
"mn-cyrl"
  Language
Norwegian_Bokmal  -> FilePath
"nb"
  Language
Norwegian_Nynorsk -> FilePath
"nn"
  Language
Occitan -> FilePath
"oc"
  Language
Oriya -> FilePath
"or"
  Language
Panjabi -> FilePath
"pa"
  Language
Piedmontese -> FilePath
"pms"
  Language
Polish -> FilePath
"pl"
  Language
Portuguese -> FilePath
"pt"
  Language
Romanian -> FilePath
"ro"
  Language
Romansh -> FilePath
"rm"
  Language
Russian -> FilePath
"ru"
  Language
Sanskrit -> FilePath
"sa"
  Language
Serbian_Cyrillic -> FilePath
"sr-cyrl"
  Language
Serbocroatian_Cyrillic -> FilePath
"sh-cyrl"
  Language
Serbocroatian_Latin -> FilePath
"sh-latn"
  Language
Slovak -> FilePath
"sk"
  Language
Slovenian -> FilePath
"sl"
  Language
Spanish -> FilePath
"es"
  Language
Swedish -> FilePath
"sv"
  Language
Tamil -> FilePath
"ta"
  Language
Telugu -> FilePath
"te"
  Language
Thai -> FilePath
"th"
  Language
Turkish -> FilePath
"tr"
  Language
Turkmen -> FilePath
"tk"
  Language
Ukrainian -> FilePath
"uk"
  Language
Uppersorbian -> FilePath
"hsb"
  Language
Welsh -> FilePath
"cy"


-- | The number of characters from the beginning and end of a word not to hyphenate in this language.
languageMins :: Language -> (Int, Int)
languageMins :: Language -> (Int, Int)
languageMins Language
s = case Language
s of
  Language
Afrikaans -> (Int
1, Int
2)
  Language
Armenian -> (Int
1, Int
2)
  Language
Assamese -> (Int
1, Int
1)
  Language
Basque -> (Int
2, Int
2)
  Language
Bengali -> (Int
1, Int
1)
  Language
Bulgarian -> (Int
2, Int
2)
  Language
Catalan -> (Int
2, Int
2)
  Language
Chinese -> (Int
1, Int
1)
  Language
Coptic -> (Int
1, Int
1)
  Language
Croatian -> (Int
2, Int
2)
  Language
Czech -> (Int
2, Int
3)
  Language
Danish -> (Int
2, Int
2)
  Language
Dutch -> (Int
2, Int
2)
  Language
English_GB -> (Int
2, Int
3)
  Language
English_US -> (Int
2, Int
3)
  Language
Esperanto -> (Int
2, Int
2)
  Language
Estonian -> (Int
2, Int
3)
  Language
Ethiopic -> (Int
1, Int
1)
  -- Farsi -> (,)
  Language
Finnish -> (Int
2, Int
2)
  Language
French -> (Int
2, Int
3)
  Language
Friulan -> (Int
2, Int
2)
  Language
Galician -> (Int
2, Int
2)
  Language
Georgian -> (Int
1, Int
2)
  Language
German_1901 -> (Int
2, Int
2)
  Language
German_1996 -> (Int
2, Int
2)
  Language
German_Swiss -> (Int
2, Int
2)
  Language
Greek_Ancient -> (Int
1, Int
1)
  Language
Greek_Mono -> (Int
1, Int
1)
  Language
Greek_Poly -> (Int
1, Int
1)
  Language
Gujarati -> (Int
1, Int
1)
  Language
Hindi -> (Int
1, Int
1)
  Language
Hungarian -> (Int
2, Int
2)
  Language
Icelandic -> (Int
2, Int
2)
  Language
Indonesian -> (Int
2, Int
2)
  Language
Interlingua -> (Int
2, Int
2)
  Language
Irish -> (Int
2, Int
3)
  Language
Italian -> (Int
2, Int
2)
  Language
Kannada -> (Int
1, Int
1)
  Language
Kurmanji -> (Int
2, Int
2)
  Language
Latin -> (Int
2, Int
2)
  Language
Latin_Classic -> (Int
2, Int
2)
  Language
Latvian -> (Int
2, Int
2)
  Language
Lithuanian -> (Int
2, Int
2)
  Language
Malayalam -> (Int
1, Int
1)
  Language
Marathi -> (Int
1, Int
1)
  Language
Mongolian -> (Int
2, Int
2)
  Language
Norwegian_Bokmal -> (Int
2, Int
2)
  Language
Norwegian_Nynorsk -> (Int
2, Int
2)
  Language
Occitan -> (Int
2, Int
2)
  Language
Oriya -> (Int
1, Int
1)
  Language
Panjabi -> (Int
1, Int
1)
  Language
Piedmontese -> (Int
2, Int
2)
  Language
Polish -> (Int
2, Int
2)
  Language
Portuguese -> (Int
2, Int
3)
  Language
Romanian -> (Int
2, Int
2)
  Language
Romansh -> (Int
2, Int
2)
  Language
Russian -> (Int
2, Int
2)
  Language
Sanskrit -> (Int
1, Int
3)
  Language
Serbian_Cyrillic -> (Int
2, Int
2)
  Language
Serbocroatian_Cyrillic -> (Int
2, Int
2)
  Language
Serbocroatian_Latin -> (Int
2, Int
2)
  Language
Slovak -> (Int
2, Int
3)
  Language
Slovenian -> (Int
2, Int
2)
  Language
Spanish -> (Int
2, Int
2)
  Language
Swedish -> (Int
2, Int
2)
  Language
Tamil -> (Int
1, Int
1)
  Language
Telugu -> (Int
1, Int
1)
  Language
Thai -> (Int
2, Int
3)
  Language
Turkish -> (Int
2, Int
2)
  Language
Turkmen -> (Int
2, Int
2)
  Language
Ukrainian -> (Int
2, Int
2)
  Language
Uppersorbian -> (Int
2, Int
2)
  Language
Welsh -> (Int
2, Int
3)


-- |
-- >>> 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\240lahei\240avegavinnuverkf\230rageymslusk\250r"
-- ["va\240la","hei\240a","vega","vinnu","verk","f\230ra","geymslu","sk\250r"]
icelandic :: Hyphenator

-- | Hyphenators for a wide array of languages.
afrikaans, armenian, assamese, basque, bengali, bulgarian, catalan, chinese,
 coptic, croatian, czech, danish, dutch, esperanto,
 estonian, ethiopic, {- farsi, -} finnish, friulan, galician, georgian, german_1901, german_1996,
 german_Swiss, greek_Ancient, greek_Mono, greek_Poly, gujarati, hindi, hungarian,
 indonesian, interlingua, irish, italian, kannada, kurmanji, latin, latin_Classic,
 latvian, lithuanian, malayalam, marathi, mongolian, norwegian_Bokmal,
 norwegian_Nynorsk, occitan, oriya, panjabi, piedmontese, polish, portuguese, romanian,
 romansh, russian, sanskrit, serbian_Cyrillic, serbocroatian_Cyrillic,
 serbocroatian_Latin, slovak, slovenian, spanish, swedish, tamil,
 telugu, thai, turkish, turkmen, ukrainian, uppersorbian, welsh :: Hyphenator

afrikaans :: Hyphenator
afrikaans = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Afrikaans)
armenian :: Hyphenator
armenian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Armenian)
assamese :: Hyphenator
assamese = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Assamese)
basque :: Hyphenator
basque = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Basque)
bengali :: Hyphenator
bengali = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Bengali)
bulgarian :: Hyphenator
bulgarian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Bulgarian)
catalan :: Hyphenator
catalan = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Catalan)
chinese :: Hyphenator
chinese = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Chinese)
coptic :: Hyphenator
coptic = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Coptic)
croatian :: Hyphenator
croatian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Croatian)
czech :: Hyphenator
czech = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Czech)
danish :: Hyphenator
danish = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Danish)
dutch :: Hyphenator
dutch = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Dutch)
english_US :: Hyphenator
english_US = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
English_US)
english_GB :: Hyphenator
english_GB = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
English_GB)
esperanto :: Hyphenator
esperanto = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Esperanto)
estonian :: Hyphenator
estonian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Estonian)
ethiopic :: Hyphenator
ethiopic = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Ethiopic)
-- farsi = unsafePerformIO (loadHyphenator Farsi)
finnish :: Hyphenator
finnish = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Finnish)
french :: Hyphenator
french = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
French)
friulan :: Hyphenator
friulan = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Friulan)
galician :: Hyphenator
galician = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Galician)
georgian :: Hyphenator
georgian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Georgian)
german_1901 :: Hyphenator
german_1901 = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
German_1901)
german_1996 :: Hyphenator
german_1996 = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
German_1996)
german_Swiss :: Hyphenator
german_Swiss = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
German_Swiss)
greek_Ancient :: Hyphenator
greek_Ancient = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Greek_Ancient)
greek_Mono :: Hyphenator
greek_Mono = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Greek_Mono)
greek_Poly :: Hyphenator
greek_Poly = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Greek_Poly)
gujarati :: Hyphenator
gujarati = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Gujarati)
hindi :: Hyphenator
hindi = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Hindi)
hungarian :: Hyphenator
hungarian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Hungarian)
icelandic :: Hyphenator
icelandic = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Icelandic)
indonesian :: Hyphenator
indonesian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Indonesian)
interlingua :: Hyphenator
interlingua = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Interlingua)
irish :: Hyphenator
irish = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Irish)
italian :: Hyphenator
italian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Italian)
kannada :: Hyphenator
kannada = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Kannada)
kurmanji :: Hyphenator
kurmanji = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Kurmanji)
latin :: Hyphenator
latin = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Latin)
latin_Classic :: Hyphenator
latin_Classic = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Latin_Classic)
latvian :: Hyphenator
latvian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Latvian)
lithuanian :: Hyphenator
lithuanian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Lithuanian)
malayalam :: Hyphenator
malayalam = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Malayalam)
marathi :: Hyphenator
marathi = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Marathi)
mongolian :: Hyphenator
mongolian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Mongolian)
norwegian_Bokmal :: Hyphenator
norwegian_Bokmal = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Norwegian_Bokmal)
norwegian_Nynorsk :: Hyphenator
norwegian_Nynorsk = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Norwegian_Nynorsk)
occitan :: Hyphenator
occitan = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Occitan)
oriya :: Hyphenator
oriya = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Oriya)
panjabi :: Hyphenator
panjabi = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Panjabi)
piedmontese :: Hyphenator
piedmontese = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Piedmontese)
polish :: Hyphenator
polish = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Polish)
portuguese :: Hyphenator
portuguese = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Portuguese)
romanian :: Hyphenator
romanian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Romanian)
romansh :: Hyphenator
romansh = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Romansh)
russian :: Hyphenator
russian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Russian)
sanskrit :: Hyphenator
sanskrit = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Sanskrit)
serbian_Cyrillic :: Hyphenator
serbian_Cyrillic = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Serbian_Cyrillic)
serbocroatian_Cyrillic :: Hyphenator
serbocroatian_Cyrillic = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Serbocroatian_Cyrillic)
serbocroatian_Latin :: Hyphenator
serbocroatian_Latin = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Serbocroatian_Latin)
slovak :: Hyphenator
slovak = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Slovak)
slovenian :: Hyphenator
slovenian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Slovenian)
spanish :: Hyphenator
spanish = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Spanish)
swedish :: Hyphenator
swedish = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Swedish)
tamil :: Hyphenator
tamil = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Tamil)
telugu :: Hyphenator
telugu = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Telugu)
thai :: Hyphenator
thai = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Thai)
turkish :: Hyphenator
turkish = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Turkish)
turkmen :: Hyphenator
turkmen = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Turkmen)
ukrainian :: Hyphenator
ukrainian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Ukrainian)
uppersorbian :: Hyphenator
uppersorbian = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Uppersorbian)
welsh :: Hyphenator
welsh = IO Hyphenator -> Hyphenator
forall a. IO a -> a
unsafePerformIO (Language -> IO Hyphenator
loadHyphenator Language
Welsh)

-- | Load (and cache) the hyphenator for a given language.
languageHyphenator :: Language -> Hyphenator
languageHyphenator :: Language -> Hyphenator
languageHyphenator Language
s = case Language
s of
  Language
Afrikaans -> Hyphenator
afrikaans
  Language
Armenian -> Hyphenator
armenian
  Language
Assamese -> Hyphenator
assamese
  Language
Basque -> Hyphenator
basque
  Language
Bengali -> Hyphenator
bengali
  Language
Bulgarian -> Hyphenator
bulgarian
  Language
Catalan -> Hyphenator
catalan
  Language
Chinese -> Hyphenator
chinese
  Language
Coptic -> Hyphenator
coptic
  Language
Croatian -> Hyphenator
croatian
  Language
Czech -> Hyphenator
czech
  Language
Danish -> Hyphenator
danish
  Language
Dutch -> Hyphenator
dutch
  Language
English_US -> Hyphenator
english_US
  Language
English_GB -> Hyphenator
english_GB
  Language
Esperanto -> Hyphenator
esperanto
  Language
Estonian -> Hyphenator
estonian
  Language
Ethiopic -> Hyphenator
ethiopic
  -- Farsi -> farsi
  Language
Finnish -> Hyphenator
finnish
  Language
French -> Hyphenator
french
  Language
Friulan -> Hyphenator
friulan
  Language
Galician -> Hyphenator
galician
  Language
Georgian -> Hyphenator
georgian
  Language
German_1901  -> Hyphenator
german_1901
  Language
German_1996  -> Hyphenator
german_1996
  Language
German_Swiss -> Hyphenator
german_Swiss
  Language
Greek_Ancient -> Hyphenator
greek_Ancient
  Language
Greek_Mono -> Hyphenator
greek_Mono
  Language
Greek_Poly -> Hyphenator
greek_Poly
  Language
Gujarati -> Hyphenator
gujarati
  Language
Hindi -> Hyphenator
hindi
  Language
Hungarian -> Hyphenator
hungarian
  Language
Icelandic -> Hyphenator
icelandic
  Language
Indonesian -> Hyphenator
indonesian
  Language
Interlingua -> Hyphenator
interlingua
  Language
Irish -> Hyphenator
irish
  Language
Italian -> Hyphenator
italian
  Language
Kannada -> Hyphenator
kannada
  Language
Kurmanji -> Hyphenator
kurmanji
  Language
Latin -> Hyphenator
latin
  Language
Latin_Classic -> Hyphenator
latin_Classic
  Language
Latvian -> Hyphenator
latvian
  Language
Lithuanian -> Hyphenator
lithuanian
  Language
Malayalam -> Hyphenator
malayalam
  Language
Marathi -> Hyphenator
marathi
  Language
Mongolian -> Hyphenator
mongolian
  Language
Norwegian_Bokmal  -> Hyphenator
norwegian_Bokmal
  Language
Norwegian_Nynorsk -> Hyphenator
norwegian_Nynorsk
  Language
Occitan -> Hyphenator
occitan
  Language
Oriya -> Hyphenator
oriya
  Language
Panjabi -> Hyphenator
panjabi
  Language
Piedmontese -> Hyphenator
piedmontese
  Language
Polish -> Hyphenator
polish
  Language
Portuguese -> Hyphenator
portuguese
  Language
Romanian -> Hyphenator
romanian
  Language
Romansh -> Hyphenator
romansh
  Language
Russian -> Hyphenator
russian
  Language
Sanskrit -> Hyphenator
sanskrit
  Language
Serbian_Cyrillic -> Hyphenator
serbian_Cyrillic
  Language
Serbocroatian_Cyrillic -> Hyphenator
serbocroatian_Cyrillic
  Language
Serbocroatian_Latin -> Hyphenator
serbocroatian_Latin
  Language
Slovak -> Hyphenator
slovak
  Language
Slovenian -> Hyphenator
slovenian
  Language
Spanish -> Hyphenator
spanish
  Language
Swedish -> Hyphenator
swedish
  Language
Tamil -> Hyphenator
tamil
  Language
Telugu -> Hyphenator
telugu
  Language
Thai -> Hyphenator
thai
  Language
Turkish -> Hyphenator
turkish
  Language
Turkmen -> Hyphenator
turkmen
  Language
Ukrainian -> Hyphenator
ukrainian
  Language
Uppersorbian -> Hyphenator
uppersorbian
  Language
Welsh -> Hyphenator
welsh