Ciphers.hs

#!/usr/bin/env stack
-- stack --resolver lts-20.18 script --package hspec
import Test.Hspec
import Data.Char (toLower, toUpper, isUpper, isLower)
import Data.Maybe (fromJust)
import Data.List (elemIndex, lookup)


-- WARN Does not work for uppercase values of p.
shift' :: Char -> Char -> Char
shift' p k =
  case (lookup (toLower p) alphas , lookup (toLower k) alphas) of
     (Just x, Just y)   ->  fromJust $ lookup (x+y) indices
     (Nothing, Just _)  ->  p
     (Just _, Nothing)  ->  error "non-alpha char in k"
     (Nothing, Nothing) ->   error ("both " ++ [p] ++ "and " ++ [k] ++ " are non-alpha")
  where
    alphas  = zip (cycle ['a'..'z']) [0,1..]
    indices = zip [0,1..] (cycle ['a'..'z'])



-- Vigenère cipher
-- ---------------
-- The idea is that each character in the first list is "shifted" by a
-- distance determined by the corresponding character in the second
-- list. The second list, though, may have a different length than the
-- first. If it is longer, there's no problem; you'll just ignore the
-- extra (as seen by the base case vig [] k = []). If it is shorter,
-- though, you'll want to start over at the beginning.
vige :: String -> String -> String
vige p k = map (\(x, y) -> shift' x y) (zip p (cycle k))



main = hspec $ do

  describe "shift" $ do
    it "works for example inputs" $ do
      shift' 'b' 'z' `shouldBe` 'a'

  describe "vige" $ do
    it "works for alpha lowercase only" $ do
      vige "thisistheplaintext" "key" `shouldBe` "dlgcmqdlczpysrrobr"
    it "works for alpha lowercase with spaces" $ do
      vige "this is the plaintext" "key" `shouldBe` "dlgc mq dlc zpysrrobr" -- never terminates
      -- vige "ATTACKATDAWN" "LEMON" `shouldBe` "LXFOPVEFRNHR"

If I run the "works for alpha lowercase with spaces" test, then I get stuck in an infinite loop. Is there a way to write that test so it terminates after a timeout?

A helpful IRC user says: "maybe System.Timeout and shouldNotThrow".