[Haskell-beginners] Simplifying code

[edgar klerks]

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 at nana
ban at na
b at n@na
banan@
b at nan@
ban at n@
b at 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 at gmail.com,
Tel: +31727851429
Fax: +31848363080
Skype: edgar.klerks
Website: flatlinerict.nl
Adres: Koelmalaan 258,
1813JD, Alkmaar
Nederland
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/beginners/attachments/20100209/363c8357/attachment-0001.html