Haskell Quiz/The Solitaire Cipher/Solution Igloo

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