module Codec.MuCipher where

import Data.Char
import Data.List
import Data.Maybe
import Numeric

-- Basic number arithmetic
encodeList :: Integer -> [Integer] -> Integer
encodeList base list = sum . zipWith (*) list $ iterate (base *) 1

decodeList :: Integer -> Integer -> [Integer]
decodeList base int = map snd . takeWhile (/=(0,0)) . drop 1 $ 
                      iterate ((`divMod` base) . fst) (int,0)

-- Table-agnostic and auto-table versions
getTable :: String -> String
getTable str = map chr $ nub $ sort $ map ord str

getListWith :: String -> String -> [Integer]
getListWith table str = map (\c -> fromIntegral $ fromJust $ elemIndex c table) str

getList :: String -> [Integer]
getList str = getListWith (getTable str) str

getIntegerWith :: String -> String -> Integer
getIntegerWith table str = encodeList (genericLength table) $ 
                           reverse $ getListWith table str

-- Thanks to "int-e" for suggesting showIntAtBase
getString :: String -> Integer -> String
getString table int = showIntAtBase (genericLength table) (table!!) int ""

showCipherString :: String -> String -> String -> String
showCipherString t b i = "showIntAtBase "++b++" ("++t++"!!) "++i++" \"\""

showCipherWith :: String -> String -> String
showCipherWith table str = showCipherString (show table) (show base) $ 
                         show $ encodeList base $ reverse $ getListWith table str
                             where base = genericLength table

-- These are the easiest functions to use
showCipher :: String -> String
showCipher str = showCipherWith (getTable str) str

printCipher :: String -> IO ()
printCipher = putStrLn . showCipher