Encode and Decode to Text from Punched Card (Sample Code)

PunchedCardConverter.hs

{-
  Decode and Encode to Texts from Punched Card
  This Program Use IBM 80-column punched card formats.
  Bad this program has allowed any columns.
 
  /
  |]           ]]]]]]]]]
  | ]                   ]]]]]]]]]
  |  ]                           ]]]]]]]]]
  |   ]        ]        ]        ]
  |    ]        ]        ]        ]
  |     ]        ]        ]        ]
  |      ]        ]        ]        ]
  |       ]        ]        ]        ]
  |        ]        ]        ]        ]
  |         ]        ]        ]        ]
  |          ]        ]        ]        ]
  |           ]        ]        ]        ]
  |________________________________________________
   &-0123456789ABCDEFGHIJKLMNOPQR/STUVWXYZ
-}

import System.Environment (getArgs)
import Data.List (elemIndices, transpose)
import Data.Traversable (sequence)
import Data.Char (toUpper, isDigit) 
import Data.Tuple (swap)
import Data.Maybe (fromMaybe)
import Data.Array

type PunchedIndices = [Int]
type PunchedCard = [String]
    
chars :: [((Int,Int), Char)] 
chars = zip (concat [[(a,b) | b <- [4..12]]| a <- [1..3]])
        "ABCDEFGHIJKLMNOPQR/STUVWXYZ"
    
punch2char :: PunchedIndices -> Maybe Char
punch2char []  = Just ' ' 
punch2char [1] = Just '&'
punch2char [2] = Just '-'
punch2char [n] = Just (head $ show (n - 3))
punch2char [a,b] = lookup (a,b) chars
punch2char _ = Nothing

char2punch :: Char -> PunchedIndices
char2punch '&' = [1]
char2punch '-' = [2]
char2punch c
    | isDigit c = [(read [c]) + 3]
    | Just (a,b) <- lookup c (fmap swap chars) = [a,b]
    | otherwise = []

encode :: Char -> String -> PunchedCard
encode punchSymbol = makePunchedCard . fmap (char2punch . toUpper)
    where
      makePunchedCard :: [PunchedIndices] -> PunchedCard
      makePunchedCard pis = transpose $ left : (fmap punchColumn pis)
          where
            left = "/|||||||||||||"
            column = (listArray (0, 13) "             _")
            punchColumn pi = elems $ column // (zip pi (repeat punchSymbol)) 
                    
decode :: Char -> PunchedCard -> String
decode punchChar punchCards = fromMaybe errorMessage (sequence text)
    where
      text = fmap (punch2char . elemIndices punchChar) $ transpose punchCards
      errorMessage = "error: error points is "
                     ++ (unwords $ map show $ elemIndices Nothing text)

main = do
  [cmd,(p:_)] <- getArgs
  texts <- getContents
  case cmd of
    "encode" -> putStrLn $ unlines $ fmap (unlines . encode p) $ lines texts
    "decode" -> putStrLn $ decode p $ lines texts
    _ -> putStrLn ("error:" ++ cmd ++ " command is not much")