String Alignment in haskell

I'm working on an assignment in Haskell. The assignment is to give the optimal alignment of two strings given scores for word matches, misses and gap insertions. Here is our code so far. The first step is to make it work using brute force and later we will implement with memoization. However, we are stuck at the current spot.

Our optAlignment function is not working properly. With the example input "writers" "vintner" the optimal alignments returned should be:

[("writ-ers","vintner-"), ("wri-t-ers","-vintner-"), ("wri-t-ers","v-intner-")]

but we get

[("writers","vintner"),("writ-ers","vintner-"),("writ-ers","v-intner"),("wri-ters","v-intner"),("wri-t-ers","v-intner-"),("writ-ers","-vintner"),("wri-ters","-vintner"),("wri-t-ers","-vintner-")]

So the correct alternatives are there but also a few more. We have made a function totalScore which shows that some of the alternatives we get are not optimal (obviously). But we have spent 2 hours now trying to figure it out but have made no progress. The code also takes several minutes to run which makes it kinda hard to bug check.

So we would really like some help with figuring out which parts are wrong in our code.

-- String Alignment assignment

scoreMatch = 0
scoreMismatch = -1
scoreSpace = -1

type AlignmentType = (String,String)

optAlignments :: String -> String -> [AlignmentType]
optAlignments [][] = [("","")]
optAlignments (x:xs) [] = attachHeads x '-' (optAlignments xs "")
optAlignments [] (y:ys) = attachHeads '-' y (optAlignments "" ys)
optAlignments (x:xs) (y:ys) = maximaBy (uncurry similarityScore) $match++xSpacematch++ySpacematch
    where match = attachHeads x y $optAlignments xs ys
          xSpacematch = attachHeads x '-' $optAlignments xs (y:ys)
          ySpacematch = attachHeads '-' y $optAlignments (x:xs) ys



similarityScore :: String -> String -> Int
similarityScore [][] = 0
similarityScore xs [] = scoreSpace * length xs
similarityScore [] ys = scoreSpace * length ys
similarityScore (x:xs) (y:ys) = max match $max xSpacematch ySpacematch
    where match = similarityScore xs ys + score x y
          xSpacematch = similarityScore xs (y:ys) + score x '-'
          ySpacematch = similarityScore (x:xs) ys + score '-' y



score :: Char -> Char -> Int  
score x '-' = scoreSpace
score '-' y = scoreSpace
score x y
    | x == y = scoreMatch
    | otherwise = scoreMismatch

-- attachHeads functions attaches the two arguments to the front of each list in the tuple
attachHeads :: a -> a -> [([a],[a])] -> [([a],[a])] 
attachHeads h1 h2 aList = [(h1:xs,h2:ys) | (xs,ys) <- aList]

maximaBy :: Ord b => (a -> b) -> [a] -> [a] 
maximaBy valueFcn xs = [a| a <- xs, valueFcn a == maxVal ] 
    where maxVal = maximum $map valueFcn xs

totalScore x y = sum $map (uncurry score) (zip x y)
--map (uncurry totalScore)

--outputOptAlignments string1 string2