module Codec.MuCipher where

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

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)

getTable :: String -> String
getTable str = map chr $ nub $ sort $ map ord str

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

getString :: String -> Integer -> String
getString table int = map ((table!!) . fromIntegral) $ decodeList (fromIntegral $ length table) int

--decodeList_str :: String -> String -> String
--decodeList_str b i = "takeWhile(/=(0,0))$drop 1$iterate((`divMod`"++b++").fst)("++i++",0)"
--getString_str :: String -> String -> String
--getString_str t b i = "map(("++t++"!!).fromIntegral.snd)("++l++")"

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

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

showCipher :: String -> String
showCipher str = getString_str ("\"" ++ tab ++ "\"") (show base) $ 
                 show $ encodeList base $ reverse $ getList str
                     where base = fromIntegral $ length tab
                           tab = getTable str