-- Generiere ein Sachverzeichnis (Index)

{- Spezifikation: Die Eingabe sei ein Text, in dem alle Zeilen 
durch \n voneinander getrennt sind. Der Index soll zu jedem 
Begriff alle Zeilennummern angeben, in denen dieser vorkommt.
Alle relevanten Begriffe sollen in alphabetischer Reihenfolge aufgeführt werden.
Hier: Jedes Wort mit mindestens vier Buchstaben sei relevant.
Kommt ein Begriff in einer Zeile mehrfach vor, so soll diese 
Zeilennummer nicht dupliziert werden.

Programmstruktur durch Zerlegung in Phasen: f = f1 >.> f2 ... >.> fn
-}

infixl 9 >.>
(>.>) :: (u->v) -> (v-> w) -> (u->w)
f >.> g = g . f

type Doc = String; type Line = String; type Word = String

bspDoc :: Doc -- Ein Beispieldokument zum Testen 
bspDoc = "Dies Haus ist ein schönes Haus,\n mit einem Baum\nvor dem Haus."

makeIndex :: Doc -> [([Int], Word)]
makeIndex = lines >.> numLines >.> allNumWords >.> sortNumWords >.> makeLists >.> amalgamate >.> shorten

numLines :: [Line] -> [(Int,Line)]
numLines ls = zip [1..length ls] ls

numWords :: (Int,Line) -> [(Int,Word)]

-- Auszug aus einfacher Textverarbeitung 
whiteSpaces :: [Char]
whiteSpaces = "\n\t ;,:.\'\"!?()+-"

isWhite :: Char -> Bool
isWhite c = c `elem` whiteSpaces


splitWords :: String -> [Word]
splitWords [] = []
splitWords t = getWord t': splitWords (dropWord t')             
               where t' = dropWhile isWhite t


-- getWord extrahiert das erste Wort und dropWord entfernt es aus einem Text

getWord :: String -> Word
getWord [] = []
getWord (c:cs) = if isWhite c then [] else c : getWord cs

dropWord :: String -> String
dropWord [] = []
dropWord (c:cs) = if isWhite c then cs else dropWord cs
-- Ende des Auszugs

numWords (nr,line) = [(nr,w) | w <- splitWords line]

allNumWords :: [(Int,Line)] -> [(Int,Word)]
allNumWords = concat . map numWords

orderPair :: (Int,Word) -> (Int,Word) -> Bool
orderPair (n1,w1) (n2,w2) = w1 < w2 || (w1 == w2 && n1 < n2)

sortNumWords :: [(Int,Word)] -> [(Int,Word)]
sortNumWords [] = []
sortNumWords (p:ps) = 
   sortNumWords [q|q<-ps, orderPair q p] ++ [p] ++
   sortNumWords [q|q<-ps, orderPair p q]

makeLists :: [(Int,Word)] -> [([Int],Word)]
makeLists ps = [ ([nr],w) | (nr,w) <- ps ]

amalgamate :: [([Int],Word)] -> [([Int],Word)]
amalgamate [] = []
amalgamate [p] = [p]
amalgamate ((l1,w1):(l2,w2):rest) 
   | w1 /= w2 = (l1,w1) : amalgamate ((l2,w2):rest)
   | otherwise = amalgamate ((l1++l2,w1):rest)

shorten :: [([Int],Word)] -> [([Int],Word)]
shorten = filter sizer 
          where sizer (ls, w) = length w > 3