diff --git a/src/Justify.hs b/src/Justify.hs new file mode 100644 index 000000000..a4707551c --- /dev/null +++ b/src/Justify.hs @@ -0,0 +1,32 @@ +module Justify + ( makeParagraph + ) where +import Data.Ratio + +makeParagraph :: Int -> String -> [String] +makeParagraph maxl = map (justify maxl) . lineSplit maxl + +justify :: Int -> ([String],Int,Int,Bool) -> String +justify maxl (ws,ccount,wcount,True) = concat $ interweave (reverse ws) + $ map f $ splitExtra (wcount-1) extrac + where + f n = replicate (n+1) ' ' + extrac = maxl - (ccount + wcount - 1) +justify _ (ws,_,_,False) = unwords $ reverse ws + +interweave :: [a] -> [a] -> [a] +interweave (x:xs) (y:ys) = x:y:interweave xs ys +interweave xs ys = xs ++ ys + +splitExtra :: Int -> Int -> [Int] +splitExtra nword nchar = zipWith (-) flist (0:flist) + where + flist = map floor $ scanl1 (+) $ replicate nword (nchar % nword) + +lineSplit :: Int -> String -> [([String],Int,Int,Bool)] +lineSplit maxl s = f ([],0,0,False) $ words s + where + f (curline,ccount,wcount,_) (wrd:wrds) + | ccount + wcount + length wrd > maxl = (curline,ccount,wcount,True) : f ([wrd],length wrd,1,False) wrds + | otherwise = f (wrd:curline, ccount + length wrd, wcount+1,False) wrds + f x [] = [x]