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
(Int -> Element -> ShowS)
-> (Element -> String) -> ([Element] -> ShowS) -> Show Element
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 (BrState -> String) -> BrState -> String
forall a b. (a -> b) -> a -> b
$ (BrState -> Element -> BrState) -> BrState -> [Element] -> BrState
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 (String -> [String]) -> String -> [String]
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) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
cs
in String -> [Element]
parseWS String
p [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ String -> [Element]
parseEls String
r
| Bool
otherwise = let (String
p, String
r) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
cs
in String -> Element
parseWord String
p Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: String -> [Element]
parseEls String
r
parseWS :: String -> [Element]
parseWS :: String -> [Element]
parseWS [] = []
parseWS String
ws = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
ws of
(String
a, String
"") -> [String -> Bool -> Element
forall (t :: * -> *) a. Foldable t => t a -> Bool -> Element
elspace String
a Bool
False]
(String
a, Char
'\n':String
rs) -> String -> Bool -> Element
forall (t :: * -> *) a. Foldable t => t a -> Bool -> Element
elspace String
a Bool
True Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: String -> [Element]
parseWS String
rs
where elspace :: t a -> Bool -> Element
elspace t a
cs Bool
b = Int -> Bool -> Element
ElSpace (t a -> Int
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 String -> (Char -> String) -> String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Char -> String
forall p. p -> Char -> String
f Int
i
where f :: p -> Char -> String
f p
_ Char
'\t' = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' '
f p
_ Char
c = Char -> String
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 Int -> Int -> Bool
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
currc
fstcol :: Bool
fstcol = Int
currc Int -> Int -> Bool
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) = String -> Int
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) = Int -> Char -> String
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
then Int
0
else Int
currc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
bs' :: BrState
bs' = if Int
currc' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxcol
then Int -> String -> BrState
BrState Int
currc' (String
currstr String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c])
else Int -> String -> BrState
BrState Int
1 (String
currstr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
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 (String -> Bool) -> [String] -> Maybe String
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
avspace) (Int -> Bool) -> (String -> Int) -> String -> Bool
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 = (([String], [String]) -> String)
-> [([String], [String])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String], [String]) -> String
cf ([([String], [String])] -> [String])
-> [([String], [String])] -> [String]
forall a b. (a -> b) -> a -> b
$ [([String], [String])] -> [([String], [String])]
forall a. [a] -> [a]
reverse ([([String], [String])] -> [([String], [String])])
-> [([String], [String])] -> [([String], [String])]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [[String]] -> [([String], [String])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([String] -> [[String]]
forall a. [a] -> [[a]]
inits [String]
hw) ([String] -> [[String]]
forall a. [a] -> [[a]]
tails [String]
hw)
cf :: ([String], [String]) -> String
cf ([], [String]
ew) = (if Bool
nlb then String
"" else String
"\n") String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ew
cf ([String]
iw, []) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
iw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
cf ([String]
iw, [String]
ew) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
iw String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
ch] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ew
hypLen :: String -> Int
hypLen String
wcs = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') (String -> Int) -> String -> Int
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) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
wcs in
if String
i String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
""
then String -> ShowS
f (String
acc String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
a]) String
as
else case String
e of
(Char
'\n':String
rest) -> String -> ShowS
f (String
acc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") String
rest
[] -> String -> ShowS
f String
acc []
String
_ -> String -> ShowS
f (String
acc String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
a]) String
as