replace method calls with shorter ones

gistfile1.hs

import Data.Char
import Data.List
import Control.Monad.State
import qualified Data.Map as M

data Token = Str Char String
           | Code String
  deriving Show
  
main = interact horrify

horrify str = vars names ++ collapse tokens
  where (tokens,(_,names)) = runState (walk (tokenize str)) (0,M.empty)

vars = stmt . intercalate "," . map varize . M.toList where
    varize (name,sym) = sym ++ "='" ++ name ++ "'";
    stmt vs = "var " ++ vs ++ ";"

walk (t@Str{}:ts) = do
  ts' <- walk ts
  return $ t : ts'
walk (Code cs:ts) = do
  t <- replace cs
  ts <- walk ts
  return $ t : ts
walk [] = return []

replace = fmap Code . swap where
  swap ('.':cs) | length name > 5 = do
    cs' <- swap rest
    sym <- genSym name
    return  $ "." ++ sym ++ cs'
    where (name,rest) = span nameChar cs
  swap (c:cs)   = do
    cs' <- swap cs
    return $ c : cs'
  swap [] = return []

genSym name = do
  (count,names) <- get
  case M.lookup name names of
    Just sym -> return sym
    Nothing  -> do 
      let sym = "$" ++ show count
      modify $ const $ (count+1,M.insert name sym names)
      return sym

nameChar c = isLetter c || isDigit c || c `elem` "_$"

collapse (Code cs:ts)     = cs ++ collapse ts
collapse (Str typ cs:ts)  = [typ] ++ cs ++ [typ] ++ collapse ts
collapse [] = []

tokenize = collect [] where
  collect acc [] = [Code (reverse acc)]
  collect acc (c:cs)
      | c `elem` "\"'" = Code (reverse acc) : string c cs
      | otherwise      = collect (c:acc) cs

string typ = collect [] where
  collect acc [] = error "Unexpected end of string."
  collect acc ('\\':c:cs) = collect (c:'\\':acc) cs
  collect acc (c:cs) | c == typ  = Str typ (reverse acc) : tokenize cs
                     | otherwise = collect (c:acc) cs