JSON parser written in haskell: no adequate error checking, just JSON

JsonParser.hs

module JsonParser where

import qualified Data.Map as M
import qualified Data.Bifunctor as Bi
import Data.Char ( ord
                 , chr
                 , isHexDigit
                 , isDigit
                 )

data Value = Number Double
           | Str String
           | Array [Value]
           | Object (M.Map Value Value)
           deriving(Show, Eq, Ord)

isWs :: Char -> Bool
isWs = flip elem " \t\n\b\r"

skipWs :: String -> String
skipWs = dropWhile isWs

parse :: String -> (Value, String)
parse ('[':t) =
  Bi.first Array (parseArray t)
  where
    parseArray :: String -> ([Value], String)
    parseArray (w:t) | isWs w = parseArray t
    parseArray (']':t) = ([], t)
    parseArray v       =
      let (value, rest) = Bi.second skipWs $ parse v
      in case rest of
        ',':rt -> Bi.first (value :) $ parseArray rt
        ']':rt -> ([value], rt)

parse ('0':'x':t) =
  (Number number, t')
  where
    -- Pattern ensures that hex digits are not empty
    (hexDigits@(_:_), t') = span isHexDigit t
    number = read $ "0x" ++ hexDigits
parse (h:t) | h `elem` ['0'..'9'] =
  case rest of
    '.':rt ->
      let (afterDot@(_:_), dt) = span isDigit rt
      in (Number $ read $ h:additional ++ "." ++ afterDot, dt)
    _ -> (Number $ read $ h:additional, rest)
  where (additional, rest) = span isDigit t

parse ('{':t) =
  Bi.first Object $ parseObject t
  where
    parseObject :: String -> (M.Map Value Value, String)
    parseObject ('}':t) = (M.empty, t)
    parseObject (w:t) | isWs w = parseObject t
    parseObject keyS =
      let (key, ':':vst) = Bi.second skipWs $ parse keyS
          (value, vt)    = parse $ skipWs vst
          bMap           = M.fromList [(key, value)]
      in case vt of
        ',':t -> Bi.first (M.union bMap) $ parseObject t
        '}':t -> (bMap, t)

parse ('"':t) =
  Bi.first Str (parseString t)
  where
    escape :: String -> (Char, String)
    escape "" = error "unexpected eof at escaping character"
    escape seq =
      case h of
        'n' -> ('\n', t)
        'r' -> ('\r', t)
        't' -> ('\t', t)
        '"' -> ('"', t)
        'x' ->
          let
            hexCharAsInt :: Char -> Int
            hexCharAsInt c | c `elem` ['a'..'f'] = ord c - ord 'a' + 10
                           | c `elem` ['A'..'F'] = ord c - ord 'A' + 10
                           | c `elem` ['0'..'9'] = ord c - ord '0'
                           | otherwise           = error "invalid hex char"
            (x1:[x0], t') = Bi.first (hexCharAsInt <$>) $ splitAt 2 t
          in
            (chr $ x1 * 16 + x0, t')
        'u' -> error "unimplemented"
      where (h:t) = seq

    parseString :: String -> (String, String)
    parseString ('\\':et) =
      let
        (ec, t)   = escape et
        (s, rest) = parseString t
      in
        (ec : s, rest)
    parseString ('"':t) = ("", t)
    parseString (c:t)   = Bi.first (c :) $ parseString t

parse (w:t) | isWs w = parse t