Vigenere cipher exercise in Haskell

Question

This is my implementation using the dreadful !!:

import Data.Char (chr, ord, toUpper)
-- A bit of self documentation help
type Key = String
type Msg = String
key :: Key
key = "TSTING"
msg :: Msg
msg = "I'm not even mad... This is impressive!"
-- | Checks if character is valid for encoding
isValid :: Char -> Bool
isValid c = let cUp = toUpper c :: Char
 in 'A' <= cUp && cUp <= 'Z'
-- | Given 'key' & 'msg' generate a list of [Maybe Int] indices
-- to map 'msg' from 'key', skipping invalid characters
toIdx :: Key -> Msg -> [Maybe Int]
toIdx k m = map (flip mod keyN <$>) $ toIdx_ 0 m
 where keyN = length k :: Int
 toIdx_ :: Int -> Msg -> [Maybe Int]
 toIdx_ _ "" = []
 toIdx_ acc (c:cs)
 | isValid c = Just acc : toIdx_ (acc + 1) cs
 | otherwise = Nothing : toIdx_ acc cs
-- | Given 'key' & 'msg' generate a list of numbers representing
-- the amount to shift 'msg' characters based on 'key'
toShifts :: Key -> Msg -> [Int]
toShifts k m = map toKey (toIdx k m)
 where kUp = map toUpper k :: Key
 toKey :: Maybe Int -> Int
 toKey Nothing = 0
 toKey (Just x) = ord (kUp!!x) - ord 'A'
-- | Given 'by' & 'c', shift the Char 'c' by amount 'by'. 'by' can be both
-- positive & negative as well as 0.
shift :: Int -> Char -> Char
shift by c
 | isValid c && c >= 'a' = shift_ $ ord 'a'
 | isValid c && c >= 'A' = shift_ $ ord 'A'
 | otherwise = c
 where cONorm = ord (toUpper c) - ord 'A' :: Int
 azN = ord 'Z' - ord 'A' :: Int
 shift_ :: Int -> Char
 shift_ aO = chr $ aO + mod (by + cONorm) azN
-- Encode & decode a message using the given key.
vigenere, unVigenere :: Key -> Msg -> Msg
vigenere k m = zipWith shift (toShifts k m) m
unVigenere k m = zipWith shift (map negate $ toShifts k m) m

I found that the most "annoying" thing when coming from background such as Python is to be able to keep track of things, for example when figuring out how to convert valid characters into usable positions to be then mapped with the key. That thing took me half a day to figure out!

How would you do it? Or is there some "standard" way of working with these sort of things? I'm referring particularly to toIdx & toIdx_, had to use toIdx_ to accumulate the indices with acc in this list of Maybe Int in order to correctly map valid Chars with key.

Of course, I wouldn't have it any other way but have an algorithm which takes any String input and creates an encoded String with preserved upper/lower-case and non-valid (out of ASCII alphabet) Chars.

