一个跳舞题目的Haskell解答[未完成]

m个舞者和n和领舞者跳舞

规则1:舞者不能和同一个领舞者跳两次以上

规则2:舞者不能跳同一个舞曲一次以上

求出所有组合

import Data.List
{-领舞者-}
type Leader = String
{-舞蹈-}
type Daunce = String
{-跳舞卡片-}
data Card = Card{leader::String
				,daunce::String} deriving (Eq,Show)
{-舞者-}
data Follower = Follower{name::String
						,cards::[Card]}deriving (Eq,Show)

rNoRepeatDaunce::Follower->Card->Bool
rNoRepeatDaunce (Follower _ []) _ = True
rNoRepeatDaunce (Follower _ cards) (Card _ d) = (find (==d) (map daunce cards))==Nothing

rNoEnoughLeader::[Card]->Leader->Bool
rNoEnoughLeader [] _ = True
rNoEnoughLeader cards leader' = let  leaders = map leader cards 
								in 
									let count = sum $ [1 | l<-leaders, l== leader']
									in 
										if count ==2
										then False
										else True
rOneDaunce::Follower->Daunce->Bool
rOneDaunce (Follower _ cards) d = [ 1 | (Card _ daunce) <-cards,daunce==d] == []
							

removeLeader::[Card]->Leader->[Card]
removeLeader [] _ = []
removeLeader  lds l = [  ld | ld@(Card leader daunce) <- lds , l /= leader]

removeCards::[Card]->[Card]->[Card]
removeCards lwd o = filter (\x -> (x `elem` o)==False) lwd

append :: Follower->Card->Follower
append (Follower name cards) t@(Card leadername daunce)= Follower name  (t:cards)
							
tDauncers=["Tom","Peter"]
tLeaders=["Candy"]
tDaunces=["waltz"]

leaderWithDaunceLst = [Card l d | l <- tLeaders,d <- tDaunces]
follows = [Follower name [] | name <-tDauncers]

allDaunce::[Follower]->[Card]
allDaunce [] = []
allDaunce ((Follower _ ds ):xs) = ds ++ (allDaunce xs)

comPair::[Follower]->[Follower]->[Card]->[Follower]
comPair ds o [] = ds++o
comPair ds [] _ = ds
comPair r (f:fx) t@(card@(Card leader daunce):cardList) = if (rNoRepeatDaunce f card) 
													  && (rNoEnoughLeader (cards f) leader) 
													  && (rOneDaunce f daunce)
													 then comPair ((append f card):r) fx (removeLeader cardList leader)
													 else comPair r (f:fx) t
main = do
		a <- return $ comPair[] follows leaderWithDaunceLst
		putStrLn $ "step1:\t" ++ show a
		
		--f1 <- return  $ removeCards leaderWithDaunceLst $ allDaunce a
		b <- return $ comPair [] a leaderWithDaunceLst
		putStrLn $ "step2:\t" ++ show b
		
		f2 <- return  $ removeCards leaderWithDaunceLst $ allDaunce b
		c <- return $ comPair [] b f2
		putStrLn $ "step3:\t" ++ show c