nahive_rails_params_parser.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import qualified Data.Map as M
import Data.List (isSuffixOf, isPrefixOf)
import Control.Arrow (second)
import Control.Monad (mapM_)
import Control.Monad.State

newtype ParamsParserMonad a = PPM (State (M.Map String [String]) a)
                            deriving (Monad)

execParamsParser (PPM m) = execState m M.empty

addPair :: String -> String -> ParamsParserMonad ()
addPair key value = do
  if "[]" `isSuffixOf` key
    then storePair concatStrategy (takeWhile (/= '[') key) [value]
    else storePair replaceStrategy key [value]
  where
    concatStrategy [newval] oldval = newval : oldval
    replaceStrategy newval _ = newval

storePair :: ([String] -> [String] -> [String]) -> String -> [String] -> ParamsParserMonad ()
storePair fn key value = PPM $ do
  map <- get
  let map' = M.insertWith fn key value map
  put map'

splitBy :: String -> String -> [String]
splitBy sep ""  = []
splitBy sep str = splitBy' str ""
  where
    splitBy' "" accum = [reverse accum]
    splitBy' input@(c:str) accum 
      | sep `isPrefixOf` input = (reverse accum) : splitBy' (drop (length sep - 1) str) ""
      | otherwise = splitBy' str (c:accum)

toPair :: String -> (String, String)
toPair = second (drop 1) . break (== '=')

parseParams :: String -> M.Map String [String]
parseParams str = execParamsParser ((mapM_ (uncurry addPair) . 
                                            filter (not . null . snd) . 
                                            map toPair . 
                                            splitBy "&") str)