module Text.LineBreak ( breakString, breakStringLn, BreakFormat(..) ) where
import Text.Hyphenation
import Data.Char (isSpace)
import Data.List (find, inits, tails, span)
data BreakFormat = BreakFormat { bfMaxCol :: Int,
bfTabRep :: Int,
bfHyphenSymbol :: Char,
bfHyphenator :: Maybe Hyphenator }
data BrState = BrState { bsCurrCol :: Int,
bsBroken :: String }
data Element = ElWord String
| ElSpace Int Bool
deriving (Show)
breakString :: BreakFormat -> String -> String
breakString bf cs = hackClean out
where els = parseEls (subTabs (bfTabRep bf) cs)
out = bsBroken $ foldl (putElem bf) (BrState 0 "") els
breakStringLn :: BreakFormat -> String -> [String]
breakStringLn bf cs = lines $ breakString bf cs
parseEls :: String -> [Element]
parseEls [] = []
parseEls cs@(c:_) | isSpace c = let (p, r) = span isSpace cs
in parseWS p ++ parseEls r
| otherwise = let (p, r) = span (not . isSpace) cs
in parseWord p : parseEls r
parseWS :: String -> [Element]
parseWS [] = []
parseWS ws = case span (/= '\n') ws of
(a, "") -> [elspace a False]
(a, '\n':rs) -> elspace a True : parseWS rs
where elspace cs b = ElSpace (length cs) b
parseWord :: String -> Element
parseWord wr = ElWord wr
subTabs :: Int -> String -> String
subTabs i cs = cs >>= f i
where f n '\t' = replicate i ' '
f _ c = return c
putElem :: BreakFormat -> BrState -> Element -> BrState
putElem (BreakFormat maxc _ sym hyp)
bs@(BrState currc currstr) el =
if avspace >= elLenght el
then putString bs maxc (el2string el)
else case el of
(ElSpace _ _) -> putString bs maxc "\n"
(ElWord cs) -> putString bs maxc (broken cs)
where avspace = maxc currc
fstcol = currc == 0
broken cs = breakWord hyp sym avspace cs fstcol
elLenght :: Element -> Int
elLenght (ElWord cs) = length cs
elLenght (ElSpace i _) = i
el2string :: Element -> String
el2string (ElSpace i False) = replicate i ' '
el2string (ElSpace i True) = "\n"
el2string (ElWord cs) = cs
putString :: BrState -> Int -> String -> BrState
putString bs _ [] = bs
putString (BrState currc currstr) maxcol (c:cs) =
let currc' = if c == '\n'
then 0
else currc + 1
bs' = if currc' <= maxcol
then BrState currc' (currstr ++ [c])
else BrState 1 (currstr ++ "\n" ++ [c])
in putString bs' maxcol cs
breakWord :: Maybe Hyphenator -> Char -> Int -> String -> Bool -> String
breakWord mhy ch avspace cs nlb = case find ((<= avspace) . hypLen) poss of
Just a -> a
Nothing -> cs
where hw = case mhy of
Just hy -> hyphenate hy cs
Nothing -> [cs]
poss = error $ show $ map cf $ reverse $ zip (inits hw) (tails hw)
cf ([], ew) = (if nlb then "" else "\n") ++ concat ew
cf (iw, []) = concat iw ++ "\n"
cf (iw, ew) = concat iw ++ [ch] ++ "\n" ++ concat ew
hypLen cs = length . takeWhile (/= '\n') $ cs
hackClean :: String -> String
hackClean cs = noEoflWs cs
where noEoflWs cs = f "" cs
f acc [] = acc
f acc cs@(a:as) =
let (i, e) = span (== ' ') cs in
if i == ""
then f (acc ++ [a]) as
else case e of
('\n':rest) -> f (acc ++ "\n") rest
[] -> f acc []
_ -> f (acc ++ [a]) as