diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2013, Francesco Ariis +Copyright (c) 2014, Francesco Ariis All rights reserved. diff --git a/Text/LineBreak.hs b/Text/LineBreak.hs --- a/Text/LineBreak.hs +++ b/Text/LineBreak.hs @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Text.LineBreak --- Copyright : (C) 2013 Francesco Ariis +-- Copyright : (C) 2014 Francesco Ariis -- License : BSD3 (see LICENSE file) -- -- Maintainer : Francesco Ariis @@ -17,9 +17,8 @@ -- > import Text.LineBreak -- > -- > hyp = Just english_US --- > bf = BreakFormat 25 '-' hyp +-- > bf = BreakFormat 25 4 '-' hyp -- > cs = "Using hyphenation with gruesomely non parsimonious wording." --- > -- > main = putStr $ breakString bf cs -- -- will output: @@ -30,109 +29,159 @@ -- ------------------------------------------------------------------------------- -module Text.LineBreak ( breakString, breakStringLn, BreakFormat (..) ) where +module Text.LineBreak ( breakString, breakStringLn, BreakFormat(..) ) where -import Data.List (intercalate) import Text.Hyphenation +import Data.Char (isSpace) +import Data.List (find, inits, tails, span) --- TODO: what to do in overflow case? --- @ --- let hyp = Just english_US in --- putStr $ breakString (BreakFormat 55 '-' hyp) str2 --- @ --- --- @ --- Mathematicians seek out patterns and use them to formu- --- late new conjectures. Mathematicians resolve the truth --- or falsity of conjectures by mathematical proof. --- @ - +----------- -- TYPES -- +----------- --- | How to break the Strings: maximum width of the lines, symbol to use --- to hyphenate a word, Hypenator to use (language, exceptions, etc. Refer to --- "Text.Hyphenation" for more info). To break lines without hyphenating, put --- @Nothing@ in @bfHyphenator@. +-- | How to break the strings: maximum width of the lines, number of spaces +-- to replace tabs with (dumb replacement), symbol to use to hyphenate +-- words, hypenator to use (language, exceptions, etc.; refer to +-- "Text.Hyphenation" for usage instructions). To break lines without +-- hyphenating, put @Nothing@ in @bfHyphenator@. data BreakFormat = BreakFormat { bfMaxCol :: Int, + bfTabRep :: Int, bfHyphenSymbol :: Char, bfHyphenator :: Maybe Hyphenator } +data BrState = BrState { bsCurrCol :: Int, -- current column + bsBroken :: String } -- output string --- bit: hyphenated part of a word -data WordPart = Init | Mid | End | Single - deriving (Eq, Show) +data Element = ElWord String -- things we need to place + | ElSpace Int Bool -- n of spaces, presence of final breakline + deriving (Show) -isInit Init = True -isInit Single = True -isInit _ = False +--------------- +-- FUNCTIONS -- +--------------- -isEnd End = True -isEnd Single = True -isEnd _ = False +-- | Breaks some text (String) to make it fit in a certain width. The output +-- is a String, suitable for writing to screen or file. +breakString :: BreakFormat -> String -> String +breakString bf cs = hackClean out + where els = parseEls (subTabs (bfTabRep bf) cs) + out = bsBroken $ foldl (putElem bf) (BrState 0 "") els +-- | Convenience for @lines $ breakString bf cs@ +breakStringLn :: BreakFormat -> String -> [String] +breakStringLn bf cs = lines $ breakString bf cs -putBit :: String -> BreakFormat -> WordPart -> String -> String -putBit oldcs (BreakFormat maxcol hypsym _) wp bit = - let - spaceleft = - maxcol - currcol + - (if isInit wp then (-1) else 0) + -- new world - (if not $ isEnd wp then (-1) else 0) -- possible hyp. space - lenbit = length bit - addbefore - -- begin of word, no space left - | isInit wp && lenbit > spaceleft = "\n" -- put newline - -- begin of word, not @ first column - | isInit wp && currcol /= 0 = " " -- put space - -- not begin of word, need to newline - | not (isInit wp) && - lenbit > spaceleft = hypsym : "\n" -- put hyphens\n - -- nothing special - | otherwise = "" -- put nothing - in +----------------- +-- ANCILLARIES -- +----------------- - oldcs ++ addbefore ++ bit - where currcol = length . last . lines $ ('\n' : oldcs) +-- PARSING -- +-- fino a qui +-- o word 'till ws +-- o wspa 'till (\n | word). se \n, prendilo +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 -putWord :: String -> BreakFormat -> String -> String -putWord oldcs bf@(BreakFormat _ _ mhyp) word = - let bit = case mhyp of - (Just hyp) -> hyphenate hyp word - Nothing -> [word] - in +-- Signatures between the two |parse| are different because there can +-- be more element in a single white-space string (newline newline), while +-- that is not possible with parseWord +parseWS :: String -> [Element] +parseWS [] = [] +parseWS ws = case span (/= '\n') ws of + (a, "") -> [elspace a False] -- no newlines + (a, '\n':rs) -> elspace a True : parseWS rs + where elspace cs b = ElSpace (length cs) b - -- There is a possible optimisation here (check if the word is bigger - -- than the remaining space and pass it as a singleton. Since there - -- wasn't a notable gain in time, I scrapped it. +parseWord :: String -> Element +parseWord wr = ElWord wr - case bit of - (ba:[]) -> putBit oldcs bf Single ba -- singleton - (ba:bb:[]) -> let newcs = putBit oldcs bf Init ba in - putBit newcs bf End bb -- pair - (ba:bs) -> let inics = putBit oldcs bf Init ba -- triplet+ - bodcs = foldl f inics (init bs) in - putBit bodcs bf End (last bs) - where f oldcs bit = putBit oldcs bf Mid bit +-- number of spaces to replace \t with, string +subTabs :: Int -> String -> String +subTabs i cs = cs >>= f i + where f n '\t' = replicate i ' ' + f _ c = return c +-- COMPUTATION -- -putLine :: String -> BreakFormat -> String -> String -putLine oldcs bf line = - let ws = words line in - foldl f oldcs ws - where f oldcs w = putWord oldcs bf w +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 -- starting col: 1 + fstcol = currc == 0 + broken cs = breakWord hyp sym avspace cs fstcol +elLenght :: Element -> Int +elLenght (ElWord cs) = length cs +elLenght (ElSpace i _) = i --- | Breaks a String to make it fit in a certain width. The output is a String, --- suitable for writing to screen or file. -breakString :: BreakFormat -> String -> String -breakString bf para = unlines $ breakStringLn bf para +-- convert element to string +el2string :: Element -> String +el2string (ElSpace i False) = replicate i ' ' +el2string (ElSpace i True) = "\n" +el2string (ElWord cs) = cs --- | Convenience for @lines $ breakString bf cs@ -breakStringLn :: BreakFormat -> String -> [String] -breakStringLn bf para = - let ls = lines para in - map (putLine "" bf) ls +-- put a string and updates the state +-- (more than macol? new line, but no hyphenation!) +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 + +-- breaks a word given remaining space, using an hypenator +-- the last bool is a "you are on the first col, can't start +-- a new line +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 -- don't find? return input + where hw = case mhy of + Just hy -> hyphenate hy cs + Nothing -> [cs] + poss = error $ show $ map cf $ reverse $ zip (inits hw) (tails hw) + -- poss ~= ["hyphenation\n","hyphen-\nation", + -- "hy-\nphenation","\nhyphenation"] + + -- crea hyphenated from two bits + 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 + +-- CLEAN -- + +-- removes eof/eol whitespace +hackClean :: String -> String +hackClean cs = noEoflWs cs + where noEoflWs cs = f "" cs + + -- the ugliness + 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 -- eol ws + [] -> f acc [] -- eof ws + _ -> f (acc ++ [a]) as -- normal + diff --git a/linebreak.cabal b/linebreak.cabal --- a/linebreak.cabal +++ b/linebreak.cabal @@ -1,12 +1,12 @@ name: linebreak -version: 0.1.0.3 +version: 1.0.0.1 synopsis: breaks strings to fit width description: Simple functions to break a String to fit a maximum text width, using Knuth-Liang hyphenation algorhitm. license: BSD3 license-file: LICENSE author: Francesco Ariis -homepage: http://ariis.it/items/linebreak/page.html +homepage: http://ariis.it/static/articles/linebreak/page.html maintainer: fa-ml@ariis.it category: Text build-type: Simple @@ -14,7 +14,7 @@ source-repository head type: darcs - location: http://www.ariis.it/share/repos/linebreak/ + location: http://www.ariis.it/link/repos/linebreak/ library -- Modules exported by the library.