Haskell: relational algebra to SQL converter

relalgSql.hs

import Data.Char --for ord (Char -> Int)

data Query  = Relation (String,[String])        -- (Relationenname, [Attributname])
            | Projection [String] Query         -- [Attributname]
            | Selection String Query            -- Bedingung
            | Rename [(String,String)] Query    -- [(alter Attributname, neuer Attributname)]
            | Union Query Query
            | Difference Query Query
            | Product Query Query
            deriving Show

crunch      :: Query  -> String

expand      :: [(String,String)] -> [String] -> [String] -> String
bite        :: Query  -> ([(String,String)],[String],[String])

bite (Relation (name, atnames))
            = (zip atnames atnames,[name],[])
bite (Projection f q)
            = ([ (a,b) | (a,b) <- [ (x,y) | x <- f, (_,y) <- sel ], elem (a,b) sel ], fro, whe)
    where
        (sel,fro,whe) 
                = bite q
bite (Selection θ q)
            = (sel,fro,θ:whe)
    where
        (sel,fro,whe) 
                = bite q
bite (Rename ρ q) -- Attention! Complicated code that may have a negative impact on your health! (c)
            | snd appres = (fst (fst appres), snd (fst appres), []) --The conditions moved to the subquery
            | otherwise  = (fst (fst appres), snd (fst appres), whe)
    where
        (sel,fro,whe) 
                = bite q
        appres = (apply ρ sel)
        apply a [] -- Returns the new stuff for SELECT and FROM, and whether FROM changed (From changes iff a renamed variable gets renamed)
                = (([],fro),False)
        apply a (x:xs)
                | res == [] = ((x : (fst (fst tmp)), snd (fst tmp)),snd tmp)
                | fst x /= snd x && not (snd tmp) = ( ( nse, ["("++ (expand sel fro whe) ++ ") AS " ++ id] ), True ) --This is the tricky case 
                | otherwise = ((nse, snd (fst tmp)), snd tmp)
            where
                res = [ υ | (μ,υ) <- a, μ == fst x ]
                tmp = apply a xs
                id  = "r" ++ (show (foldl (+) 0 (map ord (head fro))))
                nse = ((head res),fst x) : (fst (fst tmp))
bite (Union p q)
        | fst (unzip selp) == fst (unzip selq) = (zip (fst (unzip selp)) (fst (unzip selp)),
                ["("++ (expand selp frop whep) ++ ") AS " ++ pid ++ " UNION\n" ++
                 "("++ (expand selq froq wheq) ++ ") AS " ++ qid], [])
        | otherwise = error "Malformed input, UNION not possible."
    where
        (selp,frop,whep)
            = bite p
        (selq,froq,wheq)
            = bite q
        pid = "p" ++ (show (foldl (+) 0 (map ord (head frop))))
        qid = "q" ++ (show (foldl (+) 0 (map ord (head froq))))
bite (Difference p q)
        | fst (unzip selp) == fst (unzip selq) = (zip (fst (unzip selp)) (fst (unzip selp)),
                ["("++ (expand selp frop whep) ++ ") AS " ++ pid ++ " EXCEPT\n" ++
                 "("++ (expand selq froq wheq) ++ ") AS " ++ qid], [])
        | otherwise = error "Malformed input, DIFFERENCE not possible."
    where
        (selp,frop,whep)
            = bite p
        (selq,froq,wheq)
            = bite q
        pid = "p" ++ (show (foldl (+) 0 (map ord (head frop))))
        qid = "q" ++ (show (foldl (+) 0 (map ord (head froq))))
bite (Product p q)
        = ( (zip pnames pnames) ++ (zip qnames qnames),  
                ["("++ (expand selp frop whep) ++ ") AS " ++ pid,
                 "("++ (expand selq froq wheq) ++ ") AS " ++ qid], [])
    where
        (selp,frop,whep)
            = bite p
        (selq,froq,wheq)
            = bite q
        pid = "p" ++ (show (foldl (+) 0 (map ord (head frop))))
        qid = "q" ++ (show (foldl (+) 0 (map ord (head froq))))
        pnames
            = map ((++) (pid ++ ".")) (fst (unzip selp))
        qnames
            = map ((++) (qid ++ ".")) (fst (unzip selq))

expand [] _ _
            = error "Malformed input, can't SELECT nothing."
expand _ [] _
            = error "Malformed input, can't select FROM nothing."
expand (s:sel) (f:fro) whe    
            = "SELECT DISTINCT " ++ select ++ "\nFROM " ++ from ++ rest 
    where
        select  = foldl (++) (comb s) (map ((++) ", ") (map comb sel))
        from    = foldl (++) f (map ((++) ", ") fro)
        rest    = if whe == [] then "" else "\nWHERE (" ++ (foldl (++) (head whe) ((map ((++) ") AND (")) (tail whe))) ++ ")"
        comb (a,b)
                = if a == b then a else b ++ " AS " ++ a

crunch q    = (expand sel fro whe) ++ ";"
    where
        (sel,fro,whe)   
                = bite q

-- Samples

sample1     = Projection ["ergebnis"] (Rename [("x","ergebnis")] (Selection "a=x" (Relation ("Tabelle",["a","b","x"]))))
sample2     = Product (Relation ("N",["9","0"])) (Rename [("α","b")] (Projection ["c","α"] ( Rename [("a","α")] (Selection "b>4" (Relation ("Bla",["a","c","d"]))))))