align-words.hs

left-align.hs

-- https://stackoverflow.com/questions/30821491/haskell-take-and-drop-at-the-same-time

import Data.List     (groupBy, unfoldr)
import Data.Function (on)
import Text.Printf   (printf)
import Control.Monad (forM)

-- |
-- TODO | - Rename
--        - Deal with combining characters (eg. diacritics) (should probably use a Unicode-aware library)
--        - Allow linebreaks after punctuation
restrict :: Int -> String -> [String]
restrict n text = map concat $ takeLines (atomise text)
  where
    takeLine :: [String] -> Maybe ([String], [String])
    takeLine []    = Nothing
    takeLine atoms = Just $ go 0 ([], atoms)

    takeLines :: [String] -> [[String]]
    takeLines = unfoldr takeLine
    
    go _ (ln, [])     = (ln, [])
    go m (ln, a:toms)
      | hasNewline a        = (ln, toms) -- Strip trailing whitespace. We've completed the line.
      | (m + length a) <= n = go (m + length a) (ln ++ [a], toms)
      | otherwise           = (ln, dropWhile (any isWhitespace) $ a:toms)


-- | Group into indivisible 'atoms' of text
atomise :: String -> [String]
atomise = groupBy (on (==) isWhitespace)


-- |
isWhitespace :: Char -> Bool
isWhitespace = flip elem " \n\r\t"


-- |
isLinearSpace :: Char -> Bool
isLinearSpace = flip elem " \r\t"


-- |
hasNewline :: String -> Bool
hasNewline s = '\n' `elem` s