{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Network.WindowsLive.Query
    ( parse
    , fromList
    , empty
    , null
    , keys
    , Query
    , lookup1
    , (%=)
    , (%=?)
    , addToURI
    , toQueryString
    )
where

import qualified Prelude
import Prelude hiding ( null )
import Data.List.Split ( splitOn )
import Control.Monad ( liftM )
import Control.Arrow ( (>>>) )
import Control.Monad.Error ( MonadError )
import Network.URI ( unEscapeString, escapeURIString, isUnreserved, URI(uriQuery) )
import Data.Monoid ( Monoid )
import Data.List ( intercalate )

newtype Query = Query { pairs :: [(String, String)] }
    deriving (Monoid, Show)

null :: Query -> Bool
null = Prelude.null . pairs

empty :: Query
empty = Query []

fromList :: [(String, String)] -> Query
fromList = Query

keys :: Query -> [String]
keys = map fst . pairs

(%=) :: String -> String -> Query
k %= v = Query [(k, v)]

(%=?) :: String -> Maybe String -> Query
k %=? v = maybe empty (k %=) v

addToURI :: Query -> URI -> URI
addToURI q u =
    let initialChar = if Prelude.null (uriQuery u) then '?' else '&'
    in u { uriQuery = uriQuery u ++ (initialChar:toQueryString q) }

toQueryString :: Query -> String
toQueryString q =
    let esc = escapeURIString isUnreserved
        encodePair (k, v) = esc k ++ "=" ++ esc v
    in intercalate "&" $ map encodePair $ pairs q

parse :: MonadError e m => String -> m Query
parse = splitOn "&" >>> mapM parsePair >>> liftM Query
    where parsePair p =
              case break (== '=') p of
                (_, []) -> fail $ "Missing value in query string: " ++ show p
                (k, '=':v) -> return ( unEscapeString k
                                     , unEscapeString v
                                     )
                unknown -> error $ "impossible: " ++ show unknown

lookup1 :: MonadError e m => String -> Query -> m String
lookup1 k = pairs >>> Prelude.lookup k >>> maybe missing return
    where missing = fail $ "Missing query arg: " ++ show k