• πάντα ῥεῖ: Welcome to SE Code Review. 1st note: None of the SE sites is designed as a forum. "I'm not sure about the rules here" You can always make yourself familiar with the rules and policies reading the material in the Help Center.
• razvanc: @πάνταῥεῖ of course, but we both know people are lazy and it's easier to wait for someone to shout at you on your first try :P
• πάντα ῥεῖ: Who was shouting? You also miss the {informed} badge. Well, as you've been mentioning the rules, I was just tempted to tell you.
• t3chb0t: As a matter of fact for someone who didn't read the rules your question is fine. If you only haven't told us this, no one would have noticed :-P
• πάντα ῥεῖ: @razvanc Well, one important thing you should notice here (one of the reason it's different from a forum): Down- or Upvotes refer to the posts quality, not as punishment or reward for the OP. You can always edit your post in course of improvement. Removing that statement would improve your post, because from the topic point of view it is just unnecessary noise, that distracts future readers.

Answer 1

You're rather close. The issue lies within zipWith. zipWith will always consume the first elements of both lists. That's why you need (toShifts k m) to begin with.

However, what if we get rid of zipWith for a moment and use pattern matching in vigenere?

vigenere' :: Key -> Msg -> Msg
vigenere' ks (' ':ms) = ' ' : vigenere ks ms
vigenere' (k:ks) (m :ms) = shiftC k m : vigenere ks ms
vigenere' _ [] = []

where shiftC :: Char -> Char -> Char is an appropriate function (left as an exercise). Actually, that's it. That's all that is necessary for vigenere, apart from shiftC. Well, I'm lying: the key will run out at some point. That's why you use cycle :: [a] -> [a]:

vigenere :: Key -> Msg -> Msg
vigenere ks ms = vigenere' (cycle ks) ms

cycle turns a regular list in an infinite one, e.g. cycle [1,2,3] == [1,2,3,1,2,3,1,2,3,...] (exercise: try to implement cycle). Therefore, it turns your key into an infinite one.

You can implement unVigenere' the same way, only that you need unShiftC :: Char -> Char -> Char. A pair of functions, namely toInt :: Char -> Int and fromInt :: Int -> Char will come in handy for that (left as an exercise).

Heck, we can even implement both functions the same way and use isValid instead of pattern matching for unsupported characters:

cryptZip' :: (Char -> Char -> Char) -> Key -> Msg -> Msg
cryptZip' _ _ [] = []
cryptZip' f (k:ks) (m :ms) =
 | isValid m = f k m : cryptZip' f ks ms
 | otherwise = m : cryptZip' f (k:ks) ms
-- | Combines the key and the message with the given function.
-- Invalid characters are left as-is. The function shall return
-- only valid characters.
cryptZip :: (Char -> Char -> Char) -> Key -> Msg -> Msg
cryptZip f ks ms = cryptZip' f (cycle ks) ms

Now, vigenere and unVigenere are extremely simple:

vigenere = cryptZip shiftC
unVigenere = cryptZip unShiftC

And we're done. By the way, you can use (Char -> Char -> Maybe Char) to get rid of isValid. But that, again, is left as an exercise.

Further remarks

The type annotations in your where bindings are not necessary. I would get rid of them, since they may get out of sync with your top-level function (but you will at least get a type-error).

cryptZip can be written as (a -> a -> Maybe a) -> [a] -> [a] -> [a], if you're up for a challenge.

Your overall complexity stemmed from zipWith. It's a great function, but only if it's used for the right job. Not everything is a nail, just because you have a hammer at hand. Instead of trying to get everything else in place to use a specific function, ask yourself what you want to do, and whether there's an easy way. Unfortunately, there is no cryptZip-like function in the standard library (unless you count stateful accumulators such as mapAccumL).

• razvanc: I was just about to answer on your other comment :) cause I just went through your other explanation. Only thing I don't like about it really is that pattern matching on ' '. What if we use TAB or some other symbol? We of course don't want to shift those, that's why I have the zipWith and all that funky !! stuff - which yes, I don't like, but I do like to try reimplementing it with @Gurkenglas' solution to toIdx_ and then I'll just have to experiment some more :). Thanks!
• Zeta: @razvanc that's why cryptZip' uses isValid, and the exercise variant uses Char -> Char -> Maybe Char. And yeah, the non-pattern-matching variant is hidden in the exercises in the other question.
• razvanc: I'll have to go over your solution again and process it slower :) to fully get the ins-&-outs of it. Thanks for your time :).
• Zeta: By the way, I wouldn't call Gurkenglas' second solution best practice. It's clever, but rather obfuscated.
• razvanc: Well I'm not entitled to say it since I'm such a n00b at Haskell but I do get that feeling, yes :)

Answer 2

To get rid of !! here, you can use it earlier and earlier until you never even generate an Int.

-- | Given 'key' & 'msg' generate a list of [Maybe Int] indices
-- to map 'msg' from 'key', skipping invalid characters
toIdx :: Key -> Msg -> [Maybe Char]
toIdx k m = toIdx_ (cycle $ map toUpper k) m
 where toIdx_ :: Key -> Msg -> [Maybe Char]
 toIdx_ _ "" = []
 toIdx_ key@(k:ey) (c:cs)
 | isValid c = Just k : toIdx_ ey cs
 | otherwise = Nothing : toIdx_ key cs
-- | Given 'key' & 'msg' generate a list of numbers representing
-- the amount to shift 'msg' characters based on 'key'
toShifts :: Key -> Msg -> [Int]
toShifts k m = map toKey (toIdx k m)
 where toKey :: Maybe Char -> Int
 toKey Nothing = 0
 toKey (Just x) = ord x - ord 'A'

Of course, there is hardly a need to separate all these steps.

base :: Char -> Maybe Char
base c
 | 'a' <= c && c <= 'z' = Just 'a'
 | 'A' <= c && c <= 'Z' = Just 'A'
 | otherwise = Nothing
vigenere, unVigenere :: String -> String -> String
[vigenere, unVigenere] = (`map` [(+), (-)]) $ \direction k ->
 (.) snd $ (`mapAccumL` cycle k) $ \key@(k:ey) c -> case base c of
 Nothing -> (key, c)
 Just a -> (,) ey $ chr $ ord a +
 mod ((ord c - ord a) `direction` (ord (toUpper k) - ord 'A')) (ord 'Z' - ord 'A')

• razvanc: I really like the solution you have for toIdx_ on the first code block. That's clever :). There's a few problems with it tho', signature should be ... -> [Maybe Char] and it should be called with toIdx_ (cycle $ map toUpper k) m if I'm not mistaking. At the time I wrote the code I didn't know about cycle nor I do about mapAccumL and your second solution is way to terse for me, quite literally not understandable :D. Coming from Python I kind of have it ingrained in my style that explicit is better than implicit. Thanks for your time!