[Haskell-cafe] module Crypt_Discordian - code critique requested

Jacques Carette carette at mcmaster.ca
Wed Feb 23 10:10:55 EST 2005


Were I to write the same code as
Terrence Brannon <bauhaus at metaperl.com> wrote:
> module Crypt_Discordian 
>     where
> 
> import List
> 
> vowel_list = "aeiouAEIOU"
> 
> is_vowel c = c `elem` vowel_list
> 
> move_vowels lis = move_vowels' lis [] []
> 
> move_vowels' []     c v = v ++ c
> move_vowels' (x:xs) c v
>     | is_vowel x  = move_vowels' xs    c  (x:v)
>     | otherwise   = move_vowels' xs (x:c)    v
> 
> remove_spaces str = filter (\x -> x /= ' ') str
> 
> encrypt str = List.sort $ move_vowels $ remove_spaces str

I would likely write
> module Foo where
> 
> vowel_list = "aeiouAEIOU"
> 
> split_vowels = partition (`elem` vowel_list)
> 
> tuple_to_list t = fst t ++ snd t
> 
> remove_spaces = filter (/= ' ') 
> 
> encrypt = List.sort . tuple_to_list . split_vowels . remove_spaces

instead.  But I have this feeling that tuple_to_list is probably already in the library, I just missed it.

The arbiters of good-Haskell-style can now enumerate the ways in which my code is 'bad' ;-)

Jacques


More information about the Haskell-Cafe mailing list