# Haskell Quiz/The Solitaire Cipher/Solution Igloo

From HaskellWiki

This implementation attempts to be short and beautiful rather than efficient. It's just the natural, pure solution, making use of lazy evaluation by generating an infinite key stream and then zipping that with the data.

```
import Data.Char
import Data.List
-- This handy function should be imported from Data.Maybe or somewhere,
-- along with justWhen
justUnless :: (a -> Bool) -> a -> Maybe a
justUnless f x = if f x then Nothing else Just x
-- Sanitisation, padding and splitting
sanitise :: String -> String
sanitise = map toUpper . filter isAlpha . filter isAscii
pad :: Int -> String -> String
pad n = concat . init . splitAts n . (++ replicate n 'X')
splitAts :: Int -> [a] -> [[a]]
splitAts n = unfoldr (fmap (splitAt n) . justUnless null)
-- The deck
initialKey :: [Int]
initialKey = [1..54]
isJokerA, isJokerB, isJoker :: Int -> Bool
isJokerA = (== 53)
isJokerB = (== 54)
isJoker = (>= 53)
toCount :: Int -> Int
toCount = (`min` 53)
-- Deck manipulation functions
rollDown, rollDownTwice :: (a -> Bool) -> [a] -> [a]
rollDown f xs = case break f xs of
(y:ys, [x]) -> y : x : ys
(ys, x:z:zs) -> ys ++ [z, x] ++ zs
rollDownTwice f = rollDown f . rollDown f
tripleCut :: [Int] -> [Int]
tripleCut xs = case break isJoker xs of
(xs1, y:xs') ->
case break isJoker xs' of
(xs2, z:xs3) ->
xs3 ++ [y] ++ xs2 ++ [z] ++ xs1
countCut :: [Int] -> [Int]
countCut xs = case splitAt 53 xs of
(xs', [n]) ->
case splitAt (toCount n) xs' of
(ys, zs) -> zs ++ ys ++ [n]
readVal :: [Int] -> Int
readVal xs@(x:_) = xs !! (toCount x)
-- Algorithm
alg :: (Int -> Int -> Int) -> [Int] -> String -> String
alg f key = concat . intersperse " " . splitAts 5
. zipWith (arith f) (mkStream key)
arith :: (Int -> Int -> Int) -> Int -> Char -> Char
arith f i = chr . (+ ord 'A') . (`mod` 26) . f i . subtract (ord 'A') . ord
enc, dec :: String -> String
enc = alg (+) initialKey . pad 5 . sanitise
dec = alg subtract initialKey . filter (' ' /=)
mkStream :: [Int] -> [Int]
mkStream = filter (not . isJoker) . map readVal . tail . iterate step
step :: [Int] -> [Int]
step = countCut . tripleCut . rollDownTwice isJokerB . rollDown isJokerA
```