gistfile1.txt

starting server
opts: StartupConfig {connectionMode = TCPIP False 4005, autoPort = False, showHelp = False}
=== Listening on port: 4005
==> {"id":1,"method":"connection-info","params":{}}
<== {"version":"0.1","id":1,"result":{"version":1,"pid":0}}
==> {"id":2,"method":"list-cabal-components","params":{"cabal-file":"/home/mathijs/workspace/json/json.cabal"}}
<== {"version":"0.1","id":2,"result":[{"library":null,"cabal-file":"/home/mathijs/workspace/json/json.cabal"}]}
==> {"id":3,"method":"load","params":{"component":{"library":null,"cabal-file":"/home/mathijs/workspace/json/json.cabal"},"output":false}}
Configuring json-0.1...
Creating .dist-scion (and its parents)
("/opt/ghc/bin/ghc",["--numeric-version"])
/opt/ghc/bin/ghc is version 6.10.4
("/opt/ghc/bin/ghc-pkg",["--version"])
/opt/ghc/bin/ghc-pkg is version 6.10.4
("/opt/ghc/bin/ghc",["--supported-languages"])
Reading installed packages...
("/opt/ghc/bin/ghc-pkg",["dump","--global"])
("/opt/ghc/bin/ghc-pkg",["dump","--user"])
Warning: No 'build-type' specified. If you do not need a custom Setup.hs or
./configure script then use 'build-type: Simple'.
searching for alex in path.
found alex at /opt/haskell-platform/bin/alex
("/opt/haskell-platform/bin/alex",["--version"])
/opt/haskell-platform/bin/alex is version 2.3.1
searching for ar in path.
found ar at /usr/bin/ar
searching for c2hs in path.
Cannot find c2hs on the path
searching for cpphs in path.
Cannot find cpphs on the path
searching for ffihugs in path.
Cannot find ffihugs on the path
searching for gcc in path.
found gcc at /usr/bin/gcc
("/usr/bin/gcc",["-dumpversion"])
/usr/bin/gcc is version 4.4.1
searching for greencard in path.
Cannot find greencard on the path
searching for haddock in path.
found haddock at /opt/ghc/bin/haddock
("/opt/ghc/bin/haddock",["--version"])
/opt/ghc/bin/haddock is version 2.4.2
searching for happy in path.
found happy at /opt/haskell-platform/bin/happy
("/opt/haskell-platform/bin/happy",["--version"])
/opt/haskell-platform/bin/happy is version 1.18.4
searching for hmake in path.
Cannot find hmake on the path
searching for hsc2hs in path.
found hsc2hs at /opt/ghc/bin/hsc2hs
("/opt/ghc/bin/hsc2hs",["--version"])
/opt/ghc/bin/hsc2hs is version 0.67
searching for HsColour in path.
Cannot find HsColour on the path
searching for hugs in path.
Cannot find hugs on the path
searching for jhc in path.
Cannot find jhc on the path
searching for ld in path.
found ld at /usr/bin/ld
("/opt/ghc/bin/ghc",["-c","/tmp/32620.c","-o","/tmp/32620.o"])
("/usr/bin/ld",["-x","-r","/tmp/32620.o","-o","/tmp/32621.o"])
searching for nhc98 in path.
Cannot find nhc98 on the path
searching for pkg-config in path.
found pkg-config at /usr/bin/pkg-config
("/usr/bin/pkg-config",["--version"])
/usr/bin/pkg-config is version 0.22
searching for ranlib in path.
found ranlib at /usr/bin/ranlib
searching for strip in path.
found strip at /usr/bin/strip
searching for tar in path.
found tar at /bin/tar
<== {"version":"0.1","id":3,"result":{"succeeded":true,"notes":[],"duration":4.9e-5}}
==> {"id":4,"method":"list-cabal-components","params":{"cabal-file":"/home/mathijs/workspace/json/json.cabal"}}
<== {"version":"0.1","id":4,"result":[{"library":null,"cabal-file":"/home/mathijs/workspace/json/json.cabal"}]}
==> {"id":5,"method":"load","params":{"component":{"library":null,"cabal-file":"/home/mathijs/workspace/json/json.cabal"},"output":true}}
<== {"version":"0.1","id":5,"result":{"succeeded":true,"notes":[],"duration":5.2e-5}}
==> {"id":6,"method":"background-typecheck-file","params":{"file":"/home/mathijs/workspace/json/Setup.hs"}}
<== {"version":"0.1","id":6,"result":{"Left":"Could not find file in module graph."}}
==> {"id":7,"method":"background-typecheck-file","params":{"file":"/home/mathijs/workspace/json/Text/JSON.hs"}}
<== {"version":"0.1","id":7,"result":{"Left":"Could not find file in module graph."}}
==> {"id":8,"method":"list-cabal-components","params":{"cabal-file":"/home/mathijs/workspace/json/json.cabal"}}
<== {"version":"0.1","id":8,"result":[{"library":null,"cabal-file":"/home/mathijs/workspace/json/json.cabal"}]}
==> {"id":9,"method":"load","params":{"component":{"library":null,"cabal-file":"/home/mathijs/workspace/json/json.cabal"},"output":true}}
<== {"version":"0.1","id":9,"result":{"succeeded":true,"notes":[],"duration":5.1e-5}}
==> {"id":10,"method":"background-typecheck-arbitrary","params":{"contents":"{-# OPTIONS_GHC -XCPP -XMultiParamTypeClasses -XTypeSynonymInstances #-}\n--------------------------------------------------------------------\n-- |\n-- Module    : Text.JSON\n-- Copyright : (c) Galois, Inc. 2007-2009\n-- License   : BSD3\n--\n-- Maintainer:  Sigbjorn Finne <[email protected]>\n-- Stability :  provisional\n-- Portability: portable\n--\n--------------------------------------------------------------------\n--\n-- Serialising Haskell values to and from JSON values.\n--\n\nmodule Text.JSON (\n    -- * JSON Types\n    JSValue(..)\n\n    -- * Serialization to and from JSValues\n  , JSON(..)\n\n    -- * Encoding and Decoding\n  , Result(..)\n  , encode -- :: JSON a => a -> String\n  , decode -- :: JSON a => String -> Either String a\n  , encodeStrict -- :: JSON a => a -> String\n  , decodeStrict -- :: JSON a => String -> Either String a\n\n    -- * Wrapper Types\n  , JSString\n  , toJSString\n  , fromJSString\n\n  , JSObject\n  , toJSObject\n  , fromJSObject\n  , resultToEither\n\n    -- * Serialization to and from Strings.\n    -- ** Reading JSON\n  , readJSNull, readJSBool, readJSString, readJSRational\n  , readJSArray, readJSObject, readJSValue\n\n    -- ** Writing JSON\n  , showJSNull, showJSBool, showJSArray\n  , showJSRational, showJSRational'\n  , showJSObject, showJSValue\n\n    -- ** Instance helpers\n  , makeObj, valFromObj\n  \n  ) where\n\nimport Text.JSON.Types\nimport Text.JSON.String\n\nimport Data.List\nimport Data.Int\nimport Data.Word\nimport Data.Either\nimport Control.Monad(liftM,ap,MonadPlus(..))\nimport Control.Applicative\nimport Control.Monad.Error ( MonadError(..) )\n\nimport qualified Data.ByteString.Char8 as S\nimport qualified Data.ByteString.Lazy.Char8 as L\nimport qualified Data.IntSet as I\nimport qualified Data.Set as Set\nimport qualified Data.Map as M\nimport qualified Data.IntMap as IntMap\n\nimport qualified Data.Array as Array\n\n------------------------------------------------------------------------\n\n-- | Decode a String representing a JSON value \n-- (either an object, array, bool, number, null)\n--\n-- This is a superset of JSON, as types other than\n-- Array and Object are allowed at the top level.\n--\ndecode :: (JSON a) => String -> Result a\ndecode s = case runGetJSON readJSValue s of\n             Right a  -> readJSON a\n             Left err -> Error err\n\n-- | Encode a Haskell value into a string, in JSON format.\n--\n-- This is a superset of JSON, as types other than\n-- Array and Object are allowed at the top level.\n--\nencode :: (JSON a) => a -> String\nencode = (flip showJSValue [] . showJSON)\n\n------------------------------------------------------------------------\n\n-- | Decode a String representing a strict JSON value.\n-- This follows the spec, and requires top level\n-- JSON types to be an Array or Object.\ndecodeStrict :: (JSON a) => String -> Result a\ndecodeStrict s = case runGetJSON readJSTopType s of\n     Right a  -> readJSON a\n     Left err -> Error err\n\n-- | Encode a value as a String in strict JSON format.\n-- This follows the spec, and requires all values\n-- at the top level to be wrapped in either an Array or Object.\n-- JSON types to be an Array or Object.\nencodeStrict :: (JSON a) => a -> String\nencodeStrict = (flip showJSTopType [] . showJSON)\n\n------------------------------------------------------------------------\n\n-- | The class of types serialisable to and from JSON\nclass JSON a where\n  readJSON  :: JSValue -> Result a\n  showJSON  :: a -> JSValue\n\n  readJSONs :: JSValue -> Result [a]\n  readJSONs (JSArray as) = mapM readJSON as\n  readJSONs _            = mkError \"Unable to read list\"\n\n  showJSONs :: [a] -> JSValue\n  showJSONs = JSArray . map showJSON\n\n-- | A type for parser results\ndata Result a = Ok a | Error String\n  deriving (Eq,Show)\n\n-- | Map Results to Eithers\nresultToEither :: Result a -> Either String a\nresultToEither (Ok a)    = Right a\nresultToEither (Error s) = Left  s\n\ninstance Functor Result where fmap = liftM\n\ninstance Applicative Result where\n  (<*>) = ap\n  pure  = return\n\ninstance Alternative Result where\n  Ok a    <|> _ = Ok a\n  Error _ <|> b = b\n  empty         = Error \"empty\"\n\ninstance MonadPlus Result where\n  Ok a `mplus` _ = Ok a\n  _ `mplus` x    = x\n  mzero          = Error \"Result: MonadPlus.empty\"\n\ninstance Monad Result where\n  return x      = Ok x\n  fail x        = Error x\n  Ok a >>= f    = f a\n  Error x >>= _ = Error x\n\ninstance MonadError String Result where\n  throwError x = Error x\n\n  catchError (Error e) h = h e\n  catchError x _ = x\n\n-- | Convenient error generation\nmkError :: String -> Result a\nmkError s = Error s\n\n--------------------------------------------------------------------\n--\n-- | To ensure we generate valid JSON, we map Haskell types to JSValue\n-- internally, then pretty print that.\n--\ninstance JSON JSValue where\n    showJSON = id\n    readJSON = return\n\nsecond :: (a -> b) -> (x,a) -> (x,b)\nsecond f (a,b) = (a, f b)\n\n--------------------------------------------------------------------\n-- Some simple JSON wrapper types, to avoid overlapping instances\n\ninstance JSON JSString where\n  readJSON (JSString s) = return s\n  readJSON _            = mkError \"Unable to read JSString\"\n  showJSON = JSString\n\ninstance (JSON a) => JSON (JSObject a) where\n  readJSON (JSObject o) =\n      let f (x,y) = do y' <- readJSON y; return (x,y')\n      in toJSObject `fmap` mapM f (fromJSObject o)\n  readJSON _ = mkError \"Unable to read JSObject\"\n  showJSON = JSObject . toJSObject . map (second showJSON) . fromJSObject\n\n\n-- -----------------------------------------------------------------\n-- Instances\n--\n\ninstance JSON Bool where\n  showJSON = JSBool\n  readJSON (JSBool b) = return b\n  readJSON _          = mkError \"Unable to read Bool\"\n\ninstance JSON Char where\n  showJSON  = JSString . toJSString . (:[])\n  showJSONs = JSString . toJSString\n\n  readJSON (JSString s) = case fromJSString s of\n                            [c] -> return c\n                            _ -> mkError \"Unable to read Char\"\n  readJSON _            = mkError \"Unable to read Char\"\n\n  readJSONs (JSString s)  = return (fromJSString s)\n  readJSONs (JSArray a)   = mapM readJSON a\n  readJSONs _             = mkError \"Unable to read String\"\n\ninstance JSON Ordering where\n  showJSON = encJSString show\n  readJSON = decJSString \"Ordering\" readOrd\n    where\n     readOrd x = \n       case x of\n         \"LT\" -> return Prelude.LT\n\t \"EQ\" -> return Prelude.EQ\n\t \"GT\" -> return Prelude.GT\n\t _    -> mkError (\"Unable to read Ordering\")\n\n-- -----------------------------------------------------------------\n-- Integral types\n\ninstance JSON Integer where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ round i\n  readJSON _             = mkError \"Unable to read Integer\"\n\n-- constrained:\ninstance JSON Int where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ round i\n  readJSON _              = mkError \"Unable to read Int\"\n\n-- constrained:\ninstance JSON Word where\n  showJSON = JSRational False . toRational\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Word\"\n\n-- -----------------------------------------------------------------\n\ninstance JSON Word8 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Word8\"\n\ninstance JSON Word16 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Word16\"\n\ninstance JSON Word32 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Word32\"\n\ninstance JSON Word64 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Word64\"\n\ninstance JSON Int8 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Int8\"\n\ninstance JSON Int16 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Int16\"\n\ninstance JSON Int32 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Int32\"\n\ninstance JSON Int64 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _                = mkError \"Unable to read Int64\"\n\n-- -----------------------------------------------------------------\n\ninstance JSON Double where\n  showJSON = JSRational False . toRational\n  readJSON (JSRational _ r) = return $ fromRational r\n  readJSON _                = mkError \"Unable to read Double\"\n    -- can't use JSRational here, due to ambiguous '0' parse\n    -- it will parse as Integer.\n\ninstance JSON Float where\n  showJSON = JSRational True . toRational\n  readJSON (JSRational _ r) = return $ fromRational r\n  readJSON _                = mkError \"Unable to read Float\"\n\n-- -----------------------------------------------------------------\n-- Sums\n\ninstance (JSON a) => JSON (Maybe a) where\n  readJSON (JSObject o) = case \"Just\" `lookup` as of\n      Just x -> Just <$> readJSON x\n      _      -> case (\"Nothing\" `lookup` as) of\n          Just JSNull -> return Nothing\n          _           -> mkError \"Unable to read Maybe\"\n    where as = fromJSObject o\n  readJSON _ = mkError \"Unable to read Maybe\"\n  showJSON (Just x) = JSObject $ toJSObject [(\"Just\", showJSON x)]\n  showJSON Nothing  = JSObject $ toJSObject [(\"Nothing\", JSNull)]\n\ninstance (JSON a, JSON b) => JSON (Either a b) where\n  readJSON (JSObject o) = case \"Left\" `lookup` as of\n      Just a  -> Left <$> readJSON a\n      Nothing -> case \"Right\" `lookup` as of\n          Just b  -> Right <$> readJSON b\n          Nothing -> mkError \"Unable to read Either\"\n    where as = fromJSObject o\n  readJSON _ = mkError \"Unable to read Either\"\n  showJSON (Left a)  = JSObject $ toJSObject [(\"Left\",  showJSON a)]\n  showJSON (Right b) = JSObject $ toJSObject [(\"Right\", showJSON b)]\n\n-- -----------------------------------------------------------------\n-- Products\n\ninstance JSON () where\n  showJSON _ = JSArray []\n  readJSON (JSArray []) = return ()\n  readJSON _      = mkError \"Unable to read ()\"\n\ninstance (JSON a, JSON b) => JSON (a,b) where\n  showJSON (a,b) = JSArray [ showJSON a, showJSON b ]\n  readJSON (JSArray [a,b]) = (,) `fmap` readJSON a `ap` readJSON b\n  readJSON _ = mkError \"Unable to read Pair\"\n\ninstance (JSON a, JSON b, JSON c) => JSON (a,b,c) where\n  showJSON (a,b,c) = JSArray [ showJSON a, showJSON b, showJSON c ]\n  readJSON (JSArray [a,b,c]) = (,,) `fmap`\n                                  readJSON a `ap`\n                                  readJSON b `ap`\n                                  readJSON c\n  readJSON _ = mkError \"Unable to read Triple\"\n\ninstance (JSON a, JSON b, JSON c, JSON d) => JSON (a,b,c,d) where\n  showJSON (a,b,c,d) = JSArray [showJSON a, showJSON b, showJSON c, showJSON d]\n  readJSON (JSArray [a,b,c,d]) = (,,,) `fmap`\n                                  readJSON a `ap`\n                                  readJSON b `ap`\n                                  readJSON c `ap`\n                                  readJSON d\n\n  readJSON _ = mkError \"Unable to read 4 tuple\"\n\n-- -----------------------------------------------------------------\n-- List-like types\n\n\ninstance JSON a => JSON [a] where\n  showJSON = showJSONs\n  readJSON = readJSONs\n\n-- container types:\n\ninstance (Ord a, JSON a, JSON b) => JSON (M.Map a b) where\n#if !defined(MAP_AS_DICT)\n  showJSON = encJSArray M.toList\n  readJSON = decJSArray \"Map\" M.fromList\n#else\n  showJSON = encJSDict M.toList\n   -- backwards compatibility..\n  readJSON a@JSArray{}  = M.fromList <$> readJSON a\n  readJSON o = decJSDict \"Map\" M.fromList o\n#endif\n\ninstance (JSON a) => JSON (IntMap.IntMap a) where\n#if !defined(MAP_AS_DICT)\n  showJSON = encJSArray IntMap.toList\n  readJSON = decJSArray \"IntMap\" IntMap.fromList\n#else\n{- alternate (dict) mapping: -}\n  showJSON = encJSDict IntMap.toList\n  readJSON = decJSDict \"IntMap\" IntMap.fromList\n#endif\n\ninstance (Ord a, JSON a) => JSON (Set.Set a) where\n  showJSON = encJSArray Set.toList\n  readJSON = decJSArray \"Set\" Set.fromList\n\ninstance (Array.Ix i, JSON i, JSON e) => JSON (Array.Array i e) where\n  showJSON = encJSArray Array.assocs\n  readJSON = decJSArray \"Array\" arrayFromList\n\ninstance JSON I.IntSet where\n  showJSON = encJSArray I.toList\n  readJSON = decJSArray \"IntSet\" I.fromList\n\n-- helper functions for array / object serializers:\narrayFromList :: (Array.Ix i) => [(i,e)] -> Array.Array i e\narrayFromList [] = Array.array undefined []\narrayFromList ls@((i,_):xs) = Array.array bnds ls\n       where\n        bnds = \n\t foldr (\\ (ix,_) (mi,ma) ->\n\t         let\n\t\t  mi1 = min ix mi\n\t\t  ma1 = max ix ma\n\t\t in\n\t\t mi1 `seq` ma1 `seq` (mi1,ma1))\n\t       (i,i)\n\t       xs\n\n-- -----------------------------------------------------------------\n-- ByteStrings\n\ninstance JSON S.ByteString where\n  showJSON = encJSString S.unpack\n  readJSON = decJSString \"ByteString\" (return . S.pack)\n\ninstance JSON L.ByteString where\n  showJSON = encJSString L.unpack\n  readJSON = decJSString \"Lazy.ByteString\" (return . L.pack)\n\n-- -----------------------------------------------------------------\n-- Instance Helpers\n\nmakeObj :: [(String, JSValue)] -> JSValue\nmakeObj = JSObject . toJSObject\n\n-- | Pull a value out of a JSON object.\nvalFromObj :: JSON a => String -> JSObject JSValue -> Result a\nvalFromObj k o = maybe (Error $ \"valFromObj: Could not find key: \" ++ show k)\n                       readJSON\n\t\t       (lookup k (fromJSObject o))\n\nencJSString :: (a -> String) -> a -> JSValue\nencJSString f v = JSString (toJSString (f v))\n\ndecJSString :: String -> (String -> Result a) -> JSValue -> Result a\ndecJSString _ f (JSString s) = f (fromJSString s)\ndecJSString l _ _ = mkError (\"readJSON{\"++l++\"}: unable to parse string value\")\n\nencJSArray :: (JSON a) => (b-> [a]) -> b -> JSValue\nencJSArray f v = showJSON (f v)\n\ndecJSArray :: (JSON a) => String -> ([a] -> b) -> JSValue -> Result b\ndecJSArray _ f a@JSArray{} = f <$> readJSON a\ndecJSArray l _ _ = mkError (\"readJSON{\"++l++\"}: unable to parse array value\")\n\n#if defined(MAP_AS_DICT)\nencJSDict :: (JSON a, JSON b) => (c -> [(a,b)]) -> c -> JSValue\nencJSDict f v = makeObj $ \n  map (\\ (x,y) -> (showJSValue (showJSON x) \"\", showJSON y)) (f v)\n\ndecJSDict :: (JSON a, JSON b)\n          => String\n\t  -> ([(a,b)] -> c)\n\t  -> JSValue\n\t  -> Result c\ndecJSDict _ f (JSObject o) = mapM rd (fromJSObject o) >>= return . f\n   where\n     rd (a,b) = do\n       pa <- decode a\n       pb <- readJSON b\n       return (pa,pb)\ndecJSDict l _ _ = mkError (\"readJSON{\"++l ++ \"}: unable to read dict; expected JSON object\")\n#endif\n\n","file":"/home/mathijs/workspace/json/Text/JSON.hs"}}
<== {"version":"0.1","id":10,"result":{"Left":"Could not find file in module graph."}}
==> {"id":11,"method":"background-typecheck-file","params":{"file":"/home/mathijs/workspace/json/Text/JSON.hs"}}
<== {"version":"0.1","id":11,"result":{"Left":"Could not find file in module graph."}}
==> {"id":12,"method":"list-cabal-components","params":{"cabal-file":"/home/mathijs/workspace/json/json.cabal"}}
<== {"version":"0.1","id":12,"result":[{"library":null,"cabal-file":"/home/mathijs/workspace/json/json.cabal"}]}
==> {"id":13,"method":"load","params":{"component":{"library":null,"cabal-file":"/home/mathijs/workspace/json/json.cabal"},"output":true}}
<== {"version":"0.1","id":13,"result":{"succeeded":true,"notes":[],"duration":5.2e-5}}
==> {"id":14,"method":"background-typecheck-file","params":{"file":"/home/mathijs/workspace/json/Text/JSON.hs"}}
<== {"version":"0.1","id":14,"result":{"Left":"Could not find file in module graph."}}
==> {"id":15,"method":"background-typecheck-arbitrary","params":{"contents":"{-# OPTIONS_GHC -XCPP -XMultiParamTypeClasses -XTypeSynonymInstances #-}\n--------------------------------------------------------------------\n-- |\n-- Module    : Text.JSON\n-- Copyright : (c) Galois, Inc. 2007-2009\n-- License   : BSD3\n--\n-- Maintainer:  Sigbjorn Finne <[email protected]>\n-- Stability :  provisional\n-- Portability: portable\n--\n--------------------------------------------------------------------\n--\n-- Serialising Haskell values to and from JSON values.\n--\n\nmodule Text.JSON (\n    -- * JSON Types\n    JSValue(..)\n\n    -- * Serialization to and from JSValues\n  , JSON(..)\n\n    -- * Encoding and Decoding\n  , Result(..)\n  , encode -- :: JSON a => a -> String\n  , decode -- :: JSON a => String -> Either String a\n  , encodeStrict -- :: JSON a => a -> String\n  , decodeStrict -- :: JSON a => String -> Either String a\n\n    -- * Wrapper Types\n  , JSString\n  , toJSString\n  , fromJSString\n\n  , JSObject\n  , toJSObject\n  , fromJSObject\n  , resultToEither\n\n    -- * Serialization to and from Strings.\n    -- ** Reading JSON\n  , readJSNull, readJSBool, readJSString, readJSRational\n  , readJSArray, readJSObject, readJSValue\n\n    -- ** Writing JSON\n  , showJSNull, showJSBool, showJSArray\n  , showJSRational, showJSRational'\n  , showJSObject, showJSValue\n\n    -- ** Instance helpers\n  , makeObj, valFromObj\n  \n  ) where\n\nimport Text.JSON.Types\nimport Text.JSON.String\n\nimport Data.List\nimport Data.Int\nimport Data.Word\nimport Data.Either\nimport Control.Monad(liftM,ap,MonadPlus(..))\nimport Control.Applicative\nimport Control.Monad.Error ( MonadError(..) )\n\nimport qualified Data.ByteString.Char8 as S\nimport qualified Data.ByteString.Lazy.Char8 as L\nimport qualified Data.IntSet as I\nimport qualified Data.Set as Set\nimport qualified Data.Map as M\nimport qualified Data.IntMap as IntMap\n\nimport qualified Data.Array as Array\n\n------------------------------------------------------------------------\n\n-- | Decode a String representing a JSON value \n-- (either an object, array, bool, number, null)\n--\n-- This is a superset of JSON, as types other than\n-- Array and Object are allowed at the top level.\n--\ndecode :: (JSON a) => String -> Result a\ndecode s = case runGetJSON readJSValue s of\n             Right a  -> readJSON a\n             Left err -> Error err\n\n-- | Encode a Haskell value into a string, in JSON format.\n--\n-- This is a superset of JSON, as types other than\n-- Array and Object are allowed at the top level.\n--\nencode :: (JSON a) => a -> String\nencode = (flip showJSValue [] . showJSON)\n\n------------------------------------------------------------------------\n\n-- | Decode a String representing a strict JSON value.\n-- This follows the spec, and requires top level\n-- JSON types to be an Array or Object.\ndecodeStrict :: (JSON a) => String -> Result a\ndecodeStrict s = case runGetJSON readJSTopType s of\n     Right a  -> readJSON a\n     Left err -> Error err\n\n-- | Encode a value as a String in strict JSON format.\n-- This follows the spec, and requires all values\n-- at the top level to be wrapped in either an Array or Object.\n-- JSON types to be an Array or Object.\nencodeStrict :: (JSON a) => a -> String\nencodeStrict = (flip showJSTopType [] . showJSON)\n\n------------------------------------------------------------------------\n\n-- | The class of types serialisable to and from JSON\nclass JSON a where\n  readJSON  :: JSValue -> Result a\n  showJSON  :: a -> JSValue\n\n  readJSONs :: JSValue -> Result [a]\n  readJSONs (JSArray as) = mapM readJSON as\n  readJSONs _            = mkError \"Unable to read list\"\n\n  showJSONs :: [a] -> JSValue\n  showJSONs = JSArray . map showJSON\n\n-- | A type for parser results\ndata Result a = Ok a | Error String\n  deriving (Eq,Show)\n\n-- | Map Results to Eithers\nresultToEither :: Result a -> Either String a\nresultToEither (Ok a)    = Right a\nresultToEither (Error s) = Left  s\n\ninstance Functor Result where fmap = liftM\n\ninstance Applicative Result where\n  (<*>) = ap\n  pure  = return\n\ninstance Alternative Result where\n  Ok a    <|> _ = Ok a\n  Error _ <|> b = b\n  empty         = Error \"empty\"\n\ninstance MonadPlus Result where\n  Ok a `mplus` _ = Ok a\n  _ `mplus` x    = x\n  mzero          = Error \"Result: MonadPlus.empty\"\n\ninstance Monad Result where\n  return x      = Ok x\n  fail x        = Error x\n  Ok a >>= f    = f a\n  Error x >>= _ = Error x\n\ninstance MonadError String Result where\n  throwError x = Error x\n\n  catchError (Error e) h = h e\n  catchError x _ = x\n\n-- | Convenient error generation\nmkError :: String -> Result a\nmkError s = Error s\n\n--------------------------------------------------------------------\n--\n-- | To ensure we generate valid JSON, we map Haskell types to JSValue\n-- internally, then pretty print that.\n--\ninstance JSON JSValue where\n    showJSON = id\n    readJSON = return\n\nsecond :: (a -> b) -> (x,a) -> (x,b)\nsecond f (a,b) = (a, f b)\n\n--------------------------------------------------------------------\n-- Some simple JSON wrapper types, to avoid overlapping instances\n\ninstance JSON JSString where\n  readJSON (JSString s) = return s\n  readJSON _            = mkError \"Unable to read JSString\"\n  showJSON = JSString\n\ninstance (JSON a) => JSON (JSObject a) where\n  readJSON (JSObject o) =\n      let f (x,y) = do y' <- readJSON y; return (x,y')\n      in toJSObject `fmap` mapM f (fromJSObject o)\n  readJSON _ = mkError \"Unable to read JSObject\"\n  showJSON = JSObject . toJSObject . map (second showJSON) . fromJSObject\n\n\n-- -----------------------------------------------------------------\n-- Instances\n--\n\ninstance JSON Bool where\n  showJSON = JSBool\n  readJSON (JSBool b) = return b\n  readJSON _          = mkError \"Unable to read Bool\"\n\ninstance JSON Char where\n  showJSON  = JSString . toJSString . (:[])\n  showJSONs = JSString . toJSString\n\n  readJSON (JSString s) = case fromJSString s of\n                            [c] -> return c\n                            _ -> mkError \"Unable to read Char\"\n  readJSON _            = mkError \"Unable to read Char\"\n\n  readJSONs (JSString s)  = return (fromJSString s)\n  readJSONs (JSArray a)   = mapM readJSON a\n  readJSONs _             = mkError \"Unable to read String\"\n\ninstance JSON Ordering where\n  showJSON = encJSString show\n  readJSON = decJSString \"Ordering\" readOrd\n    where\n     readOrd x = \n       case x of\n         \"LT\" -> return Prelude.LT\n\t \"EQ\" -> return Prelude.EQ\n\t \"GT\" -> return Prelude.GT\n\t _    -> mkError (\"Unable to read Ordering\")\n\n-- -----------------------------------------------------------------\n-- Integral types\n\ninstance JSON Integer where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ round i\n  readJSON _             = mkError \"Unable to read Integer\"\n\n-- constrained:\ninstance JSON Int where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ round i\n  readJSON _              = mkError \"Unable to read Int\"\n\n-- constrained:\ninstance JSON Word where\n  showJSON = JSRational False . toRational\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Word\"\n\n-- -----------------------------------------------------------------\n\ninstance JSON Word8 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Word8\"\n\ninstance JSON Word16 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Word16\"\n\ninstance JSON Word32 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Word32\"\n\ninstance JSON Word64 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Word64\"\n\ninstance JSON Int8 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Int8\"\n\ninstance JSON Int16 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Int16\"\n\ninstance JSON Int32 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _             = mkError \"Unable to read Int32\"\n\ninstance JSON Int64 where\n  showJSON = JSRational False . fromIntegral\n  readJSON (JSRational _ i) = return $ truncate i\n  readJSON _                = mkError \"Unable to read Int64\"\n\n-- -----------------------------------------------------------------\n\ninstance JSON Double where\n  showJSON = JSRational False . toRational\n  readJSON (JSRational _ r) = return $ fromRational r\n  readJSON _                = mkError \"Unable to read Double\"\n    -- can't use JSRational here, due to ambiguous '0' parse\n    -- it will parse as Integer.\n\ninstance JSON Float where\n  showJSON = JSRational True . toRational\n  readJSON (JSRational _ r) = return $ fromRational r\n  readJSON _                = mkError \"Unable to read Float\"\n\n-- -----------------------------------------------------------------\n-- Sums\n\ninstance (JSON a) => JSON (Maybe a) where\n  readJSON (JSObject o) = case \"Just\" `lookup` as of\n      Just x -> Just <$> readJSON x\n      _      -> case (\"Nothing\" `lookup` as) of\n          Just JSNull -> return Nothing\n          _           -> mkError \"Unable to read Maybe\"\n    where as = fromJSObject o\n  readJSON _ = mkError \"Unable to read Maybe\"\n  showJSON (Just x) = JSObject $ toJSObject [(\"Just\", showJSON x)]\n  showJSON Nothing  = JSObject $ toJSObject [(\"Nothing\", JSNull)]\n\ninstance (JSON a, JSON b) => JSON (Either a b) where\n  readJSON (JSObject o) = case \"Left\" `lookup` as of\n      Just a  -> Left <$> readJSON a\n      Nothing -> case \"Right\" `lookup` as of\n          Just b  -> Right <$> readJSON b\n          Nothing -> mkError \"Unable to read Either\"\n    where as = fromJSObject o\n  readJSON _ = mkError \"Unable to read Either\"\n  showJSON (Left a)  = JSObject $ toJSObject [(\"Left\",  showJSON a)]\n  showJSON (Right b) = JSObject $ toJSObject [(\"Right\", showJSON b)]\n\n-- -----------------------------------------------------------------\n-- Products\n\ninstance JSON () where\n  showJSON _ = JSArray []\n  readJSON (JSArray []) = return ()\n  readJSON _      = mkError \"Unable to read ()\"\n\ninstance (JSON a, JSON b) => JSON (a,b) where\n  showJSON (a,b) = JSArray [ showJSON a, showJSON b ]\n  readJSON (JSArray [a,b]) = (,) `fmap` readJSON a `ap` readJSON b\n  readJSON _ = mkError \"Unable to read Pair\"\n\ninstance (JSON a, JSON b, JSON c) => JSON (a,b,c) where\n  showJSON (a,b,c) = JSArray [ showJSON a, showJSON b, showJSON c ]\n  readJSON (JSArray [a,b,c]) = (,,) `fmap`\n                                  readJSON a `ap`\n                                  readJSON b `ap`\n                                  readJSON c\n  readJSON _ = mkError \"Unable to read Triple\"\n\ninstance (JSON a, JSON b, JSON c, JSON d) => JSON (a,b,c,d) where\n  showJSON (a,b,c,d) = JSArray [showJSON a, showJSON b, showJSON c, showJSON d]\n  readJSON (JSArray [a,b,c,d]) = (,,,) `fmap`\n                                  readJSON a `ap`\n                                  readJSON b `ap`\n                                  readJSON c `ap`\n                                  readJSON d\n\n  readJSON _ = mkError \"Unable to read 4 tuple\"\n\n-- -----------------------------------------------------------------\n-- List-like types\n\n\ninstance JSON a => JSON [a] where\n  showJSON = showJSONs\n  readJSON = readJSONs\n\n-- container types:\n\ninstance (Ord a, JSON a, JSON b) => JSON (M.Map a b) where\n#if !defined(MAP_AS_DICT)\n  showJSON = encJSArray M.toList\n  readJSON = decJSArray \"Map\" M.fromList\n#else\n  showJSON = encJSDict M.toList\n   -- backwards compatibility..\n  readJSON a@JSArray{}  = M.fromList <$> readJSON a\n  readJSON o = decJSDict \"Map\" M.fromList o\n#endif\n\ninstance (JSON a) => JSON (IntMap.IntMap a) where\n#if !defined(MAP_AS_DICT)\n  showJSON = encJSArray IntMap.toList\n  readJSON = decJSArray \"IntMap\" IntMap.fromList\n#else\n{- alternate (dict) mapping: -}\n  showJSON = encJSDict IntMap.toList\n  readJSON = decJSDict \"IntMap\" IntMap.fromList\n#endif\n\ninstance (Ord a, JSON a) => JSON (Set.Set a) where\n  showJSON = encJSArray Set.toList\n  readJSON = decJSArray \"Set\" Set.fromList\n\ninstance (Array.Ix i, JSON i, JSON e) => JSON (Array.Array i e) where\n  showJSON = encJSArray Array.assocs\n  readJSON = decJSArray \"Array\" arrayFromList\n\ninstance JSON I.IntSet where\n  showJSON = encJSArray I.toList\n  readJSON = decJSArray \"IntSet\" I.fromList\n\n-- helper functions for array / object serializers:\narrayFromList :: (Array.Ix i) => [(i,e)] -> Array.Array i e\narrayFromList [] = Array.array undefined []\narrayFromList ls@((i,_):xs) = Array.array bnds ls\n       where\n        bnds = \n\t foldr (\\ (ix,_) (mi,ma) ->\n\t         let\n\t\t  mi1 = min ix mi\n\t\t  ma1 = max ix ma\n\t\t in\n\t\t mi1 `seq` ma1 `seq` (mi1,ma1))\n\t       (i,i)\n\t       xs\n\n-- -----------------------------------------------------------------\n-- ByteStrings\n\ninstance JSON S.ByteString where\n  showJSON = encJSString S.unpack\n  readJSON = decJSString \"ByteString\" (return . S.pack)\n\ninstance JSON L.ByteString where\n  showJSON = encJSString L.unpack\n  readJSON = decJSString \"Lazy.ByteString\" (return . L.pack)\n\n-- -----------------------------------------------------------------\n-- Instance Helpers\n\nmakeObj :: [(String, JSValue)] -> JSValue\nmakeObj = JSObject . toJSObject\n\n-- | Pull a value out of a JSON object.\nvalFromObj :: JSON a => String -> JSObject JSValue -> Result a\nvalFromObj k o = maybe (Error $ \"valFromObj: Could not find key: \" ++ show k)\n                       readJSON\n\t\t       (lookup k (fromJSObject o))\n\nencJSString :: (a -> String) -> a -> JSValue\nencJSString f v = JSString (toJSString (f v))\n\ndecJSString :: String -> (String -> Result a) -> JSValue -> Result a\ndecJSString _ f (JSString s) = f (fromJSString s)\ndecJSString l _ _ = mkError (\"readJSON{\"++l++\"}: unable to parse string value\")\n\nencJSArray :: (JSON a) => (b-> [a]) -> b -> JSValue\nencJSArray f v = showJSON (f v)\n\ndecJSArray :: (JSON a) => String -> ([a] -> b) -> JSValue -> Result b\ndecJSArray _ f a@JSArray{} = f <$> readJSON a\ndecJSArray l _ _ = mkError (\"readJSON{\"++l++\"}: unable to parse array value\")\n\n#if defined(MAP_AS_DICT)\nencJSDict :: (JSON a, JSON b) => (c -> [(a,b)]) -> c -> JSValue\nencJSDict f v = makeObj $ \n  map (\\ (x,y) -> (showJSValue (showJSON x) \"\", showJSON y)) (f v)\n\ndecJSDict :: (JSON a, JSON b)\n          => String\n\t  -> ([(a,b)] -> c)\n\t  -> JSValue\n\t  -> Result c\ndecJSDict _ f (JSObject o) = mapM rd (fromJSObject o) >>= return . f\n   where\n     rd (a,b) = do\n       pa <- decode a\n       pb <- readJSON b\n       return (pa,pb)\ndecJSDict l _ _ = mkError (\"readJSON{\"++l ++ \"}: unable to read dict; expected JSON object\")\n#endif\n\n","file":"/home/mathijs/workspace/json/Text/JSON.hs"}}
<== {"version":"0.1","id":15,"result":{"Left":"Could not find file in module graph."}}