Solitaire Cipher in Haskell

Solitaire.hs

-- Solitaire Cipher
-- http://www.rubyquiz.com/quiz1.html

module Solitaire where

import Data.Sequence ((><), (|>), (<|))
import qualified Data.Sequence as S

import Debug.Trace
import Control.Arrow

import Data.Char
import Data.Maybe
import Data.List (unfoldr)

alternates = x
    where x = 0 : y
          y = 1 : x

(!) = S.index

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

type Deck = S.Seq Card

fred = S.fromList $ map Card [1..52] ++ [JokerA, JokerB]

remove :: Int -> Deck -> Deck
remove i deck = partA >< partB
    where
        parts = S.splitAt i deck
        partA = fst parts
        partB = S.drop 1 . snd $ parts

insert :: Int -> Card -> Deck -> Deck
insert i card deck = (partA |> card) >< partB
    where
        parts = S.splitAt i deck
        partA = fst parts
        partB = snd $ parts

swap :: Deck -> Int -> Int -> Deck
swap deck m n = S.update m (deck ! n) . S.update n (deck ! m) $ deck

moveDown :: Card -> Int -> Deck -> Deck
moveDown card n deck = deck'
    where
        size = S.length deck
        deck' = go (S.findIndexL (==card) deck)
        go (Just i) =
            let j = if i + n >= size
                    then (i + n) `mod` (size-1)
                    else i + n
            in remove i >>> insert (j) card $ deck

tripleCut :: Deck -> Deck
tripleCut deck = 
    (partC |> (deck ! topJoker)) >< (partB |> (deck ! bottomJoker)) >< partA
    where
        Just ia = S.findIndexL (==JokerA) deck
        Just ib = S.findIndexL (==JokerB) deck
        topJoker = min ia ib
        bottomJoker = max ia ib
        partA = S.take topJoker deck
        partB = S.take (abs (ia-ib) - 1) . S.drop (topJoker + 1) $ deck
        partC = S.drop (bottomJoker+1) deck

countCut :: Deck -> Deck
countCut deck = (partB' >< partA) |> bottom
    where
        bottom = deck ! (S.length deck - 1)
        value = case bottom of 
            Card n -> n
            JokerA -> 27
            JokerB -> 27
        partA = S.take value deck
        partB = S.drop value deck
        partB' = S.take (S.length partB - 1) partB

takeValue :: Deck -> Maybe Int
takeValue deck = output
    where
        value = case deck ! 0 of
            (Card n ) -> n
            JokerA -> 53
            JokerB -> 53
        output = case deck ! value of
            (Card n) -> Just n
            JokerA -> Nothing
            JokerB -> Nothing

-- key :: Deck -> (Deck, Maybe Int)
key = (moveDown JokerA 1) >>> (moveDown JokerB 2) >>> tripleCut >>> countCut >>> (takeValue &&& id)

stream = unfoldr (Just . key)

toChar n = chr $ ord 'A' + ((n - 1) `mod` 26)
toNumber c = ord c - ord 'A' + 1

keystream = map (toChar . fromJust) . filter (/=Nothing) . stream

chunksOf :: Int -> [a] -> [[a]]
chunksOf n = go []
    where
        go acc [] = reverse acc
        go acc xs | length xs <= n = go (xs:acc) []
                  | otherwise = go (take n xs : acc) (drop n xs)

encrypt input = result
    where
        numbers = map toNumber . prepare $ input
        keys = map toNumber (keystream fred)
        crypt = zipWith (\x y -> (x + y) `mod`26) numbers keys
        result = map toChar crypt

decrypt input = result
    where
        numbers = map toNumber $ input
        keys = map toNumber (keystream fred)
        crypt = zipWith (\x y -> (x - y) `mod`26) numbers keys
        result = map toChar crypt

prepare :: String -> String
prepare msg = padded
    where
        n = 5 - ((length converted) `rem` 5)
        padded = converted ++ replicate (if n < 5 then n else 0) 'X'
        converted = map toUpper . filter isLetter $ msg