From c1e92783da2bba171a67a71712f82c514e8b3865 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Wed, 4 Nov 2015 23:45:19 +0000 Subject: [PATCH] Fix warnings --- src/Data/Argonaut/Combinators.purs | 16 +--- src/Data/Argonaut/Decode.purs | 115 ++++++++++++----------------- src/Data/Argonaut/Encode.purs | 45 ++++------- 3 files changed, 68 insertions(+), 108 deletions(-) diff --git a/src/Data/Argonaut/Combinators.purs b/src/Data/Argonaut/Combinators.purs index 2a0ba3d..2bb9d5e 100644 --- a/src/Data/Argonaut/Combinators.purs +++ b/src/Data/Argonaut/Combinators.purs @@ -7,22 +7,14 @@ module Data.Argonaut.Combinators import Prelude -import Data.Argonaut.Core - ( foldJsonObject - , fromObject - , jsonSingletonObject - , Json() - , JAssoc() - , JObject() - ) -import Data.Argonaut.Encode (encodeJson, EncodeJson) +import Data.Argonaut.Core (foldJsonObject, fromObject, jsonSingletonObject, Json(), JAssoc(), JObject()) import Data.Argonaut.Decode (DecodeJson, decodeJson) +import Data.Argonaut.Encode (encodeJson, EncodeJson) import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe) +import Data.StrMap as M import Data.Tuple (Tuple(..)) -import qualified Data.StrMap as M - infix 7 := infix 7 .? infixr 6 ~> @@ -34,7 +26,7 @@ infixl 1 ?>>= (~>) :: forall a. (EncodeJson a) => JAssoc -> a -> Json (~>) (Tuple k v) a = foldJsonObject (jsonSingletonObject k v) (M.insert k v >>> fromObject) (encodeJson a) -(?>>=) :: forall a b. Maybe a -> String -> Either String a +(?>>=) :: forall a. Maybe a -> String -> Either String a (?>>=) (Just x) _ = Right x (?>>=) _ str = Left $ "Couldn't decode " ++ str diff --git a/src/Data/Argonaut/Decode.purs b/src/Data/Argonaut/Decode.purs index 20f3a6d..8d58b3e 100644 --- a/src/Data/Argonaut/Decode.purs +++ b/src/Data/Argonaut/Decode.purs @@ -6,39 +6,23 @@ module Data.Argonaut.Decode , decodeMaybe ) where -import Prelude - -import Data.Argonaut.Core - ( Json() - , JNumber() - , JString() - , foldJsonNull - , foldJsonBoolean - , foldJsonNumber - , foldJsonString - , foldJsonArray - , foldJsonObject - , toArray - , toNumber - , toObject - , toString - , toBoolean - ) +import Prelude + +import Control.Alt ((<|>)) +import Control.Bind ((=<<)) +import Data.Argonaut.Core (Json(), foldJsonNull, foldJsonBoolean, foldJsonNumber, foldJsonString, toArray, toNumber, toObject, toString, toBoolean) import Data.Array (zipWithA) import Data.Either (either, Either(..)) +import Data.Foldable (find) +import Data.Generic (Generic, GenericSpine(..), GenericSignature(..), Proxy(..), fromSpine, toSignature) import Data.Int (fromNumber) -import Data.Maybe (maybe, Maybe(..)) -import Data.Tuple (Tuple(..)) -import Data.String import Data.List (List(..), toList) -import Control.Alt -import Control.Bind ((=<<)) +import Data.Map as Map +import Data.Maybe (maybe, Maybe(..)) +import Data.String (charAt, toChar) +import Data.StrMap as M import Data.Traversable (traverse, for) -import Data.Foldable (find) -import Data.Generic - -import qualified Data.StrMap as M -import qualified Data.Map as Map +import Data.Tuple (Tuple(..)) class DecodeJson a where decodeJson :: Json -> Either String a @@ -51,61 +35,60 @@ gDecodeJson json = maybe (Left "fromSpine failed") Right <<< fromSpine -- | Decode `Json` representation of a `GenericSpine`. gDecodeJson' :: GenericSignature -> Json -> Either String GenericSpine gDecodeJson' signature json = case signature of - SigNumber - -> SNumber <$> mFail "Expected a number" (toNumber json) - SigInt - -> SInt <$> mFail "Expected an integer number" (fromNumber =<< toNumber json) - SigString - -> SString <$> mFail "Expected a string" (toString json) - SigBoolean - -> SBoolean <$> mFail "Expected a boolean" (toBoolean json) - SigArray thunk - -> do jArr <- mFail "Expected an array" $ toArray json - SArray <$> traverse (map const <<< gDecodeJson' (thunk unit)) jArr - SigRecord props - -> do jObj <- mFail "Expected an object" $ toObject json - SRecord <$> for props \({recLabel: lbl, recValue: val}) - -> do pf <- mFail ("'" <> lbl <> "' property missing") (M.lookup lbl jObj) - sp <- gDecodeJson' (val unit) pf - pure { recLabel: lbl, recValue: const sp } - SigProd alts - -> do jObj <- mFail "Expected an object" $ toObject json - tag <- mFail "'tag' string property is missing" (toString =<< M.lookup "tag" jObj) - case find ((tag ==) <<< _.sigConstructor) alts of - Nothing -> Left ("'" <> tag <> "' isn't a valid constructor") - Just { sigValues: sigValues } -> do - vals <- mFail "'values' array is missing" (toArray =<< M.lookup "values" jObj) - sps <- zipWithA (\k -> gDecodeJson' (k unit)) sigValues vals - pure (SProd tag (const <$> sps)) + SigNumber -> SNumber <$> mFail "Expected a number" (toNumber json) + SigInt -> SInt <$> mFail "Expected an integer number" (fromNumber =<< toNumber json) + SigString -> SString <$> mFail "Expected a string" (toString json) + SigChar -> SChar <$> mFail "Expected a char" (toChar =<< toString json) + SigBoolean -> SBoolean <$> mFail "Expected a boolean" (toBoolean json) + SigArray thunk -> do + jArr <- mFail "Expected an array" $ toArray json + SArray <$> traverse (map const <<< gDecodeJson' (thunk unit)) jArr + SigRecord props -> do + jObj <- mFail "Expected an object" $ toObject json + SRecord <$> for props \({recLabel: lbl, recValue: val}) -> do + pf <- mFail ("'" <> lbl <> "' property missing") (M.lookup lbl jObj) + sp <- gDecodeJson' (val unit) pf + pure { recLabel: lbl, recValue: const sp } + SigProd alts -> do + jObj <- mFail "Expected an object" $ toObject json + tag <- mFail "'tag' string property is missing" (toString =<< M.lookup "tag" jObj) + case find ((tag ==) <<< _.sigConstructor) alts of + Nothing -> Left ("'" <> tag <> "' isn't a valid constructor") + Just { sigValues: sigValues } -> do + vals <- mFail "'values' array is missing" (toArray =<< M.lookup "values" jObj) + sps <- zipWithA (\k -> gDecodeJson' (k unit)) sigValues vals + pure (SProd tag (const <$> sps)) where - mFail :: forall a. String -> Maybe a -> Either String a - mFail msg = maybe (Left msg) Right + mFail :: forall a. String -> Maybe a -> Either String a + mFail msg = maybe (Left msg) Right instance decodeJsonMaybe :: (DecodeJson a) => DecodeJson (Maybe a) where decodeJson j = (Just <$> decodeJson j) <|> pure Nothing instance decodeJsonTuple :: (DecodeJson a, DecodeJson b) => DecodeJson (Tuple a b) where - decodeJson j = decodeJson j >>= f where + decodeJson j = decodeJson j >>= f + where f (Cons a (Cons b Nil)) = Tuple <$> decodeJson a <*> decodeJson b + f _ = Left "Couldn't decode Tuple" instance decodeJsonEither :: (DecodeJson a, DecodeJson b) => DecodeJson (Either a b) where decodeJson j = (Left <$> decodeJson j) <|> (Right <$> decodeJson j) instance decodeJsonNull :: DecodeJson Unit where - decodeJson = foldJsonNull (Left "Not null.") (const $ Right unit) + decodeJson = foldJsonNull (Left "Not null") (const $ Right unit) instance decodeJsonBoolean :: DecodeJson Boolean where - decodeJson = foldJsonBoolean (Left "Not a Boolean.") Right + decodeJson = foldJsonBoolean (Left "Not a Boolean") Right instance decodeJsonNumber :: DecodeJson Number where - decodeJson = foldJsonNumber (Left "Not a Number.") Right + decodeJson = foldJsonNumber (Left "Not a Number") Right instance decodeJsonInt :: DecodeJson Int where - decodeJson num = foldJsonNumber (Left "Not a Number.") go num - where go num = maybe (Left "Not an Int") Right $ fromNumber num + decodeJson num = foldJsonNumber (Left "Not a Number") go num + where go num = maybe (Left "Not an Int") Right $ fromNumber num instance decodeJsonString :: DecodeJson String where - decodeJson = foldJsonString (Left "Not a String.") Right + decodeJson = foldJsonString (Left "Not a String") Right instance decodeJsonJson :: DecodeJson Json where decodeJson = Right @@ -116,17 +99,17 @@ instance decodeJsonChar :: DecodeJson Char where go (Just c) = Right c instance decodeStrMap :: (DecodeJson a) => DecodeJson (M.StrMap a) where - decodeJson json = maybe (Left "Couldn't decode.") Right $ do + decodeJson json = maybe (Left "Couldn't decode StrMap") Right $ do obj <- toObject json traverse decodeMaybe obj instance decodeArray :: (DecodeJson a) => DecodeJson (Array a) where - decodeJson json = maybe (Left "Couldn't decode.") Right $ do + decodeJson json = maybe (Left "Couldn't decode Array") Right $ do obj <- toArray json traverse decodeMaybe obj instance decodeList :: (DecodeJson a) => DecodeJson (List a) where - decodeJson json = maybe (Left "Couldn't decode.") Right $ do + decodeJson json = maybe (Left "Couldn't decode List") Right $ do lst <- toList <$> toArray json traverse decodeMaybe lst diff --git a/src/Data/Argonaut/Encode.purs b/src/Data/Argonaut/Encode.purs index 1f1dd22..f6ea394 100644 --- a/src/Data/Argonaut/Encode.purs +++ b/src/Data/Argonaut/Encode.purs @@ -1,38 +1,23 @@ module Data.Argonaut.Encode - ( EncodeJson - , encodeJson - , gEncodeJson - , gEncodeJson' - ) where + ( EncodeJson + , encodeJson + , gEncodeJson + , gEncodeJson' + ) where import Prelude -import Data.Argonaut.Core - ( Json() - , foldJsonObject - , jsonNull - , fromNull - , fromBoolean - , fromNumber - , fromString - , fromArray - , fromObject - , jsonEmptyArray - , jsonEmptyObject - , jsonSingletonObject - ) -import Data.String (fromChar) -import Data.Maybe -import Data.Either -import Data.List (List(..), fromList, toList) +import Data.Argonaut.Core (Json(), jsonNull, fromBoolean, fromNumber, fromString, fromArray, fromObject) +import Data.Either (Either(..)) +import Data.Foldable (foldr) +import Data.Generic (Generic, GenericSpine(..), toSpine) import Data.Int (toNumber) -import Data.Unfoldable () -import Data.Foldable (foldMap, foldr) +import Data.List (List(..), fromList) +import Data.Map as M +import Data.Maybe (Maybe(..)) +import Data.String (fromChar) +import Data.StrMap as SM import Data.Tuple (Tuple(..)) -import Data.Generic - -import qualified Data.StrMap as SM -import qualified Data.Map as M class EncodeJson a where encodeJson :: a -> Json @@ -46,6 +31,7 @@ gEncodeJson' :: GenericSpine -> Json gEncodeJson' spine = case spine of SInt x -> fromNumber $ toNumber x SString x -> fromString x + SChar x -> fromString $ fromChar x SNumber x -> fromNumber x SBoolean x -> fromBoolean x SArray thunks -> fromArray (gEncodeJson' <<< (unit #) <$> thunks) @@ -102,4 +88,3 @@ instance encodeStrMap :: (EncodeJson a) => EncodeJson (SM.StrMap a) where instance encodeMap :: (Ord a, EncodeJson a, EncodeJson b) => EncodeJson (M.Map a b) where encodeJson = encodeJson <<< M.toList -