{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Safe #-}
module WEditorHyphen.LangHyphen (
LangHyphen,
langHyphen,
) where
import Data.Char
import Data.List
import Text.Hyphenation
import WEditor.LineWrap
data LangHyphen = LangHyphen Language Hyphenator
langHyphen :: Language -> LangHyphen
langHyphen l = LangHyphen l (languageHyphenator l)
instance Show LangHyphen where
show (LangHyphen l _) = show l
instance WordSplitter LangHyphen Char where
splitWord (LangHyphen l h) k w cs
| w < (minWidth l) || k > w = Nothing
| k >= length cs || k < 3 = Just []
| otherwise = Just breaks where
(nb,cs',ne) = trimPunct l cs
(n0:ns) = map length $ hyphenate h cs'
breaks
| any (noSplitChars l) cs' = []
| null ns = []
| otherwise = combine k (nb+n0) (init ns ++ [ne+last ns])
combine _ _ [] = []
combine t n (k:ks)
| (n+k > t-(length (hyphenChar l)) && not (null ks)) || n+k > t = n:(combine w k ks)
| otherwise = combine w (n+k) ks
isWordChar (LangHyphen l _) = wordChars l
isWhitespace (LangHyphen l _) = whitespaceChars l
appendHyphen (LangHyphen l _) = (++ hyphenChar l)
endsWithHyphen (LangHyphen l _) cs
| null cs || null (hyphenChar l) = False
| otherwise = hyphenChar l `isSuffixOf` cs
minWidth :: Language -> Int
minWidth _ = 8
wordChars :: Language -> Char -> Bool
wordChars l c = generalCategory c `elem` cats l || noSplitChars l c where
cats _ = [UppercaseLetter,
LowercaseLetter,
TitlecaseLetter,
ModifierLetter,
OtherLetter,
NonSpacingMark,
SpacingCombiningMark,
DashPunctuation]
noSplitChars :: Language -> Char -> Bool
noSplitChars l c = generalCategory c `elem` cats l where
cats _ = [DecimalNumber,
OtherNumber,
ConnectorPunctuation,
InitialQuote,
FinalQuote,
OtherPunctuation,
CurrencySymbol]
whitespaceChars :: Language -> Char -> Bool
whitespaceChars _ c = isSeparator c
hyphenChar :: Language -> [Char]
hyphenChar _ = "-"
trimPunct :: Language -> [Char] -> (Int,[Char],Int)
trimPunct l cs =
(length $ takeWhile (noSplitChars l) cs,
dropWhile (noSplitChars l) $ reverse $ dropWhile (noSplitChars l) $ reverse cs,
length $ takeWhile (noSplitChars l) $ reverse cs)