Playfair cipher

You are encouraged to solve this task according to the task description, using any language you may know.
Task

Implement a  Playfair cipher for encryption and decryption.



The user must be able to choose   J  =  I     or   no   Q   in the alphabet.

The output of the encrypted and decrypted message must be in capitalized digraphs, separated by spaces.



Output example

                HI DE TH EG OL DI NT HE TR EX ES TU MP



 
import Control.Monad     (guard)
import Data.Array        (Array, assocs, elems, listArray, (!))
import Data.Char         (toUpper)
import Data.List         (nub, (\\))
import Data.List.Split   (chunksOf)
import Data.Maybe        (listToMaybe)
import Data.String.Utils (replace)
 
type Square a = Array (Int, Int) a
 
-- | Turns a list into an n*m-array.
array2D ::
       (Int, Int) -- ^ n * m
    -> [e] -> Square e
array2D maxCoord = listArray ((1, 1), maxCoord)
 
-- | Generates a playfair table starting with the specified string.
--
-- >>> makeTable "hello"
-- "HELOABCDFGIKMNPQRSTUVWXYZ"
makeTable :: String -> String
makeTable k = nub key ++ (alpha \\ key)
    where
      alpha = ['A' .. 'Z'] \\ "J"
      key = map toUpper =<< words k
 
-- | Turns a playfair table into a 5*5 alphabet square.
makeSquare :: [a] -> Square a
makeSquare = array2D (5, 5)
 
-- | Displays a playfair square, formatted as a square.
showSquare :: Square Char -> String
showSquare d = unlines $ chunksOf 5 (elems d)
 
-- | Given a value and an association list of x-coordinate * y-coordinate * value, returns the coordinates
getIndex' :: (Eq a) => a -> [((Int, Int), a)] -> Maybe (Int, Int)
getIndex' el = fmap fst . listToMaybe . filter ((== el) . snd)
 
encodePair, decodePair :: Eq a => Square a -> (a, a) -> Maybe (a, a)
encodePair = pairHelper (\x -> if x == 5 then 1 else x + 1)
decodePair = pairHelper (\x -> if x == 1 then 5 else x - 1)
 
pairHelper :: (Eq t)
    => (Int -> Int) -- ^ a function used for wrapping around the square
    -> Square t -- ^ a playfair square
    -> (t, t) -- ^ two characters
    -> Maybe (t, t) -- ^ the two resulting/encoded characters
pairHelper adjust sqr (c1, c2) =
    do let ps = assocs sqr
       -- assigns an association list of (x-coord * y-coord) * value to ps
       (x1, y1) <- getIndex' c1 ps
       (x2, y2) <- getIndex' c2 ps
       -- returns the coordinates of two values in the square
       -- these will later be swapped
       guard $ c1 /= c2
       -- the characters (and coordinates) cannot be the same
       let get x = sqr ! x
       -- a small utility function for extracting a value from the square
       Just $
           -- wrap the coordinates around and find the encrypted characters
           case () of
             () | y1 == y2 ->
                    (get (adjust x1, y1), get (adjust x2, y2))
                | x1 == x2 ->
                    (get (x1, adjust y1), get (x2, adjust y2))
                | otherwise ->
                    (get (x1, y2), get (x2, y1))
 
-- | Turns two characters into a tuple.
parsePair :: String -> [(Char, Char)]
parsePair = fmap (\[x, y] -> (x, y)) . words . fmap toUpper
 
-- | Turns a tuple of two characters into a string.
unparsePair :: [(Char, Char)] -> String
unparsePair = unwords . fmap (\(x, y) -> [x, y])
 
codeHelper :: (Square Char -> (Char, Char) -> Maybe (Char, Char))
    -> String -> String -> Maybe String
codeHelper subs key =
    fmap unparsePair .
    mapM (subs (makeSquare $ makeTable key)) .
    parsePair
 
playfair, unplayfair :: String -> String -> Maybe String
playfair key = codeHelper encodePair key . formatEncode
unplayfair = codeHelper decodePair
 
formatEncode :: String -> String
formatEncode =
    map toUpper .
    unwords .
    map (\[x, y] -> if x == y then [x, 'x'] else [x, y]) .
    chunksOf 2 .
    replace "j" "i" .
    concatMap adjustLength .
    words .
    filter (\n -> n `elem` (['A'..'Z'] ++ ['a'..'z']))
    where
      adjustLength str
          | odd (length str) = str ++ "x"
          | otherwise = str
 