javascript method squish

gistfile1.hs

import Data.Ord
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 horrifyOptimize

horrifyOptimize str = shortest . map (`horrify` str) $ [3..10]
  where shortest = concat . take 1 . sortBy (comparing length)

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

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

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

replace n = fmap Code . swap where
  swap ('.':cs) | length name > n = 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:" ++ show (reverse acc)
  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