{- Ausschnitt aus einem einfachen Textverarbeitungssystem

Aufgabe: Ein Text soll in Zeilen gleicher Länge transformiert werden.

   Hier: Verbesserung mittels zusätzlicher Parameter
  Das Verfahren gliedert sich in zwei Phasen, die sich abwechselnd aufrufen. 
  Die Phase1 enrfernt Leerzeichen, die Phase2 erkennt das jeweils nächste Wort.
  In beiden Phasen enthält ein 
  - Int-Parameter den verbleibenden Platz in der nächsten Zeile und ein
  - Line-Parameter die aufzubauende, nächste Zeile .
  Die zweite Phase erhält zusätzlich einen Wort-Parameter, 
  in dem das nächste Wort inkrementell aufgebaut wird.
-}

meinText :: String -- ein erster Beispieltext
meinText = "   Kein  anderer	\n zeitgenössischer    Roman stellt derart ehrlich wie \n  hintergründig    die Frage	 nach der \n  Identität des modernen Menschen."

lineLen :: Int -- gewünschte Zeilenlänge
lineLen = 30

-- ursprünglich vorhandene Leerzeichen, die entfernt werden sollen
whiteSpaces :: [Char]
whiteSpaces = [' ', '\t', '\n']

isWhite, isNotWhite :: Char -> Bool
isWhite c = c `elem` whiteSpaces
isNotWhite c = c `notElem` whiteSpaces

-- Definition: Ein Wort ist eine Zeichenfolge, die keine whiteSpaces enthält.
--                  Eine Zeile ist eine Wortfolge

type Word = String
type Line = [Word]

putInLines :: String -> String -- Hauptfunktion
putInLines = phase1 lineLen [] 

phase1 :: Int -> Line -> String -> String  -- entfernt Leerzeichen
phase1 n z (c:s) = if isWhite c then phase1 n z s else phase2 [c] n z s
phase1 n z []    = lay z

phase2 :: Word -> Int -> Line -> String -> String  -- findet nächstes Wort
phase2 w n z [] 
	| length w <= n   = lay (z ++[w]) 
	| otherwise       = lay z ++ lay [w]  
phase2 w n z (c:s) 
	| isNotWhite c = phase2 (w++[c]) n z s
	| lw < n       = phase1 (n-lw-1) (z++[w]) s 
	| lw == n      = lay (z ++[w]) ++ phase1 lineLen [] s
	| otherwise    = lay z ++ phase1 (lineLen - lw -1) [w] s
   where lw = length w

lay :: Line -> String
lay  = foldr join "\n"

join :: Word -> Word -> String
join w1 w2 = w1 ++ " " ++ w2


test :: IO()  -- Ein erster Test
test = putStr (putInLines meinText)