hjson 1.2 → 1.3

raw patch · 2 files changed

+172/−56 lines, 2 filesdep −safePVP ok

version bump matches the API change (PVP)

Dependencies removed: safe

API changes (from Hackage documentation)

Files

• Text/HJson.hs +170/−54
• hjson.cabal +2/−2

@@ -1,21 +1,46 @@-{-# LANGUAGE FlexibleInstances,OverlappingInstances,TypeSynonymInstances #-}--module Text.HJson (Json(..), Jsonable(..), fromString, toString, escapeJString) where+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE DeriveDataTypeable   #-}+module Text.HJson (+	  -- * JSON data type+	  Json(..)+	, fromString+	, toString+	, escapeJString+	, jsonParser+	  -- * Type class for objects [de]serialization+	, Jsonable(..)+	, List(..)+	, Object(..)+	, LaxObject(..)+	) where +import Control.Applicative+import Control.Monad import Data.Char import Data.List-import qualified Data.Map as Map+import qualified Data.Foldable    as F+import qualified Data.Traversable as T+import qualified Data.Map         as Map+import qualified Data.IntMap      as IntMap+import qualified Data.Set         as Set+import qualified Data.IntSet      as IntSet+import qualified Data.Sequence    as Seq import Data.Maybe import Data.Ratio-import Safe-import Text.ParserCombinators.Parsec+import Data.Typeable+import Data.Data+import Text.Parsec      hiding (many, (<|>))+import Text.Parsec.Prim        (ParsecT)  data Json = JString String 	| JNumber Rational 	| JObject (Map.Map String Json) 	| JBool Bool 	| JNull-	| JArray [Json] deriving (Eq, Show)+	| JArray [Json]+	deriving (Eq, Show, Data, Typeable)  -- | Renders JSON to String toString :: Json -> String@@ -29,34 +54,58 @@ toString (JArray vs) = "[" ++ (intercalate ", " $ map (toString) vs) ++ "]"  -- | Parses JSON string-fromString :: String -> Either String Json-fromString s = either (Left . show) (Right) $ parse valueP "user input" s+fromString :: String -> Either ParseError Json+fromString s = parse valueP "user input" s  -- | Escapes string for inclusion in JSON escapeJString :: String -> String-escapeJString = concat . map (escapeJChar)+escapeJString = concatMap escapeJChar ++----------------------------------------------------------------+-- Serialization+----------------------------------------------------------------+ -- | Class of types that can be converted to or from JSON class Jsonable a where+	-- | Convert value to JSON representation 	toJson :: a -> Json+	-- | Deserialize value. Returns Nothing in case of failure. Default+	--   implementation always returns Nothing 	fromJson :: Json -> Maybe a 	fromJson = const Nothing +-- | Newtype wrapper for list. It's user to avoid overlapping+--   instances for string+newtype List a = List { asList :: [a] } deriving (Show, Eq, Ord)++-- | Newtype wrapper for Map String a. Similarly it's used to avoid+--   overlapping instances for more generic Map a b instance.+--+--   Jsonable instance for this type require that every JSON value in+--   map should be properly decoded.+newtype Object a = Object { asMap :: Map.Map String a } deriving (Show, Eq)++-- | Another wrapper for Map String a. It have different 'Jsonable'+--   instance. Undecodable values in 'JObject' are ignored.+newtype LaxObject a = LaxObject { asLaxMap :: Map.Map String a } deriving (Show, Eq)+ -- Simple, but useful instance Jsonable Json where-	toJson = id-	fromJson _ = Nothing+	toJson   = id+	fromJson = Just+-- Numeric types instance Jsonable Bool where 	toJson b = JBool b 	fromJson (JBool b) = Just b 	fromJson _ = Nothing instance Jsonable Integer where- 	toJson = jsonifyIntegral- 	fromJson (JNumber i) = Just $ round i+	toJson = jsonifyIntegral+	fromJson (JNumber i) = Just $ round i 	fromJson _ = Nothing instance Jsonable Int where- 	toJson = jsonifyIntegral- 	fromJson (JNumber i) = Just $ round i+	toJson = jsonifyIntegral+	fromJson (JNumber i) = Just $ round i 	fromJson _ = Nothing instance Jsonable Double where 	toJson = jsonifyRealFrac@@ -66,21 +115,87 @@ 	toJson = jsonifyRealFrac 	fromJson (JNumber i) = Just $ fromRational i 	fromJson _ = Nothing+-- Other types instance Jsonable String where 	toJson = JString 	fromJson (JString s) = Just s 	fromJson _ = Nothing-instance (Jsonable a) => Jsonable (Map.Map String a) where- 	toJson = JObject . Map.mapWithKey (\_ v -> (toJson v))- 	fromJson (JObject m) = Just $ Map.fromList $ catMaybes $ map (\(k, v) -> maybe (Nothing) (\jv -> Just (k, jv)) (fromJson v)) $ Map.toList m- 	fromJson _ = Nothing+instance Jsonable a => Jsonable (Maybe a) where+	toJson (Just a)      = JObject $ Map.singleton "just" (toJson a)+	toJson Nothing       = JNull+	fromJson (JNull)     = Just Nothing+	fromJson (JObject m) = do+		guard $ Map.size m == 1+		Just <$> (fromJson =<< Map.lookup "just" m)+	fromJson _ = Nothing+instance (Jsonable a, Jsonable b) => Jsonable (Either a b) where+	toJson (Left  a) = JObject $ Map.singleton "left"  (toJson a)+	toJson (Right a) = JObject $ Map.singleton "right" (toJson a)+	fromJson (JObject m) = case Map.toList m of+		[("left",  j)] -> Left  <$> fromJson j+		[("right", j)] -> Right <$> fromJson j+		_              -> Nothing+	fromJson _ = Nothing +-- tuples+instance (Jsonable a, Jsonable b) => Jsonable (a,b) where+	toJson   (a,b)          = JArray [toJson a, toJson b]+	fromJson (JArray [a,b]) = (,) <$> fromJson a <*> fromJson b+	fromJson _ = Nothing+instance (Jsonable a, Jsonable b, Jsonable c) => Jsonable (a,b,c) where+	toJson   (a,b,c)          = JArray [toJson a, toJson b, toJson c]+	fromJson (JArray [a,b,c]) = (,,) <$> fromJson a <*> fromJson b <*> fromJson c+	fromJson _ = Nothing+instance (Jsonable a, Jsonable b, Jsonable c, Jsonable d) => Jsonable (a,b,c,d) where+	toJson   (a,b,c,d)          = JArray [toJson a, toJson b, toJson c, toJson d]+	fromJson (JArray [a,b,c,d]) = (,,,) <$> fromJson a <*> fromJson b <*> fromJson c <*> fromJson d+	fromJson _ = Nothing+instance (Jsonable a, Jsonable b, Jsonable c, Jsonable d, Jsonable e) => Jsonable (a,b,c,d,e) where+	toJson   (a,b,c,d,e)          = JArray [toJson a, toJson b, toJson c, toJson d, toJson e]+	fromJson (JArray [a,b,c,d,e]) = (,,,,) <$> fromJson a <*> fromJson b <*> fromJson c <*> fromJson d <*> fromJson e+	fromJson _ = Nothing++-- Containers+instance (Jsonable a, Ord a, Jsonable b) => Jsonable (Map.Map a b) where+	toJson     = JArray . map toJson . Map.toList+	fromJson j = Map.fromList . asList <$> fromJson j+instance Jsonable a => Jsonable (IntMap.IntMap a) where+	toJson     = JArray . map toJson . IntMap.toList+	fromJson j = IntMap.fromList . asList <$> fromJson j+instance (Jsonable a, Ord a) => Jsonable (Set.Set a) where+	toJson     = JArray . map toJson . Set.toList+	fromJson j = Set.fromList . asList <$> fromJson j+instance Jsonable IntSet.IntSet where+	toJson     = JArray . map toJson . IntSet.toList+	fromJson j = IntSet.fromList . asList <$> fromJson j+instance Jsonable a => Jsonable (Seq.Seq a) where+	toJson     = JArray . map toJson . F.toList+	fromJson j = Seq.fromList . asList <$> fromJson j++-- Newtype wrapped instances+instance Jsonable a => Jsonable (List a) where+	toJson = JArray . map toJson . asList+	fromJson (JArray xs) = List <$> mapM fromJson xs+	fromJson  _          = Nothing+instance (Jsonable a) => Jsonable (Object a) where+	toJson   (Object  m) = JObject $ fmap toJson m+	fromJson (JObject m) = Object <$> T.mapM fromJson m+	fromJson  _          = Nothing+instance (Jsonable a) => Jsonable (LaxObject a) where+	toJson   (LaxObject m) = JObject $ fmap toJson m+	fromJson (JObject m)   = Just $ LaxObject $ Map.mapMaybe fromJson m+	fromJson _             = Nothing+ -- private functions  -- Here I manually did instances' job. You know who to blame for its incompleteness.+jsonifyRealFrac :: RealFrac a => a -> Json jsonifyRealFrac i = JNumber (approxRational i 1e-666)++jsonifyIntegral :: Integral a => a -> Json jsonifyIntegral i = JNumber (fromIntegral i % 1) +escapeJChar :: Char -> [Char] escapeJChar '\n' = "\\n" escapeJChar '\b' = "\\b" escapeJChar '\f' = "\\f"@@ -90,27 +205,28 @@ escapeJChar '"' = "\\\"" escapeJChar c = [c] --- Parser -valueP = do-	spaces-	jsonV <- stringP <|> numberP <|> objectP <|> arrayP <|> boolP <|> nullP-	spaces-	return jsonV+----------------------------------------------------------------+-- JSON parser+---------------------------------------------------------------- -objectP = do-	char '{'-	spaces-	values <- keyValueP `sepBy` commaP-	spaces-	char '}'-	return $ JObject (Map.fromList values)+-- | Parsec parser for JSON+jsonParser :: Monad m => ParsecT String s m Json+jsonParser = valueP -commaP = do-	spaces-	char ','-	spaces+valueP :: Monad m => ParsecT String s m Json+valueP = spaces *> (stringP <|> numberP <|> objectP <|> arrayP <|> boolP <|> nullP) <* spaces +objectP :: Monad m => ParsecT String s m Json+objectP = +	char '{' *> spaces *>+		(JObject . Map.fromList <$> (keyValueP `sepBy` commaP))+	<* spaces <* char '}'++commaP :: Monad m => ParsecT String s m ()+commaP = () <$ spaces >> char ',' >> spaces++keyValueP :: Monad m => ParsecT String s m (String,Json) keyValueP = do 	spaces 	JString keyStringV <- stringP@@ -121,22 +237,20 @@ 	spaces 	return (keyStringV, valueV) -arrayP = do-	char '['-	spaces-	values <- valueP `sepBy` commaP-	spaces-	char ']'-	return $ JArray values+arrayP :: Monad m => ParsecT String s m Json+arrayP = +	char '[' *> spaces *>+		(JArray <$> (valueP `sepBy` commaP))+	<* spaces <* char ']' -stringP = do-	char '"'-	str <- manyTill stringElementP (char '"')-	return $ JString str -stringElementP = do-	escapeSeqP <|> anyChar+stringP :: Monad m => ParsecT String s m Json+stringP = char '"' *> (JString <$> manyTill stringElementP (char '"')) +stringElementP :: Monad m => ParsecT String s m Char+stringElementP = escapeSeqP <|> anyChar++escapeSeqP :: Monad m => ParsecT String s m Char escapeSeqP = do 	char '\\' 	(char '"') <|>@@ -149,13 +263,15 @@ 		('\t' <$ char 't') <|> 		unicodeP +unicodeP :: Monad m => ParsecT String s m Char unicodeP = do 	digitsV <- count 4 hexDigit 	let numberV = read ("0x" ++ digitsV) 	return $ chr numberV +numberP :: Monad m => ParsecT String s m Json numberP = do-	minusV <- optionMaybe (char '-')+	sign    <- (-1 <$ char '-') <|> return 1 	digitsV <- many1 digit 	maybeFractionalV <- optionMaybe (char '.' >> many digit) 	exponentV <- optionMaybe (do@@ -167,15 +283,15 @@ 			Just '-' -> ('-', readDigits) 			otherwise -> ('+', readDigits)) 	let fractionalV = fromMaybe "" maybeFractionalV-	let upV = read (digitsV ++ fractionalV) :: Integer+	let upV = sign * read (digitsV ++ fractionalV) :: Integer 	let downV = 10 ^ genericLength fractionalV 	return $ case exponentV of 		Nothing -> JNumber (upV % downV) 		Just ('-', powr) -> JNumber (upV % (downV * 10 ^ powr)) 		Just (_, powr) -> JNumber ((upV * 10 ^ powr) % downV) +boolP :: Monad m => ParsecT String s m Json boolP = (JBool True <$ string "true") <|> (JBool False <$ string "false") +nullP :: Monad m => ParsecT String u m Json nullP = JNull <$ string "null"--x <$ m = m >> return x

@@ -1,5 +1,5 @@ Name: hjson-Version: 1.2+Version: 1.3 Synopsis: JSON parsing library Category: Text Description: JSON parsing library with simple and sane API@@ -16,4 +16,4 @@  library  Exposed-Modules: Text.HJson, Text.HJson.Pretty- Build-Depends: base >= 4 && < 5, parsec >= 3.0.0, containers, safe+ Build-Depends: base >= 4 && < 5, parsec >= 3.0.0, containers