module Text.LineBreak (
breakString, breakStringLn, BreakFormat(..),
Hyphenator,
afrikaans, armenian, assamese, basque, bengali,
bulgarian, catalan, chinese, coptic, croatian,
czech, danish, dutch, english_US, english_GB,
esperanto, estonian, ethiopic, 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
) where
import Text.Hyphenation
import Data.Char (isSpace)
import Data.List (find, inits, tails)
data BreakFormat = BreakFormat { BreakFormat -> Int
bfMaxCol :: Int,
BreakFormat -> Int
bfTabRep :: Int,
BreakFormat -> Char
bfHyphenSymbol :: Char,
BreakFormat -> Maybe Hyphenator
bfHyphenator :: Maybe Hyphenator }
data BrState = BrState { BrState -> Int
_bsCurrCol :: Int,
BrState -> String
bsBroken :: String }
data Element = ElWord String
| ElSpace Int Bool
deriving (Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Element] -> ShowS
$cshowList :: [Element] -> ShowS
show :: Element -> String
$cshow :: Element -> String
showsPrec :: Int -> Element -> ShowS
$cshowsPrec :: Int -> Element -> ShowS
Show)
breakString :: BreakFormat -> String -> String
breakString :: BreakFormat -> ShowS
breakString BreakFormat
bf String
cs = ShowS
hackClean String
out
where els :: [Element]
els = String -> [Element]
parseEls (Int -> ShowS
subTabs (BreakFormat -> Int
bfTabRep BreakFormat
bf) String
cs)
out :: String
out = BrState -> String
bsBroken forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (BreakFormat -> BrState -> Element -> BrState
putElem BreakFormat
bf) (Int -> String -> BrState
BrState Int
0 String
"") [Element]
els
breakStringLn :: BreakFormat -> String -> [String]
breakStringLn :: BreakFormat -> String -> [String]
breakStringLn BreakFormat
bf String
cs = String -> [String]
lines forall a b. (a -> b) -> a -> b
$ BreakFormat -> ShowS
breakString BreakFormat
bf String
cs
parseEls :: String -> [Element]
parseEls :: String -> [Element]
parseEls [] = []
parseEls cs :: String
cs@(Char
c:String
_) | Char -> Bool
isSpace Char
c = let (String
p, String
r) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
cs
in String -> [Element]
parseWS String
p forall a. [a] -> [a] -> [a]
++ String -> [Element]
parseEls String
r
| Bool
otherwise = let (String
p, String
r) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
cs
in String -> Element
parseWord String
p forall a. a -> [a] -> [a]
: String -> [Element]
parseEls String
r
parseWS :: String -> [Element]
parseWS :: String -> [Element]
parseWS [] = []
parseWS String
ws = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
ws of
(String
a, String
"") -> [forall {t :: * -> *} {a}. Foldable t => t a -> Bool -> Element
elspace String
a Bool
False]
(String
a, Char
'\n':String
rs) -> forall {t :: * -> *} {a}. Foldable t => t a -> Bool -> Element
elspace String
a Bool
True forall a. a -> [a] -> [a]
: String -> [Element]
parseWS String
rs
(String, String)
_ -> forall a. HasCallStack => String -> a
error String
"parseWS: non-exhaustive pattern"
where elspace :: t a -> Bool -> Element
elspace t a
cs Bool
b = Int -> Bool -> Element
ElSpace (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
cs) Bool
b
parseWord :: String -> Element
parseWord :: String -> Element
parseWord String
wr = String -> Element
ElWord String
wr
subTabs :: Int -> String -> String
subTabs :: Int -> ShowS
subTabs Int
i String
cs = String
cs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {p}. p -> Char -> String
f Int
i
where f :: p -> Char -> String
f p
_ Char
'\t' = forall a. Int -> a -> [a]
replicate Int
i Char
' '
f p
_ Char
c = forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
putElem :: BreakFormat -> BrState -> Element -> BrState
putElem :: BreakFormat -> BrState -> Element -> BrState
putElem (BreakFormat Int
maxc Int
_ Char
sym Maybe Hyphenator
hyp)
bs :: BrState
bs@(BrState Int
currc String
_) Element
el =
if Int
avspace forall a. Ord a => a -> a -> Bool
>= Element -> Int
elLenght Element
el
then BrState -> Int -> String -> BrState
putString BrState
bs Int
maxc (Element -> String
el2string Element
el)
else case Element
el of
(ElSpace Int
_ Bool
_) -> BrState -> Int -> String -> BrState
putString BrState
bs Int
maxc String
"\n"
(ElWord String
cs) -> BrState -> Int -> String -> BrState
putString BrState
bs Int
maxc (ShowS
broken String
cs)
where avspace :: Int
avspace = Int
maxc forall a. Num a => a -> a -> a
- Int
currc
fstcol :: Bool
fstcol = Int
currc forall a. Eq a => a -> a -> Bool
== Int
0
broken :: ShowS
broken String
cs = Maybe Hyphenator -> Char -> Int -> String -> Bool -> String
breakWord Maybe Hyphenator
hyp Char
sym Int
avspace String
cs Bool
fstcol
elLenght :: Element -> Int
elLenght :: Element -> Int
elLenght (ElWord String
cs) = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cs
elLenght (ElSpace Int
i Bool
_) = Int
i
el2string :: Element -> String
el2string :: Element -> String
el2string (ElSpace Int
i Bool
False) = forall a. Int -> a -> [a]
replicate Int
i Char
' '
el2string (ElSpace Int
_ Bool
True) = String
"\n"
el2string (ElWord String
cs) = String
cs
putString :: BrState -> Int -> String -> BrState
putString :: BrState -> Int -> String -> BrState
putString BrState
bs Int
_ [] = BrState
bs
putString (BrState Int
currc String
currstr) Int
maxcol (Char
c:String
cs) =
let currc' :: Int
currc' = if Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n'
then Int
0
else Int
currc forall a. Num a => a -> a -> a
+ Int
1
bs' :: BrState
bs' = if Int
currc' forall a. Ord a => a -> a -> Bool
<= Int
maxcol
then Int -> String -> BrState
BrState Int
currc' (String
currstr forall a. [a] -> [a] -> [a]
++ [Char
c])
else Int -> String -> BrState
BrState Int
1 (String
currstr forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ [Char
c])
in BrState -> Int -> String -> BrState
putString BrState
bs' Int
maxcol String
cs
breakWord :: Maybe Hyphenator -> Char -> Int -> String -> Bool -> String
breakWord :: Maybe Hyphenator -> Char -> Int -> String -> Bool -> String
breakWord Maybe Hyphenator
mhy Char
ch Int
avspace String
cs Bool
nlb = case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Ord a => a -> a -> Bool
<= Int
avspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
hypLen) [String]
poss of
Just String
a -> String
a
Maybe String
Nothing -> String
cs
where hw :: [String]
hw = case Maybe Hyphenator
mhy of
Just Hyphenator
hy -> Hyphenator -> String -> [String]
hyphenate Hyphenator
hy String
cs
Maybe Hyphenator
Nothing -> [String
cs]
poss :: [String]
poss = forall a b. (a -> b) -> [a] -> [b]
map ([String], [String]) -> String
cf forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [[a]]
inits [String]
hw) (forall a. [a] -> [[a]]
tails [String]
hw)
cf :: ([String], [String]) -> String
cf ([], [String]
ew) = (if Bool
nlb then String
"" else String
"\n") forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ew
cf ([String]
iw, []) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
iw forall a. [a] -> [a] -> [a]
++ String
"\n"
cf ([String]
iw, [String]
ew) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
iw forall a. [a] -> [a] -> [a]
++ [Char
ch] forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ew
hypLen :: String -> Int
hypLen String
wcs = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall a b. (a -> b) -> a -> b
$ String
wcs
hackClean :: String -> String
hackClean :: ShowS
hackClean String
cs = ShowS
noEoflWs String
cs
where noEoflWs :: ShowS
noEoflWs String
wcs = String -> ShowS
f String
"" String
wcs
f :: String -> ShowS
f String
acc [] = String
acc
f String
acc wcs :: String
wcs@(Char
a:String
as) =
let (String
i, String
e) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
== Char
' ') String
wcs in
if String
i forall a. Eq a => a -> a -> Bool
== String
""
then String -> ShowS
f (String
acc forall a. [a] -> [a] -> [a]
++ [Char
a]) String
as
else case String
e of
(Char
'\n':String
rest) -> String -> ShowS
f (String
acc forall a. [a] -> [a] -> [a]
++ String
"\n") String
rest
[] -> String -> ShowS
f String
acc []
String
_ -> String -> ShowS
f (String
acc forall a. [a] -> [a] -> [a]
++ [Char
a]) String
as