diff --git a/CHANGES b/CHANGES
new file mode 100644
--- /dev/null
+++ b/CHANGES
@@ -0,0 +1,51 @@
+Version 0.11
+  * Limit floating-point range to that of Double to avoid allocation
+    overflows when constructing Rationals
+
+Version 0.10
+  * Use MonadFail, so that it works with GHC 8.8
+
+Version 0.9.1
+  * Merge-in contributions from Neil Mitchell to support GHC 7.10
+
+Version 0.9
+  * Merge-in contributions from Neil Mitchell to accomodate working with HEAD.
+
+Version 0.8
+  * Add `Applicative` instance for `GetJSON`
+
+Version 0.4.4: released 2009-01-17; changes from 0.4.2
+
+  * Fixes handling of unterminated strings.
+
+Version 0.4.3: released 2009-01-17; changes from 0.4.2
+
+  * optimize some common cases..string and int literals.
+    Reduces parse times by > 2x on larger dict inputs containing
+    both kinds of lits.
+
+Version 0.4.2: released 2009-01-17; changes from 0.4.1
+
+  * fixed Cabal build issues with various versions of 'base' and Data.Generic
+  * fixed whitespace-handling bug in Parsec-based frontend.
+
+Version 0.4.1: released 2009-01-12; changes from 0.3.6
+
+  * Addition of extra JSON instances:
+       - IntMap, Set, Array, IntSet
+       
+  * Dropped initial letter case-lowering for constructors: 
+       - Maybe's constructors are mapped to "Nothing","Just".
+       - Either's constructors are mapped to "Left", "Right".
+
+  * Ordering's are represented by their constructor names (was
+    funky int-mapping.)
+
+  * JSON.Text.Result is now an instance of MonadError; contributed
+    by Andy Gimblett.
+
+  * Included Lennart Augustsson's contributed generic JSON encoder,
+    in Text.JSON.Generic
+
+  * Optional JSON dict-mapping for Data.Map and Data.IntMap
+
diff --git a/Text/JSON.hs b/Text/JSON.hs
--- a/Text/JSON.hs
+++ b/Text/JSON.hs
@@ -1,18 +1,5 @@
---------------------------------------------------------------------
--- |
--- Module    : Text.JSON
--- Copyright : (c) Galois, Inc. 2007
--- License   : BSD3
---
--- Maintainer:  Don Stewart <dons@galois.com>
--- Stability :  provisional
--- Portability: portable
---
---------------------------------------------------------------------
---
--- Serialising Haskell values to and from JSON values.
---
-
+{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances #-}
+-- | Serialising Haskell values to and from JSON values.
 module Text.JSON (
     -- * JSON Types
     JSValue(..)
@@ -43,30 +30,35 @@
   , readJSArray, readJSObject, readJSValue
 
     -- ** Writing JSON
-  , showJSNull, showJSBool, showJSRational, showJSArray
+  , showJSNull, showJSBool, showJSArray
+  , showJSRational, showJSRational'
   , showJSObject, showJSValue
 
     -- ** Instance helpers
   , makeObj, valFromObj
-
+  , JSKey(..), encJSDict, decJSDict
+  
   ) where
 
 import Text.JSON.Types
 import Text.JSON.String
 
-import Data.Char
-import Data.List
 import Data.Int
 import Data.Word
-import Data.Either
+import Control.Monad.Fail (MonadFail (..))
 import Control.Monad(liftM,ap,MonadPlus(..))
 import Control.Applicative
 
 import qualified Data.ByteString.Char8 as S
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.IntSet as I
+import qualified Data.Set as Set
 import qualified Data.Map as M
+import qualified Data.IntMap as IntMap
 
+import qualified Data.Array as Array
+import qualified Data.Text as T
+
 ------------------------------------------------------------------------
 
 -- | Decode a String representing a JSON value 
@@ -146,12 +138,14 @@
 
 instance Monad Result where
   return x      = Ok x
-  fail x        = Error x
   Ok a >>= f    = f a
   Error x >>= _ = Error x
 
+instance MonadFail Result where
+  fail x        = Error x
+
 -- | Convenient error generation
-mkError :: (JSON a) => String -> Result a
+mkError :: String -> Result a
 mkError s = Error s
 
 --------------------------------------------------------------------
@@ -205,114 +199,116 @@
   readJSONs _             = mkError "Unable to read String"
 
 instance JSON Ordering where
-  showJSON LT = JSRational (-1)
-  showJSON EQ = JSRational 0
-  showJSON GT = JSRational 1
-  readJSON (JSRational (-1)) = return LT
-  readJSON (JSRational 0) = return EQ
-  readJSON (JSRational 1) = return GT
-  readJSON _ = mkError "Unable to read Ordering"
+  showJSON = encJSString show
+  readJSON = decJSString "Ordering" readOrd
+    where
+     readOrd x = 
+       case x of
+         "LT" -> return Prelude.LT
+         "EQ" -> return Prelude.EQ
+         "GT" -> return Prelude.GT
+         _    -> mkError ("Unable to read Ordering")
 
 -- -----------------------------------------------------------------
 -- Integral types
 
 instance JSON Integer where
-  showJSON = JSRational . fromIntegral
-  readJSON (JSRational i) = return $ round i
+  showJSON = JSRational False . fromIntegral
+  readJSON (JSRational _ i) = return $ round i
   readJSON _             = mkError "Unable to read Integer"
 
 -- constrained:
 instance JSON Int where
-  showJSON = JSRational . fromIntegral
-  readJSON (JSRational i) = return $ round i
+  showJSON = JSRational False . fromIntegral
+  readJSON (JSRational _ i) = return $ round i
   readJSON _              = mkError "Unable to read Int"
 
 -- constrained:
 instance JSON Word where
-  showJSON = JSRational . toRational
-  readJSON (JSRational i) = return $ truncate i
+  showJSON = JSRational False . toRational
+  readJSON (JSRational _ i) = return $ truncate i
   readJSON _             = mkError "Unable to read Word"
 
 -- -----------------------------------------------------------------
 
 instance JSON Word8 where
-  showJSON = JSRational . fromIntegral
-  readJSON (JSRational i) = return $ truncate i
+  showJSON = JSRational False . fromIntegral
+  readJSON (JSRational _ i) = return $ truncate i
   readJSON _             = mkError "Unable to read Word8"
 
 instance JSON Word16 where
-  showJSON = JSRational . fromIntegral
-  readJSON (JSRational i) = return $ truncate i
+  showJSON = JSRational False . fromIntegral
+  readJSON (JSRational _ i) = return $ truncate i
   readJSON _             = mkError "Unable to read Word16"
 
 instance JSON Word32 where
-  showJSON = JSRational . fromIntegral
-  readJSON (JSRational i) = return $ truncate i
+  showJSON = JSRational False . fromIntegral
+  readJSON (JSRational _ i) = return $ truncate i
   readJSON _             = mkError "Unable to read Word32"
 
 instance JSON Word64 where
-  showJSON = JSRational . fromIntegral
-  readJSON (JSRational i) = return $ truncate i
+  showJSON = JSRational False . fromIntegral
+  readJSON (JSRational _ i) = return $ truncate i
   readJSON _             = mkError "Unable to read Word64"
 
 instance JSON Int8 where
-  showJSON = JSRational . fromIntegral
-  readJSON (JSRational i) = return $ truncate i
+  showJSON = JSRational False . fromIntegral
+  readJSON (JSRational _ i) = return $ truncate i
   readJSON _             = mkError "Unable to read Int8"
 
 instance JSON Int16 where
-  showJSON = JSRational . fromIntegral
-  readJSON (JSRational i) = return $ truncate i
+  showJSON = JSRational False . fromIntegral
+  readJSON (JSRational _ i) = return $ truncate i
   readJSON _             = mkError "Unable to read Int16"
 
 instance JSON Int32 where
-  showJSON = JSRational . fromIntegral
-  readJSON (JSRational i) = return $ truncate i
+  showJSON = JSRational False . fromIntegral
+  readJSON (JSRational _ i) = return $ truncate i
   readJSON _             = mkError "Unable to read Int32"
 
 instance JSON Int64 where
-  showJSON = JSRational . fromIntegral
-  readJSON (JSRational i) = return $ truncate i
-  readJSON _             = mkError "Unable to read Int64"
+  showJSON = JSRational False . fromIntegral
+  readJSON (JSRational _ i) = return $ truncate i
+  readJSON _                = mkError "Unable to read Int64"
 
 -- -----------------------------------------------------------------
 
 instance JSON Double where
-  showJSON = JSRational . toRational
-  readJSON (JSRational r) = return $ fromRational r
-  readJSON _              = mkError "Unable to read Double"
+  showJSON = JSRational False . toRational
+  readJSON (JSRational _ r) = return $ fromRational r
+  readJSON _                = mkError "Unable to read Double"
     -- can't use JSRational here, due to ambiguous '0' parse
     -- it will parse as Integer.
 
 instance JSON Float where
-  showJSON = JSRational . toRational
-  readJSON (JSRational r) = return $ fromRational r
-  readJSON _              = mkError "Unable to read Float"
+  showJSON = JSRational True . toRational
+  readJSON (JSRational _ r) = return $ fromRational r
+  readJSON _                = mkError "Unable to read Float"
 
 -- -----------------------------------------------------------------
 -- Sums
 
 instance (JSON a) => JSON (Maybe a) where
-  readJSON (JSObject o) = case "just" `lookup` as of
+  readJSON (JSObject o) = case "Just" `lookup` as of
       Just x -> Just <$> readJSON x
-      _      -> case "nothing" `lookup` as of
+      _      -> case ("Nothing" `lookup` as) of
           Just JSNull -> return Nothing
           _           -> mkError "Unable to read Maybe"
     where as = fromJSObject o
   readJSON _ = mkError "Unable to read Maybe"
-  showJSON (Just x) = JSObject $ toJSObject [("just", showJSON x)]
-  showJSON Nothing  = JSObject $ toJSObject [("nothing", JSNull)]
+  showJSON (Just x) = JSObject $ toJSObject [("Just", showJSON x)]
+  showJSON Nothing  = JSObject $ toJSObject [("Nothing", JSNull)]
 
 instance (JSON a, JSON b) => JSON (Either a b) where
-  readJSON (JSObject o) = case "left" `lookup` as of
+  readJSON (JSObject o) = case "Left" `lookup` as of
       Just a  -> Left <$> readJSON a
-      Nothing -> case "right" `lookup` as of
+      Nothing -> case "Right" `lookup` as of
           Just b  -> Right <$> readJSON b
           Nothing -> mkError "Unable to read Either"
     where as = fromJSObject o
   readJSON _ = mkError "Unable to read Either"
-  showJSON (Left a)  = JSObject $ toJSObject [("left",  showJSON a)]
-  showJSON (Right b) = JSObject $ toJSObject [("right", showJSON b)]
+  showJSON (Left a)  = JSObject $ toJSObject [("Left",  showJSON a)]
+  showJSON (Right b) = JSObject $ toJSObject [("Right", showJSON b)]
 
 -- -----------------------------------------------------------------
 -- Products
@@ -353,42 +349,75 @@
   showJSON = showJSONs
   readJSON = readJSONs
 
+-- container types:
+
+#if !defined(MAP_AS_DICT)
 instance (Ord a, JSON a, JSON b) => JSON (M.Map a b) where
--- the previous version: showJSON = showJSON . M.toList
-  showJSON m = JSObject $ toJSObject $ 
-      map (\ (x,y) -> (showJSValue (showJSON x) "", showJSON y)) (M.toList m)
+  showJSON = encJSArray M.toList
+  readJSON = decJSArray "Map" M.fromList
 
-  readJSON (JSObject o) = 
-     mapM rd (fromJSObject o) >>= return . M.fromList
-   where
-     rd (a,b) = do
-       f <- decode a
-       g <- readJSON b
-       return (f,g)
+instance (JSON a) => JSON (IntMap.IntMap a) where
+  showJSON = encJSArray IntMap.toList
+  readJSON = decJSArray "IntMap" IntMap.fromList
 
-   -- backwards compatibility..
-  readJSON a@(JSArray  _) = M.fromList <$> readJSON a
-  readJSON _ = mkError "Unable to read Map"
+#else
+instance (Ord a, JSKey a, JSON b) => JSON (M.Map a b) where
+  showJSON    = encJSDict . M.toList
+  readJSON o  = M.fromList <$> decJSDict "Map" o
 
+instance (JSON a) => JSON (IntMap.IntMap a) where
+  {- alternate (dict) mapping: -}
+  showJSON    = encJSDict . IntMap.toList
+  readJSON o  = IntMap.fromList <$> decJSDict "IntMap" o
+#endif
+
+
+instance (Ord a, JSON a) => JSON (Set.Set a) where
+  showJSON = encJSArray Set.toList
+  readJSON = decJSArray "Set" Set.fromList
+
+instance (Array.Ix i, JSON i, JSON e) => JSON (Array.Array i e) where
+  showJSON = encJSArray Array.assocs
+  readJSON = decJSArray "Array" arrayFromList
+
 instance JSON I.IntSet where
-  showJSON = showJSON . I.toList
-  readJSON a@(JSArray _) = I.fromList <$> readJSON a
-  readJSON _ = mkError "Unable to read IntSet"
+  showJSON = encJSArray I.toList
+  readJSON = decJSArray "IntSet" I.fromList
 
+-- helper functions for array / object serializers:
+arrayFromList :: (Array.Ix i) => [(i,e)] -> Array.Array i e
+arrayFromList [] = Array.array undefined []
+arrayFromList ls@((i,_):xs) = Array.array bnds ls
+  where
+  bnds = foldr step (i,i) xs
+
+  step (ix,_) (mi,ma) =
+    let mi1 = min ix mi
+        ma1 = max ix ma
+    in mi1 `seq` ma1 `seq` (mi1,ma1)
+
+
 -- -----------------------------------------------------------------
 -- ByteStrings
 
 instance JSON S.ByteString where
-  showJSON = JSString . toJSString . S.unpack
-  readJSON (JSString s) = return $ S.pack $ fromJSString s
-  readJSON _ = mkError "Unable to read ByteString"
+  showJSON = encJSString S.unpack
+  readJSON = decJSString "ByteString" (return . S.pack)
 
 instance JSON L.ByteString where
-  showJSON = JSString . toJSString . L.unpack
-  readJSON (JSString s) = return $ L.pack $ fromJSString s
-  readJSON _ = mkError "Unable to read ByteString"
+  showJSON = encJSString L.unpack
+  readJSON = decJSString "Lazy.ByteString" (return . L.pack)
 
 -- -----------------------------------------------------------------
+-- Data.Text
+
+instance JSON T.Text where
+  readJSON (JSString s) = return (T.pack . fromJSString $ s)
+  readJSON _            = mkError "Unable to read JSString"
+  showJSON              = JSString . toJSString . T.unpack
+
+
+-- -----------------------------------------------------------------
 -- Instance Helpers
 
 makeObj :: [(String, JSValue)] -> JSValue
@@ -398,4 +427,58 @@
 valFromObj :: JSON a => String -> JSObject JSValue -> Result a
 valFromObj k o = maybe (Error $ "valFromObj: Could not find key: " ++ show k)
                        readJSON
-		       (lookup k (fromJSObject o))
+                       (lookup k (fromJSObject o))
+
+encJSString :: (a -> String) -> a -> JSValue
+encJSString f v = JSString (toJSString (f v))
+
+decJSString :: String -> (String -> Result a) -> JSValue -> Result a
+decJSString _ f (JSString s) = f (fromJSString s)
+decJSString l _ _ = mkError ("readJSON{"++l++"}: unable to parse string value")
+
+encJSArray :: (JSON a) => (b-> [a]) -> b -> JSValue
+encJSArray f v = showJSON (f v)
+
+decJSArray :: (JSON a) => String -> ([a] -> b) -> JSValue -> Result b
+decJSArray _ f a@JSArray{} = f <$> readJSON a
+decJSArray l _ _ = mkError ("readJSON{"++l++"}: unable to parse array value")
+
+-- | Haskell types that can be used as keys in JSON objects.
+class JSKey a where
+  toJSKey   :: a -> String
+  fromJSKey :: String -> Maybe a
+
+instance JSKey JSString where
+  toJSKey x   = fromJSString x
+  fromJSKey x = Just (toJSString x)
+
+instance JSKey Int where
+  toJSKey   = show
+  fromJSKey key = case reads key of
+                    [(a,"")] -> Just a
+                    _        -> Nothing
+
+-- NOTE: This prevents us from making other instances for lists but,
+-- our guess is that strings are used as keys more often then other list types.
+instance JSKey String where
+  toJSKey   = id
+  fromJSKey = Just
+  
+-- | Encode an association list as 'JSObject' value.
+encJSDict :: (JSKey a, JSON b) => [(a,b)] -> JSValue
+encJSDict v = makeObj [ (toJSKey x, showJSON y) | (x,y) <- v ]
+
+-- | Decode a 'JSObject' value into an association list.
+decJSDict :: (JSKey a, JSON b)
+          => String
+          -> JSValue
+          -> Result [(a,b)]
+decJSDict l (JSObject o) = mapM rd (fromJSObject o)
+  where rd (a,b) = case fromJSKey a of
+                     Just pa -> readJSON b >>= \pb -> return (pa,pb)
+                     Nothing -> mkError ("readJSON{" ++ l ++ "}:" ++
+                                    "unable to read dict; invalid object key")
+
+decJSDict l _ = mkError ("readJSON{"++l ++ "}: unable to read dict; expected JSON object")
+
+
diff --git a/Text/JSON/Generic.hs b/Text/JSON/Generic.hs
new file mode 100644
--- /dev/null
+++ b/Text/JSON/Generic.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE PatternGuards #-}
+-- | JSON serializer and deserializer using Data.Generics.
+-- The functions here handle algebraic data types and primitive types.
+-- It uses the same representation as "Text.JSON" for "Prelude" types.
+module Text.JSON.Generic 
+    ( module Text.JSON
+    , Data
+    , Typeable
+    , toJSON
+    , fromJSON
+    , encodeJSON
+    , decodeJSON
+
+    , toJSON_generic
+    , fromJSON_generic
+    ) where
+
+import Control.Monad.State
+import Text.JSON
+import Text.JSON.String ( runGetJSON )
+import Data.Generics
+import Data.Word
+import Data.Int
+
+import qualified Data.ByteString.Char8 as S
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.IntSet as I
+-- FIXME: The JSON library treats this specially, needs ext2Q
+-- import qualified Data.Map as M
+
+type T a = a -> JSValue
+
+-- |Convert anything to a JSON value.
+toJSON :: (Data a) => a -> JSValue
+toJSON = toJSON_generic
+         `ext1Q` jList
+         -- Use the standard encoding for all base types.
+         `extQ` (showJSON :: T Integer)
+         `extQ` (showJSON :: T Int)
+         `extQ` (showJSON :: T Word8)
+         `extQ` (showJSON :: T Word16)
+         `extQ` (showJSON :: T Word32)
+         `extQ` (showJSON :: T Word64)
+         `extQ` (showJSON :: T Int8)
+         `extQ` (showJSON :: T Int16)
+         `extQ` (showJSON :: T Int32)
+         `extQ` (showJSON :: T Int64)
+         `extQ` (showJSON :: T Double)
+         `extQ` (showJSON :: T Float)
+         `extQ` (showJSON :: T Char)
+         `extQ` (showJSON :: T String)
+         -- Bool has a special encoding.
+         `extQ` (showJSON :: T Bool)
+         `extQ` (showJSON :: T ())
+         `extQ` (showJSON :: T Ordering)
+         -- More special cases.
+         `extQ` (showJSON :: T I.IntSet)
+         `extQ` (showJSON :: T S.ByteString)
+         `extQ` (showJSON :: T L.ByteString)
+  where
+        -- Lists are simply coded as arrays.
+        jList vs = JSArray $ map toJSON vs
+
+
+toJSON_generic :: (Data a) => a -> JSValue
+toJSON_generic = generic
+  where
+        -- Generic encoding of an algebraic data type.
+        --   No constructor, so it must be an error value.  Code it anyway as JSNull.
+        --   Elide a single constructor and just code the arguments.
+        --   For multiple constructors, make an object with a field name that is the
+        --   constructor (except lower case) and the data is the arguments encoded.
+        generic a =
+            case dataTypeRep (dataTypeOf a) of
+                AlgRep []  -> JSNull
+                AlgRep [c] -> encodeArgs c (gmapQ toJSON a)
+                AlgRep _   -> encodeConstr (toConstr a) (gmapQ toJSON a)
+                rep        -> err (dataTypeOf a) rep
+           where
+              err dt r = error $ "toJSON: not AlgRep " ++ show r ++ "(" ++ show dt ++ ")"
+        -- Encode nullary constructor as a string.
+        -- Encode non-nullary constructors as an object with the constructor
+        -- name as the single field and the arguments as the value.
+        -- Use an array if the are no field names, but elide singleton arrays,
+        -- and use an object if there are field names.
+        encodeConstr c [] = JSString $ toJSString $ constrString c
+        encodeConstr c as = jsObject [(constrString c, encodeArgs c as)]
+
+        constrString = showConstr
+
+        encodeArgs c = encodeArgs' (constrFields c)
+        encodeArgs' [] [j] = j
+        encodeArgs' [] js  = JSArray js
+        encodeArgs' ns js  = jsObject $ zip (map mungeField ns) js
+
+        -- Skip leading '_' in field name so we can use keywords etc. as field names.
+        mungeField ('_':cs) = cs
+        mungeField cs = cs
+
+        jsObject :: [(String, JSValue)] -> JSValue
+        jsObject = JSObject . toJSObject
+
+
+type F a = Result a
+
+-- |Convert a JSON value to anything (fails if the types do not match).
+fromJSON :: (Data a) => JSValue -> Result a
+fromJSON j = fromJSON_generic j
+             `ext1R` jList
+
+             `extR` (value :: F Integer)
+             `extR` (value :: F Int)
+             `extR` (value :: F Word8)
+             `extR` (value :: F Word16)
+             `extR` (value :: F Word32)
+             `extR` (value :: F Word64)
+             `extR` (value :: F Int8)
+             `extR` (value :: F Int16)
+             `extR` (value :: F Int32)
+             `extR` (value :: F Int64)
+             `extR` (value :: F Double)
+             `extR` (value :: F Float)
+             `extR` (value :: F Char)
+             `extR` (value :: F String)
+
+             `extR` (value :: F Bool)
+             `extR` (value :: F ())
+             `extR` (value :: F Ordering)
+
+             `extR` (value :: F I.IntSet)
+             `extR` (value :: F S.ByteString)
+             `extR` (value :: F L.ByteString)
+  where value :: (JSON a) => Result a
+        value = readJSON j
+
+        jList :: (Data e) => Result [e]
+        jList = case j of
+                JSArray js -> mapM fromJSON js
+                _ -> Error $ "fromJSON: Prelude.[] bad data: " ++ show j
+
+
+
+fromJSON_generic :: (Data a) => JSValue -> Result a
+fromJSON_generic j = generic
+  where
+        typ = dataTypeOf $ resType generic
+        generic = case dataTypeRep typ of
+                      AlgRep []  -> case j of JSNull -> return (error "Empty type"); _ -> Error $ "fromJSON: no-constr bad data"
+                      AlgRep [_] -> decodeArgs (indexConstr typ 1) j
+                      AlgRep _   -> do (c, j') <- getConstr typ j; decodeArgs c j'
+                      rep        -> Error $ "fromJSON: " ++ show rep ++ "(" ++ show typ ++ ")"
+        getConstr t (JSObject o) | [(s, j')] <- fromJSObject o = do c <- readConstr' t s; return (c, j')
+        getConstr t (JSString js) = do c <- readConstr' t (fromJSString js); return (c, JSNull) -- handle nullare constructor
+        getConstr _ _ = Error "fromJSON: bad constructor encoding"
+        readConstr' t s =
+          maybe (Error $ "fromJSON: unknown constructor: " ++ s ++ " " ++ show t)
+                return $ readConstr t s
+
+        decodeArgs c = decodeArgs' (numConstrArgs (resType generic) c) c (constrFields c)
+        decodeArgs' 0 c  _       JSNull               = construct c []   -- nullary constructor
+        decodeArgs' 1 c []       jd                   = construct c [jd] -- unary constructor
+        decodeArgs' n c []       (JSArray js) | n > 1 = construct c js   -- no field names
+        -- FIXME? We could allow reading an array into a constructor with field names.
+        decodeArgs' _ c fs@(_:_) (JSObject o)         = selectFields (fromJSObject o) fs >>= construct c -- field names
+        decodeArgs' _ c _        jd                   = Error $ "fromJSON: bad decodeArgs data " ++ show (c, jd)
+
+        -- Build the value by stepping through the list of subparts.
+        construct c = evalStateT $ fromConstrM f c
+          where f :: (Data a) => StateT [JSValue] Result a
+                f = do js <- get; case js of [] -> lift $ Error "construct: empty list"; j' : js' -> do put js'; lift $ fromJSON j'
+
+        -- Select the named fields from a JSON object.  FIXME? Should this use a map?
+        selectFields fjs = mapM sel
+          where sel f = maybe (Error $ "fromJSON: field does not exist " ++ f) Ok $ lookup f fjs
+
+        -- Count how many arguments a constructor has.  The value x is used to determine what type the constructor returns.
+        numConstrArgs :: (Data a) => a -> Constr -> Int
+        numConstrArgs x c = execState (fromConstrM f c `asTypeOf` return x) 0
+          where f = do modify (+1); return undefined
+
+        resType :: Result a -> a
+        resType _ = error "resType"
+
+-- |Encode a value as a string.
+encodeJSON :: (Data a) => a -> String
+encodeJSON x = showJSValue (toJSON x) ""
+
+-- |Decode a string as a value.
+decodeJSON :: (Data a) => String -> a
+decodeJSON s =
+    case runGetJSON readJSValue s of
+    Left msg -> error msg
+    Right j ->
+        case fromJSON j of
+        Error msg -> error msg
+        Ok x -> x
diff --git a/Text/JSON/Parsec.hs b/Text/JSON/Parsec.hs
--- a/Text/JSON/Parsec.hs
+++ b/Text/JSON/Parsec.hs
@@ -1,13 +1,4 @@
---------------------------------------------------------------------
--- |
--- Module    : Text.JSON.Parsec
--- Copyright : (c) Galois, Inc. 2007
---
--- Maintainer:  Don Stewart <dons@galois.com>
--- Stability :  provisional
--- Portability: portable
---
--- Parse JSON values using the Parsec combinators.
+-- | Parse JSON values using the Parsec combinators.
 
 module Text.JSON.Parsec
   ( p_value
@@ -19,6 +10,7 @@
   , p_number
   , p_js_string
   , p_js_object
+  , p_jvalue
   , module Text.ParserCombinators.Parsec
   ) where
 
@@ -28,16 +20,19 @@
 import Data.Char
 import Numeric
 
+p_value :: CharParser () JSValue
+p_value = spaces **> p_jvalue
+
 tok              :: CharParser () a -> CharParser () a
-tok p             = spaces *> p
+tok p             = p <** spaces
 
-p_value          :: CharParser () JSValue
-p_value           =  (JSNull      <$  p_null)
-                 <|> (JSBool      <$> p_boolean)
-                 <|> (JSArray     <$> p_array)
-                 <|> (JSString    <$> p_js_string)
-                 <|> (JSObject    <$> p_js_object)
-                 <|> (JSRational  <$> p_number)
+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 () ()
@@ -45,74 +40,71 @@
 
 p_boolean        :: CharParser () Bool
 p_boolean         = tok
-                      (  (True  <$ string "true")
-                     <|> (False <$ string "false")
+                      (  (True  <$$ string "true")
+                     <|> (False <$$ string "false")
                       )
 
 p_array          :: CharParser () [JSValue]
 p_array           = between (tok (char '[')) (tok (char ']'))
-                  $ p_value `sepBy` tok (char ',')
+                  $ p_jvalue `sepBy` tok (char ',')
 
 p_string         :: CharParser () String
-p_string          = between (tok (char '"')) (char '"') (many p_char)
+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)
+        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  = pure (toEnum code)
-                        | otherwise         = empty
+          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_value
+  where p_field   = (,) <$$> (p_string <** tok (char ':')) <**> p_jvalue
 
 p_number         :: CharParser () Rational
-p_number          = do s <- getInput
-                       case readSigned readFloat s of
-                         [(n,s1)] -> n <$ setInput s1
-                         _        -> empty
+p_number          = tok
+                  $ do s <- getInput
+                       case (reads s, readSigned readFloat s) of
+                         ([(x,_)], _)
+                           | isInfinite (x :: Double) -> fail "number out of range"
+                         (_, [(y,s')]) -> y <$$ setInput s'
+                         _ -> mzero <?> "number"
 
 p_js_string      :: CharParser () JSString
-p_js_string       = toJSString <$> p_string
+p_js_string       = toJSString <$$> p_string
 
 p_js_object      :: CharParser () (JSObject JSValue)
-p_js_object       = toJSObject <$> p_object
+p_js_object       = toJSObject <$$> p_object
 
 --------------------------------------------------------------------------------
 -- XXX: Because Parsec is not Applicative yet...
 
-pure   :: a -> CharParser () a
-pure    = return
-
-(<*>)  :: CharParser () (a -> b) -> CharParser () a -> CharParser () b
-(<*>)   = ap
-
-(*>)   :: CharParser () a -> CharParser () b -> CharParser () b
-(*>)    = (>>)
+(<**>)  :: CharParser () (a -> b) -> CharParser () a -> CharParser () b
+(<**>)   = ap
 
-(<*)   :: CharParser () a -> CharParser () b -> CharParser () a
-m <* n  = do x <- m; n; return x
+(**>)   :: CharParser () a -> CharParser () b -> CharParser () b
+(**>)    = (>>)
 
-empty  :: CharParser () a
-empty   = mzero
+(<**)   :: CharParser () a -> CharParser () b -> CharParser () a
+m <** n  = do x <- m; _ <- n; return x
 
-(<$>)  :: (a -> b) -> CharParser () a -> CharParser () b
-(<$>)   = fmap
+(<$$>)  :: (a -> b) -> CharParser () a -> CharParser () b
+(<$$>)   = fmap
 
-(<$)   :: a -> CharParser () b -> CharParser () a
-x <$ m  = m >> return x
+(<$$)   :: a -> CharParser () b -> CharParser () a
+x <$$ m  = m >> return x
 
diff --git a/Text/JSON/Pretty.hs b/Text/JSON/Pretty.hs
--- a/Text/JSON/Pretty.hs
+++ b/Text/JSON/Pretty.hs
@@ -1,14 +1,4 @@
---------------------------------------------------------------------
--- |
--- Module    : Text.JSON.Pretty
--- Copyright : (c) Galois, Inc. 2007
--- License   : BSD3
---
--- Maintainer:  Don Stewart <dons@galois.com>
--- Stability :  provisional
--- Portability: portable
---
--- Display JSON values using pretty printing combinators.
+-- | Display JSON values using pretty printing combinators.
 
 module Text.JSON.Pretty
   ( module Text.JSON.Pretty
@@ -17,6 +7,7 @@
 
 import Text.JSON.Types
 import Text.PrettyPrint.HughesPJ
+import qualified Text.PrettyPrint.HughesPJ as PP
 import Data.Ratio
 import Data.Char
 import Numeric
@@ -25,7 +16,7 @@
 pp_value v        = case v of
     JSNull       -> pp_null
     JSBool x     -> pp_boolean x
-    JSRational x -> pp_number x
+    JSRational asf x -> pp_number asf x
     JSString x   -> pp_js_string x
     JSArray vs   -> pp_array vs
     JSObject xs  -> pp_js_object xs
@@ -37,9 +28,10 @@
 pp_boolean True   = text "true"
 pp_boolean False  = text "false"
 
-pp_number        :: Rational -> Doc
-pp_number x | denominator x == 1  = integer (numerator x)
-pp_number x                       = double (fromRational x)
+pp_number        :: Bool -> Rational -> Doc
+pp_number _ x | denominator x == 1 = integer (numerator x)
+pp_number True x                   = float (fromRational x)
+pp_number _    x                   = double (fromRational x)
 
 pp_array         :: [JSValue] -> Doc
 pp_array xs       = brackets $ fsep $ punctuate comma $ map pp_value xs
@@ -48,10 +40,10 @@
 pp_string x       = doubleQuotes $ hcat $ map pp_char x
   where pp_char '\\'            = text "\\\\"
         pp_char '"'             = text "\\\""
-        pp_char c | isControl c || fromEnum c >= 0x7f = uni_esc c
+        pp_char c | isControl c = uni_esc c
         pp_char c               = char c
 
-        uni_esc c = text "\\u" <> text (pad 4 (showHex (fromEnum c) ""))
+        uni_esc c = text "\\u" PP.<> text (pad 4 (showHex (fromEnum c) ""))
 
         pad n cs  | len < n   = replicate (n-len) '0' ++ cs
                   | otherwise = cs
@@ -59,7 +51,7 @@
 
 pp_object        :: [(String,JSValue)] -> Doc
 pp_object xs      = braces $ fsep $ punctuate comma $ map pp_field xs
-  where pp_field (k,v) = pp_string k <> colon <+> pp_value v
+  where pp_field (k,v) = pp_string k PP.<> colon <+> pp_value v
 
 pp_js_string     :: JSString -> Doc
 pp_js_string x    = pp_string (fromJSString x)
diff --git a/Text/JSON/ReadP.hs b/Text/JSON/ReadP.hs
--- a/Text/JSON/ReadP.hs
+++ b/Text/JSON/ReadP.hs
@@ -1,14 +1,4 @@
---------------------------------------------------------------------
--- |
--- Module    : Text.JSON.ReadP
--- Copyright : (c) Galois, Inc. 2007
--- License   : BSD3
---
--- Maintainer:  Don Stewart <dons@galois.com>
--- Stability :  provisional
--- Portability: portable
---
--- Parse JSON values using the ReadP combinators.
+-- | Parse JSON values using the ReadP combinators.
 
 module Text.JSON.ReadP
   ( p_value
@@ -30,23 +20,23 @@
 import Numeric
 
 token            :: ReadP a -> ReadP a
-token p           = skipSpaces *> p
+token p           = skipSpaces **> p
 
 p_value          :: ReadP JSValue
-p_value           =  (JSNull      <$  p_null)
-                 <|> (JSBool      <$> p_boolean)
-                 <|> (JSArray     <$> p_array)
-                 <|> (JSString    <$> p_js_string)
-                 <|> (JSObject    <$> p_js_object)
-                 <|> (JSRational  <$> p_number)
+p_value           =  (JSNull      <$$  p_null)
+                 <||> (JSBool      <$$> p_boolean)
+                 <||> (JSArray     <$$> p_array)
+                 <||> (JSString    <$$> p_js_string)
+                 <||> (JSObject    <$$> p_js_object)
+                 <||> (JSRational False <$$> p_number)
 
 p_null           :: ReadP ()
 p_null            = token (string "null") >> return ()
 
 p_boolean        :: ReadP Bool
 p_boolean         = token
-                      (  (True  <$ string "true")
-                     <|> (False <$ string "false")
+                      (  (True  <$$ string "true")
+                     <||> (False <$$ string "false")
                       )
 
 p_array          :: ReadP [JSValue]
@@ -56,62 +46,66 @@
 p_string         :: ReadP String
 p_string          = between (token (char '"')) (char '"') (many p_char)
   where p_char    =  (char '\\' >> p_esc)
-                 <|> (satisfy (\x -> x /= '"' && x /= '\\'))
+                 <||> (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)
+        p_esc     =  ('"'   <$$ char '"')
+                 <||> ('\\'  <$$ char '\\')
+                 <||> ('/'   <$$ char '/')
+                 <||> ('\b'  <$$ char 'b')
+                 <||> ('\f'  <$$ char 'f')
+                 <||> ('\n'  <$$ char 'n')
+                 <||> ('\r'  <$$ char 'r')
+                 <||> ('\t'  <$$ char 't')
+                 <||> (char 'u' **> p_uni)
 
         p_uni     = check =<< count 4 (satisfy isHexDigit)
-          where check x | code <= max_char  = pure (toEnum code)
-                        | otherwise         = empty
+          where check x | code <= max_char  = return (toEnum code)
+                        | otherwise         = pfail
                   where code      = fst $ head $ readHex x
                         max_char  = fromEnum (maxBound :: Char)
 
 p_object         :: ReadP [(String,JSValue)]
 p_object          = between (token (char '{')) (token (char '}'))
                   $ p_field `sepBy` token (char ',')
-  where p_field   = (,) <$> (p_string <* token (char ':')) <*> p_value
+  where p_field   = (,) <$$> (p_string <** token (char ':')) <**> p_value
 
 p_number         :: ReadP Rational
-p_number          = readS_to_P (readSigned readFloat)
+p_number          = readS_to_P safeRationalReads
 
+-- reading into a Double with reads is safe for huge floating-point literals
+-- this will allow all floating-point literals that are small enough to fit
+-- into a Double (and are thus compatible with most other json implementations)
+-- to be parsed here without opening us to oversized Rational allocations
+safeRationalReads :: ReadS Rational
+safeRationalReads str =
+  case reads str of
+    [(d,_)] | not (isInfinite (d :: Double)) -> readSigned readFloat str
+    _ -> []
+
 p_js_string      :: ReadP JSString
-p_js_string       = toJSString <$> p_string
+p_js_string       = toJSString <$$> p_string
 
 p_js_object      :: ReadP (JSObject JSValue)
-p_js_object       = toJSObject <$> p_object
+p_js_object       = toJSObject <$$> p_object
 
 --------------------------------------------------------------------------------
 -- XXX: Because ReadP is not Applicative yet...
 
-pure   :: a -> ReadP a
-pure    = return
-
-(<*>)  :: ReadP (a -> b) -> ReadP a -> ReadP b
-(<*>)   = ap
-
-(*>)   :: ReadP a -> ReadP b -> ReadP b
-(*>)    = (>>)
+(<**>)  :: ReadP (a -> b) -> ReadP a -> ReadP b
+(<**>)   = ap
 
-(<*)   :: ReadP a -> ReadP b -> ReadP a
-m <* n  = do x <- m; n; return x
+(**>)   :: ReadP a -> ReadP b -> ReadP b
+(**>)    = (>>)
 
-empty  :: ReadP a
-empty   = pfail
+(<**)   :: ReadP a -> ReadP b -> ReadP a
+m <** n  = do x <- m; _ <- n; return x
 
-(<|>)  :: ReadP a -> ReadP a -> ReadP a
-(<|>)   = (+++)
+(<||>)  :: ReadP a -> ReadP a -> ReadP a
+(<||>)   = (+++)
 
-(<$>)  :: (a -> b) -> ReadP a -> ReadP b
-(<$>)   = fmap
+(<$$>)  :: (a -> b) -> ReadP a -> ReadP b
+(<$$>)   = fmap
 
-(<$)   :: a -> ReadP b -> ReadP a
-x <$ m  = m >> return x
+(<$$)   :: a -> ReadP b -> ReadP a
+x <$$ m  = m >> return x
 
diff --git a/Text/JSON/String.hs b/Text/JSON/String.hs
--- a/Text/JSON/String.hs
+++ b/Text/JSON/String.hs
@@ -1,47 +1,47 @@
---------------------------------------------------------------------
--- |
--- Module    : Text.JSON.String
--- Copyright : (c) Galois, Inc. 2007
--- License   : BSD3
---
--- Maintainer:  Don Stewart <dons@galois.com>
--- Stability :  provisional
--- Portability: portable
---
---------------------------------------------------------------------
---
--- Basic support for working with JSON values.
---
-
-module Text.JSON.String (
-    -- * Parsing
-    --
-     GetJSON, runGetJSON
+-- | Basic support for working with JSON values.
 
-    -- ** Reading JSON
-  , readJSNull, readJSBool, readJSString, readJSRational
-  , readJSArray, readJSObject
+module Text.JSON.String 
+     ( 
+       -- * Parsing
+       --
+       GetJSON
+     , runGetJSON
 
-  , readJSValue, readJSTopType
+       -- ** Reading JSON
+     , readJSNull
+     , readJSBool
+     , readJSString
+     , readJSRational
+     , readJSArray
+     , readJSObject
 
-    -- ** Writing JSON
-  , showJSNull, showJSBool, showJSRational, showJSArray
-  , showJSObject
+     , readJSValue
+     , readJSTopType
 
-  , showJSValue, showJSTopType
+       -- ** Writing JSON
+     , showJSNull
+     , showJSBool
+     , showJSArray
+     , showJSObject
+     , showJSRational
+     , showJSRational'
 
-  ) where
+     , showJSValue
+     , showJSTopType
+     ) where
 
+import Prelude hiding (fail)
 import Text.JSON.Types (JSValue(..),
                         JSString, toJSString, fromJSString,
                         JSObject, toJSObject, fromJSObject)
 
-import Control.Monad (liftM)
-import Data.Char (isSpace, isDigit)
-import Data.List (isPrefixOf)
+import Control.Monad (liftM, ap)
+import Control.Monad.Fail (MonadFail (..))
+import Control.Applicative((<$>))
+import qualified Control.Applicative as A
+import Data.Char (isSpace, isDigit, digitToInt)
 import Data.Ratio (numerator, denominator, (%))
-import Numeric (readHex, readDec, showHex)
-
+import Numeric (readHex, readDec, showHex, readSigned, readFloat)
 
 -- -----------------------------------------------------------------
 -- | Parsing JSON
@@ -50,13 +50,19 @@
 newtype GetJSON a = GetJSON { un :: String -> Either String (a,String) }
 
 instance Functor GetJSON where fmap = liftM
+instance A.Applicative GetJSON where
+  pure  = return
+  (<*>) = ap
+
 instance Monad GetJSON where
   return x        = GetJSON (\s -> Right (x,s))
-  fail x          = GetJSON (\_ -> Left x)
   GetJSON m >>= f = GetJSON (\s -> case m s of
                                      Left err -> Left err
                                      Right (a,s1) -> un (f a) s1)
 
+instance MonadFail GetJSON where
+  fail x          = GetJSON (\_ -> Left x)
+
 -- | Run a JSON reader on an input String, returning some Haskell value.
 -- All input will be consumed.
 runGetJSON :: GetJSON a -> String -> Either String a
@@ -72,9 +78,6 @@
 setInput   :: String -> GetJSON ()
 setInput s  = GetJSON (\_ -> Right ((),s))
 
-(<$>) :: Functor f => (a -> b) -> f a -> f b
-x <$> y = fmap x y
-
 -------------------------------------------------------------------------
 
 -- | Find 8 chars context, for error messages
@@ -85,19 +88,25 @@
 readJSNull :: GetJSON JSValue
 readJSNull = do
   xs <- getInput
-  if "null" `isPrefixOf` xs
-        then setInput (drop 4 xs) >> return JSNull
-        else fail $ "Unable to parse JSON null: " ++ context xs
+  case xs of
+    'n':'u':'l':'l':xs1 -> setInput xs1 >> return JSNull
+    _ -> fail $ "Unable to parse JSON null: " ++ context xs
 
+tryJSNull :: GetJSON JSValue -> GetJSON JSValue
+tryJSNull k = do
+  xs <- getInput
+  case xs of
+    'n':'u':'l':'l':xs1 -> setInput xs1 >> return JSNull
+    _ -> k 
+
 -- | Read the JSON Bool type
 readJSBool :: GetJSON JSValue
 readJSBool = do
   xs <- getInput
-  case () of {_
-      | "true"  `isPrefixOf` xs -> setInput (drop 4 xs) >> return (JSBool True)
-      | "false" `isPrefixOf` xs -> setInput (drop 5 xs) >> return (JSBool False)
-      | otherwise               -> fail $ "Unable to parse JSON Bool: " ++ context xs
-  }
+  case xs of
+    't':'r':'u':'e':xs1 -> setInput xs1 >> return (JSBool True)
+    'f':'a':'l':'s':'e':xs1 -> setInput xs1 >> return (JSBool False)
+    _ -> fail $ "Unable to parse JSON Bool: " ++ context xs
 
 -- | Read the JSON String type
 readJSString :: GetJSON JSValue
@@ -106,74 +115,52 @@
   case x of
        '"' : cs -> parse [] cs
        _        -> fail $ "Malformed JSON: expecting string: " ++ context x
-
- where parse rs cs = rs `seq` case cs of
-            '\\' : c : ds -> esc rs c ds
-            '"'  : ds     -> do setInput ds
-                                return . JSString . toJSString . reverse $ rs
-            c    : ds
-                |  (c `elem` (['\x20'..'\x21'] ++ ['\x23'..'\x5B'])) || (c >='\x5D' && c <= '\x10FFFF')
-                          -> parse (c:rs) ds
-                | otherwise
-                          -> fail $ "Illegal unescaped character in string: " ++ context cs
-            _             -> fail $ "Unable to parse JSON String: unterminated String: " ++ context cs
+ where 
+  parse rs cs = 
+    case cs of
+      '\\' : c : ds -> esc rs c ds
+      '"'  : ds     -> do setInput ds
+                          return (JSString (toJSString (reverse rs)))
+      c    : ds
+       | c >= '\x20' && c <= '\xff'    -> parse (c:rs) ds
+       | c < '\x20'     -> fail $ "Illegal unescaped character in string: " ++ context cs
+       | i <= 0x10ffff  -> parse (c:rs) ds
+       | otherwise -> fail $ "Illegal unescaped character in string: " ++ context cs
+       where
+        i = (fromIntegral (fromEnum c) :: Integer)
+      _ -> fail $ "Unable to parse JSON String: unterminated String: " ++ context cs
 
-       esc rs c cs = case c of
-          '\\' -> parse ('\\' : rs) cs
-          '"'  -> parse ('"'  : rs) cs
-          'n'  -> parse ('\n' : rs) cs
-          'r'  -> parse ('\r' : rs) cs
-          't'  -> parse ('\t' : rs) cs
-          'f'  -> parse ('\f' : rs) cs
-          'b'  -> parse ('\b' : rs) cs
-          '/'  -> parse ('/'  : rs) cs
-          'u'  -> case cs of
-                    d1 : d2 : d3 : d4 : cs' ->
-                      case readHex [d1,d2,d3,d4] of
-                        [(n,"")] -> parse (toEnum n : rs) cs'
+  esc rs c cs = case c of
+   '\\' -> parse ('\\' : rs) cs
+   '"'  -> parse ('"'  : rs) cs
+   'n'  -> parse ('\n' : rs) cs
+   'r'  -> parse ('\r' : rs) cs
+   't'  -> parse ('\t' : rs) cs
+   'f'  -> parse ('\f' : rs) cs
+   'b'  -> parse ('\b' : rs) cs
+   '/'  -> parse ('/'  : rs) cs
+   'u'  -> case cs of
+             d1 : d2 : d3 : d4 : cs' ->
+               case readHex [d1,d2,d3,d4] of
+                 [(n,"")] -> parse (toEnum n : rs) cs'
 
-                        x -> fail $ "Unable to parse JSON String: invalid hex: " ++ context (show x)
-                    _ -> fail $ "Unable to parse JSON String: invalid hex: " ++ context cs
-          _ ->  fail $ "Unable to parse JSON String: invalid escape char: " ++ show c
+                 x -> fail $ "Unable to parse JSON String: invalid hex: " ++ context (show x)
+             _ -> fail $ "Unable to parse JSON String: invalid hex: " ++ context cs
+   _ ->  fail $ "Unable to parse JSON String: invalid escape char: " ++ show c
 
 
 -- | Read an Integer or Double in JSON format, returning a Rational
 readJSRational :: GetJSON Rational
 readJSRational = do
   cs <- getInput
-  case cs of
-    '-' : ds -> negate <$> pos ds
-    _        -> pos cs
+  case (reads cs, readSigned readFloat cs) of
+    ([(x,_)], _)
+      | isInfinite (x :: Double) ->
+          fail ("JSON Rational out of range: " ++ context cs)
+    (_, [(y,cs')]) -> setInput cs' >> return y
+    _ -> fail ("Unable to parse JSON Rational: " ++ context cs)
 
-  where pos ('0':cs)  = frac 0 cs
-        pos cs        = case span isDigit cs of
-          ([],_)  -> fail $ "Unable to parse JSON Rational: " ++ context cs
-          (xs,ys) -> frac (fromInteger (read xs)) ys
 
-        frac n cs = case cs of
-            '.' : ds ->
-              case span isDigit ds of
-                ([],_) -> setInput cs >> return n
-                (as,bs) -> let x = read as :: Integer
-                               y = 10 ^ (fromIntegral (length as) :: Integer)
-                           in exponent' (n + (x % y)) bs
-            _ -> exponent' n cs
-
-        exponent' n (c:cs)
-          | c == 'e' || c == 'E' = (n*) <$> exp_num cs
-        exponent' n cs = setInput cs >> return n
-
-        exp_num          :: String -> GetJSON Rational
-        exp_num ('+':cs)  = exp_digs cs
-        exp_num ('-':cs)  = recip <$> exp_digs cs
-        exp_num cs        = exp_digs cs
-
-        exp_digs :: String -> GetJSON Rational
-        exp_digs cs = case readDec cs of
-            [(a,ds)] -> do setInput ds
-                           return (fromIntegral ((10::Integer) ^ (a::Integer)))
-            _        -> fail $ "Unable to parse JSON exponential: " ++ context cs
-
 -- | Read a list in JSON format
 readJSArray  :: GetJSON JSValue
 readJSArray  = readSequence '[' ']' ',' >>= return . JSArray
@@ -217,13 +204,13 @@
 
   where parsePairs rs = rs `seq` do
           a  <- do k  <- do x <- readJSString ; case x of
-                                JSString s -> return s
+                                JSString s -> return (fromJSString s)
                                 _          -> fail $ "Malformed JSON field labels: object keys must be quoted strings."
                    ds <- getInput
                    case dropWhile isSpace ds of
                        ':':es -> do setInput (dropWhile isSpace es)
                                     v <- readJSValue
-                                    return (fromJSString k,v)
+                                    return (k,v)
                        _      -> fail $ "Malformed JSON labelled field: " ++ context ds
 
           ds <- getInput
@@ -245,10 +232,9 @@
     '{' : _ -> readJSObject
     't' : _ -> readJSBool
     'f' : _ -> readJSBool
-    xs    | "null" `isPrefixOf` xs -> readJSNull
-    (x:_) | x == '-' || isDigit x  -> JSRational <$> readJSRational
-
-    xs -> fail $ "Malformed JSON: invalid token in this context " ++ context xs
+    (x:_) | isDigit x || x == '-' -> JSRational False <$> readJSRational
+    xs -> tryJSNull
+             (fail $ "Malformed JSON: invalid token in this context " ++ context xs)
 
 -- | Top level JSON can only be Arrays or Objects
 readJSTopType :: GetJSON JSValue
@@ -271,12 +257,14 @@
 
 -- | Show JSON values
 showJSValue :: JSValue -> ShowS
-showJSValue (JSNull)       = showJSNull
-showJSValue (JSBool b)     = showJSBool b
-showJSValue (JSRational r) = showJSRational r
-showJSValue (JSArray a)    = showJSArray a
-showJSValue (JSString s)   = showJSString s
-showJSValue (JSObject o)   = showJSObject o
+showJSValue jv =
+  case jv of
+    JSNull{}         -> showJSNull
+    JSBool b         -> showJSBool b
+    JSRational asF r -> showJSRational' asF r
+    JSArray a        -> showJSArray a
+    JSString s       -> showJSString s
+    JSObject o       -> showJSObject o
 
 -- | Write the JSON null type
 showJSNull :: ShowS
@@ -295,11 +283,22 @@
 
 -- | Show a Rational in JSON format
 showJSRational :: Rational -> ShowS
-showJSRational r | denominator r == 1 = shows $ numerator r
-                 | otherwise = if isInfinite x || isNaN x then showJSNull
-                                                          else shows x
-                     where x :: Double
-                           x = realToFrac r
+showJSRational r = showJSRational' False r
+
+showJSRational' :: Bool -> Rational -> ShowS
+showJSRational' asFloat r 
+ | denominator r == 1      = shows $ numerator r
+ | isInfinite x || isNaN x = showJSNull
+ | asFloat                 = shows xf
+ | otherwise               = shows x
+ where 
+   x :: Double
+   x = realToFrac r
+   
+   xf :: Float
+   xf = realToFrac r
+
+
 
 -- | Show a list in JSON format
 showJSArray :: [JSValue] -> ShowS
diff --git a/Text/JSON/Types.hs b/Text/JSON/Types.hs
--- a/Text/JSON/Types.hs
+++ b/Text/JSON/Types.hs
@@ -1,18 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
---------------------------------------------------------------------
--- |
--- Module    : Text.JSON.Types
--- Copyright : (c) Galois, Inc. 2007
--- License   : BSD3
---
--- Maintainer:  Don Stewart <dons@galois.com>
--- Stability :  provisional
--- Portability: portable
---
---------------------------------------------------------------------
---
--- Basic support for working with JSON values.
---
+-- | Basic support for working with JSON values.
 
 module Text.JSON.Types (
 
@@ -32,6 +19,7 @@
   ) where
 
 import Data.Typeable ( Typeable )
+import Data.String(IsString(..))
 
 --
 -- | JSON values
@@ -57,7 +45,7 @@
 data JSValue
     = JSNull
     | JSBool     !Bool
-    | JSRational !Rational
+    | JSRational Bool{-as Float?-} !Rational
     | JSString   JSString
     | JSArray    [JSValue]
     | JSObject   (JSObject JSValue)
@@ -72,9 +60,15 @@
 toJSString = JSONString
   -- Note: we don't encode the string yet, that's done when serializing.
 
+instance IsString JSString where
+  fromString = toJSString
+
+instance IsString JSValue where
+  fromString = JSString . fromString
+
 -- | As can association lists
 newtype JSObject e = JSONObject { fromJSObject :: [(String, e)] }
-    deriving (Eq, Ord, Show, Read, Typeable)
+    deriving (Eq, Ord, Show, Read, Typeable )
 
 -- | Make JSON object out of an association list.
 toJSObject :: [(String,a)] -> JSObject a
diff --git a/json.cabal b/json.cabal
--- a/json.cabal
+++ b/json.cabal
@@ -1,5 +1,6 @@
+cabal-version:      2.4
 name:               json
-version:            0.3.6
+version:            0.11
 synopsis:           Support for serialising Haskell to and from JSON
 description:
     JSON (JavaScript Object Notation) is a lightweight data-interchange
@@ -11,14 +12,16 @@
     This library provides a parser and pretty printer for converting
     between Haskell values and JSON.
 category:           Web
-license:            BSD3
+license:            BSD-3-Clause
 license-file:       LICENSE
 author:             Galois Inc.
-maintainer:         Sigbjorn Finne <sof@galois.com>
-Copyright:          (c) 2007-2008 Galois Inc.
-cabal-version:      >= 1.2.0
+maintainer:         Iavor S. Diatchki (iavor.diatchki@gmail.com)
+Copyright:          (c) 2007-2018 Galois Inc.
 build-type: Simple
+extra-doc-files:
+    CHANGES
 extra-source-files:
+    tests/GenericTest.hs
     tests/HUnit.hs
     tests/Makefile
     tests/Parallel.hs
@@ -62,6 +65,10 @@
     tests/unit/pass2.json
     tests/unit/pass3.json
 
+source-repository head
+    type:     git
+    location: https://github.com/GaloisInc/json.git
+
 flag split-base
   default: True
   description: Use the new split base package.
@@ -71,8 +78,16 @@
 flag pretty
   default: True
   description: Add support for using pretty printing combinators.
+flag generic
+  default: True
+  description: Add support for generic encoder.
 
+flag mapdict
+  default: False
+  description: Encode Haskell maps as JSON dicts
+
 library
+  default-language: Haskell2010
   exposed-modules: Text.JSON,
                    Text.JSON.Types,
                    Text.JSON.String,
@@ -80,7 +95,16 @@
   ghc-options:     -Wall -O2
 
   if flag(split-base)
-    build-depends:   base >= 3, array, containers, bytestring
+    if flag(generic)
+      build-depends:    base >=4.9 && <5, syb >= 0.3.3
+
+      exposed-modules:  Text.JSON.Generic
+      Cpp-Options:      -DBASE_4
+    else
+      build-depends:    base >= 3 && <4
+
+    build-depends:   array, containers, bytestring, mtl, text
+
     if flag(parsec)
       build-depends:    parsec
       exposed-modules:  Text.JSON.Parsec
@@ -89,3 +113,9 @@
       exposed-modules:  Text.JSON.Pretty
   else
     build-depends:    base < 3
+
+  if flag(mapdict)
+     cpp-options:     -DMAP_AS_DICT
+
+
+
diff --git a/tests/GenericTest.hs b/tests/GenericTest.hs
new file mode 100644
--- /dev/null
+++ b/tests/GenericTest.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE DeriveDataTypeable, ExtendedDefaultRules, EmptyDataDecls #-}
+module Main where
+import Text.JSON.Generic
+import Data.Word
+import Data.Int
+
+data Foo = Foo { a :: Int, b :: Bool, c :: Baz } | None
+    deriving (Typeable, Data, Show, Eq)
+
+data Baz = Baz Int
+    deriving (Typeable, Data, Show, Eq)
+
+data Bar = Int :+: Int | Zero
+    deriving (Typeable, Data, Show, Eq)
+
+newtype New a = New a
+    deriving (Typeable, Data, Show, Eq)
+
+newtype Apples = Apples { noApples :: Int }
+    deriving (Typeable, Data, Show, Eq)
+
+data Record = Record { x :: Int, y :: Double, z :: Float, s :: String, t :: (Bool, Int) }
+    deriving (Typeable, Data, Show, Eq)
+
+rec = Record { x = 1, y = 2, z = 3.5, s = "hello", t = (True, 0) }
+
+data Tree a = Leaf | Node (Tree a) a (Tree a)
+    deriving (Typeable, Data, Show, Eq)
+
+atree = build 4
+  where build 0 = Leaf
+        build 1 = Node Leaf 100 Leaf
+        build n = Node (build (n-1)) n (build (n-2))
+
+data Color = Red | Green | Blue
+    deriving (Typeable, Data, Show, Eq, Enum)
+
+from (Ok x) = x
+from (Error s) = error s
+
+viaJSON :: (Data a) => a -> a
+viaJSON = from . fromJSON . toJSON
+
+testJSON :: (Data a, Eq a) => a -> Bool
+testJSON x = --x == viaJSON x
+             x == decodeJSON (encodeJSON x)
+
+tests = and [
+    testJSON (1::Integer),
+    testJSON (42::Int),
+    testJSON (100::Word8),
+    testJSON (-1000::Int64),
+    testJSON (4.2::Double),
+    testJSON (4.1::Float),
+    testJSON True,
+    testJSON 'q',
+    testJSON "Hello, World\n",
+    testJSON (Nothing :: Maybe Int),
+    testJSON (Just "aa"),
+    testJSON [],
+    testJSON [1,2,3,4],
+    testJSON (Left 1 :: Either Int Bool),
+    testJSON (Right True :: Either Int Bool),
+    testJSON (1,True),
+    testJSON (1,2,True,'a',"apa",(4.5,99)),
+    testJSON $ Baz 11,
+    testJSON $ Foo 1 True (Baz 42),
+    testJSON None,
+    testJSON $ 2 :+: 3,
+    testJSON Zero,
+    testJSON $ New (2 :+: 3),
+    testJSON rec,
+    testJSON [LT,EQ,GT],
+    testJSON atree,
+    testJSON (),
+    testJSON $ Apples 42,
+    testJSON [Red .. Blue]
+    ]
+
+main :: IO ()
+main = if tests then return () else error "Generic test failed"
diff --git a/tests/Makefile b/tests/Makefile
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -4,9 +4,13 @@
 	mkdir $(ODIR)
 
 all: $(ODIR)
-	ghc -cpp -O QC.hs --make -o QC -no-recomp -odir=$(ODIR) -hidir=$(ODIR)
+	ghc -cpp -O QC.hs --make -o QC -no-recomp -i.. -odir=$(ODIR) -hidir=$(ODIR)
 	time ./QC
-	runhaskell HUnit.hs
+	runhaskell -i.. HUnit.hs
+
+generic:	$(ODIR)
+	ghc -i.. --make -fforce-recomp -odir=$(ODIR) -hidir=$(ODIR) GenericTest.hs -o GenericTest
+	./GenericTest
 
 clean:
 	$(RM) -r $(ODIR)