Hi All,

I wrote a program which permutates a list words with some rules. For example if I feed it a list like:

banana
waterloo
vraag

It gives back the list:

banana
b@nana
ban@na
b@n@na
banan@
b@nan@
ban@n@
b@n@n@
waterloo
wa+erloo
water|oo
waterl0o
etc

However I have the feeling I am doing things to complicated. I am still a beginner. Would someone like to help me simplify somethings. If you think this is inappropriate please state also. I am not offended then. I understand you are offering your spare time to help me.

The first thing I don't get is this. I recognize some things could be rewritten with a bind operator (because of the concat $ fmap), but I am puzzled how:

mutateWords :: [Char] -> [[Char]]
mutateWords word = nub.concat $ fmap snd <$> fmap unzip <$> ( foldr(\x z ->
                        let char = snd x
                            nm = number word
                            lst = fst x
                        in (insertAt char nm <$> lst) : z
                ) [[]] $ mw word )

Here is the full code:

import Data.List
import System
import System.IO
import Control.Applicative

---CONFIG section

leat = ['s' ==> '$', 't' ==> '+', 'l' ==> '|', 'o' ==> '0','e' ==> '3', 'a' ==> '@', 'v' ==> '^']

leata = fst.unzip $ leat
leatb = snd.unzip $ leat

-- Perl like assoc lists
infixl 1 ==>
a ==> b = (a, b)

-- Flipped fmap sometimes nicer
infixl 4 <$$>

xs <$$> f = f <$> xs

-- first I need to find the positions of the mutatable charachters.
findPositions :: [Char] -> [[Int]]
findPositions xs = take (length index) $ index <*> [xs]
        where index = elemIndices <$> leata

-- And generate all subsequences
findSubSeq :: [Char] -> [[[Int]]]
findSubSeq = fmap subsequences <$> findPositions

-- Only change elements which needs to be changed
insertAt :: Char -> [(Int, Char)] -> [Int] -> [(Int,Char)]
insertAt c xs ps = xs <$$> (\x ->
                if (fst x) `elem` ps
                        then (fst x , c)
                        else x
                )
-- Couples character to mutable positions
mw word = (findSubSeq word) `zip` leatb

number = zip [0..]

mutateWords :: [Char] -> [[Char]]
mutateWords word = nub.concat $ fmap snd <$> fmap unzip <$> ( foldr(\x z ->
                        let char = snd x
                            nm = number word
                            lst = fst x
                        in (insertAt char nm <$> lst) : z
                ) [[]] $ mw word )

generateAll :: [Char] -> [[Char]]
generateAll word = g lea $ mutateWords word
    where   g 0 words = words
                g n words = g (n - 1) (nub $ words >>= mutateWords )
                lea = length leata
main = do
        filename <- getArgs
        wordlist <- readFile $ filename !! 0
        let a = (words wordlist) >>= generateAll
        mapM_ putStrLn a

--
Flatliner ICT Service,
Email: Edgar.klerks@gmail.com,
Tel: +31727851429
Fax: +31848363080
Skype: edgar.klerks
Website: flatlinerict.nl
Adres: Koelmalaan 258,
1813JD, Alkmaar
Nederland