# Haskell Quiz/The Solitaire Cipher/Solution Stoltze

(Difference between revisions)

```module Main where

import Char
import List

data Card = Card Int
| JokerA
| JokerB
deriving (Show, Eq)

instance Enum Card where
toEnum n | n == 53 = JokerA
| n == 54 = JokerB
| otherwise = Card n
succ JokerB = Card 1

getValue :: Card -> Int
getValue (Card n) = n
getValue JokerA = 53
getValue JokerB = 53

deck :: [Card]
deck = [Card 1 .. JokerB]

alphabet :: [Char]
alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

letterToNumber :: Char -> Int
letterToNumber ch = f' 1 ch where
f' n ch = if alphabet !! (n-1) == ch then n else f' (n+1) ch

numberToLetter :: Int -> Char
numberToLetter n | n <  1    = numberToLetter (n + 26)
| n > 26    = numberToLetter (n - 26)
| otherwise = alphabet !! (n - 1)

-- Not really needed, but since they specified cutting it into chuncks of 5, I thought I'd comply
splitInto :: Int -> [Char] -> [Char]
splitInto n list = unwords \$ splitInto' n list where
splitInto' n list | null list = []
| length list < n = [list ++ replicate (n - length list) 'X']
| otherwise = [take n list] ++ splitInto' n (drop n list)

-- Takes some words and a function for parsing. Since encode and decode were very similar, I thought this would be easier
process :: [Char] -> (Int -> Int -> Int) -> [Char]
process line fn = let noSpaces   = map toUpper \$ filter isAlpha line
key        = genKey \$ length noSpaces
keyvalues  = map letterToNumber key
linevalues = map letterToNumber noSpaces
newline    = map (\(x, y) -> numberToLetter (fn x y)) \$ zip linevalues keyvalues
in splitInto 5 newline

encode :: [Char] -> [Char]
encode line = process line (\line key -> line + key)

decode :: [Char] -> [Char]
decode line = process line (\line key -> line - key)

-- Generates the keycode
genKey :: Int -> [Char]
genKey n = repl n deck where
repl 0 _ = []
repl n val = let res = convert \$ move val
in if res == ' ' then repl n (move val) else res : (repl (n-1) (move val))

toLetter :: Card -> Char
toLetter JokerA = ' '
toLetter JokerB = ' '
toLetter card = (cycle alphabet !!) \$ getValue card - 1

convert :: [Card] -> Char
convert (x:xs) = toLetter \$ (x:xs) !! getValue x

-- Moves the deck one step ahead
move :: [Card] -> [Card]
move cards = stepFour \$ stepThree \$ stepTwo \$ stepOne cards where
findStart :: (Eq a) => a -> [a] -> [a]
findStart n (x:xs) = if x == n
then (x:xs)
else findStart n (xs ++ [x])

stepOne, stepTwo, stepThree, stepFour :: [Card] -> [Card]
stepOne (JokerA:x:xs) = x:JokerA:xs
stepOne (x:xs) = let change (x:y:xs) = if x == JokerA
then (y:x:xs)
else change ((y:xs) ++ [x])
in findStart x \$ change (x:xs)

stepTwo (JokerB:x:y:xs) = x:y:JokerB:xs
stepTwo (x:xs) = let change (x:y:z:xs) = if x == JokerB
then (y:z:x:xs)
else change ((y:z:xs) ++ [x])
in findStart x \$ change (x:xs)

stepThree (x:xs) = let fn c    = c /= JokerA && c /= JokerB
toFirst = takeWhile fn (x:xs)
toLast  = reverse \$ takeWhile fn \$ reverse (x:xs)
in toLast ++ (reverse (drop (length toLast) (reverse (drop (length toFirst) (x:xs))))) ++ toFirst

stepFour cards = let l = last cards
r = getValue l
in drop r (init cards) ++ take r (cards) ++ [l]```