    -- | Parse JSON values using the Parsec combinators.

    module Text.JSON.Parsec
      ( p_value
      , p_null
      , p_boolean
      , p_array
      , p_string
      , p_object
      , p_number
      , p_js_string
      , p_js_object
      , p_jvalue
      , module Text.ParserCombinators.Parsec
      ) where

    import Text.JSON.Types
    import Text.ParserCombinators.Parsec
    import Control.Monad
    import Data.Char
    import Numeric

    p_value :: CharParser () JSValue
    p_value = spaces **> p_jvalue

    tok              :: CharParser () a -> CharParser () a
    tok p             = p <** spaces

    p_jvalue         :: CharParser () JSValue
    p_jvalue          =  (JSNull      <$$  p_null)
                     <|> (JSBool      <$$> p_boolean)
                     <|> (JSArray     <$$> p_array)
                     <|> (JSString    <$$> p_js_string)
                     <|> (JSObject    <$$> p_js_object)
                     <|> (JSRational False <$$> p_number)
                     <?> "JSON value"

    p_null           :: CharParser () ()
    p_null            = tok (string "null") >> return ()

    p_boolean        :: CharParser () Bool
    p_boolean         = tok
                          (  (True  <$$ string "true")
                         <|> (False <$$ string "false")
                          )

    p_array          :: CharParser () [JSValue]
    p_array           = between (tok (char '[')) (tok (char ']'))
                      $ p_jvalue `sepBy` tok (char ',')

    p_string         :: CharParser () String
    p_string          = between (tok (char '"')) (tok (char '"')) (many p_char)
      where p_char    =  (char '\\' >> p_esc)
                     <|> (satisfy (\x -> x /= '"' && x /= '\\'))

            p_esc     =  ('"'   <$$ char '"')
                     <|> ('\\'  <$$ char '\\')
                     <|> ('/'   <$$ char '/')
                     <|> ('\b'  <$$ char 'b')
                     <|> ('\f'  <$$ char 'f')
                     <|> ('\n'  <$$ char 'n')
                     <|> ('\r'  <$$ char 'r')
                     <|> ('\t'  <$$ char 't')
                     <|> (char 'u' **> p_uni)
                     <?> "escape character"

            p_uni     = check =<< count 4 (satisfy isHexDigit)
              where check x | code <= max_char  = return (toEnum code)
                            | otherwise         = mzero
                      where code      = fst $ head $ readHex x
                            max_char  = fromEnum (maxBound :: Char)

    p_object         :: CharParser () [(String,JSValue)]
    p_object          = between (tok (char '{')) (tok (char '}'))
                      $ p_field `sepBy` tok (char ',')
      where p_field   = (,) <$$> (p_string <** tok (char ':')) <**> p_jvalue

    p_number         :: CharParser () Rational
    p_number          = tok
                      $ do s <- getInput
                           case readSigned readFloat s of
                             [(n,s1)] -> n <$$ setInput s1
                             _        -> mzero

    p_js_string      :: CharParser () JSString
    p_js_string       = toJSString <$$> p_string

    p_js_object      :: CharParser () (JSObject JSValue)
    p_js_object       = toJSObject <$$> p_object

    --------------------------------------------------------------------------------
    -- XXX: Because Parsec is not Applicative yet...

    (<**>)  :: CharParser () (a -> b) -> CharParser () a -> CharParser () b
    (<**>)   = ap

    (**>)   :: CharParser () a -> CharParser () b -> CharParser () b
    (**>)    = (>>)

    (<**)   :: CharParser () a -> CharParser () b -> CharParser () a
    m <** n  = do x <- m; _ <- n; return x

    (<$$>)  :: (a -> b) -> CharParser () a -> CharParser () b
    (<$$>)   = fmap

    (<$$)   :: a -> CharParser () b -> CharParser () a
    x <$$ m  = m >> return x