@@ -6,39 +6,23 @@ module Data.Argonaut.Decode
66 , decodeMaybe
77 ) where
88
9- import Prelude
10-
11- import Data.Argonaut.Core
12- ( Json ()
13- , JNumber ()
14- , JString ()
15- , foldJsonNull
16- , foldJsonBoolean
17- , foldJsonNumber
18- , foldJsonString
19- , foldJsonArray
20- , foldJsonObject
21- , toArray
22- , toNumber
23- , toObject
24- , toString
25- , toBoolean
26- )
9+ import Prelude
10+
11+ import Control.Alt ((<|>))
12+ import Control.Bind ((=<<))
13+ import Data.Argonaut.Core (Json (), foldJsonNull , foldJsonBoolean , foldJsonNumber , foldJsonString , toArray , toNumber , toObject , toString , toBoolean )
2714import Data.Array (zipWithA )
2815import Data.Either (either , Either (..))
16+ import Data.Foldable (find )
17+ import Data.Generic (Generic , GenericSpine (..), GenericSignature (..), Proxy (..), fromSpine , toSignature )
2918import Data.Int (fromNumber )
30- import Data.Maybe (maybe , Maybe (..))
31- import Data.Tuple (Tuple (..))
32- import Data.String
3319import Data.List (List (..), toList )
34- import Control.Alt
35- import Control.Bind ((=<<))
20+ import Data.Map as Map
21+ import Data.Maybe (maybe , Maybe (..))
22+ import Data.String (charAt , toChar )
23+ import Data.StrMap as M
3624import Data.Traversable (traverse , for )
37- import Data.Foldable (find )
38- import Data.Generic
39-
40- import qualified Data.StrMap as M
41- import qualified Data.Map as Map
25+ import Data.Tuple (Tuple (..))
4226
4327class DecodeJson a where
4428 decodeJson :: Json -> Either String a
@@ -51,61 +35,60 @@ gDecodeJson json = maybe (Left "fromSpine failed") Right <<< fromSpine
5135-- | Decode `Json` representation of a `GenericSpine`.
5236gDecodeJson' :: GenericSignature -> Json -> Either String GenericSpine
5337gDecodeJson' signature json = case signature of
54- SigNumber
55- -> SNumber <$> mFail " Expected a number" (toNumber json)
56- SigInt
57- -> SInt <$> mFail " Expected an integer number" (fromNumber =<< toNumber json)
58- SigString
59- -> SString <$> mFail " Expected a string" (toString json)
60- SigBoolean
61- -> SBoolean <$> mFail " Expected a boolean" (toBoolean json)
62- SigArray thunk
63- -> do jArr <- mFail " Expected an array" $ toArray json
64- SArray <$> traverse (map const <<< gDecodeJson' (thunk unit)) jArr
65- SigRecord props
66- -> do jObj <- mFail " Expected an object" $ toObject json
67- SRecord <$> for props \({recLabel: lbl, recValue: val})
68- -> do pf <- mFail (" '" <> lbl <> " ' property missing" ) (M .lookup lbl jObj)
69- sp <- gDecodeJson' (val unit) pf
70- pure { recLabel: lbl, recValue: const sp }
71- SigProd alts
72- -> do jObj <- mFail " Expected an object" $ toObject json
73- tag <- mFail " 'tag' string property is missing" (toString =<< M .lookup " tag" jObj)
74- case find ((tag ==) <<< _.sigConstructor) alts of
75- Nothing -> Left (" '" <> tag <> " ' isn't a valid constructor" )
76- Just { sigValues: sigValues } -> do
77- vals <- mFail " 'values' array is missing" (toArray =<< M .lookup " values" jObj)
78- sps <- zipWithA (\k -> gDecodeJson' (k unit)) sigValues vals
79- pure (SProd tag (const <$> sps))
38+ SigNumber -> SNumber <$> mFail " Expected a number" (toNumber json)
39+ SigInt -> SInt <$> mFail " Expected an integer number" (fromNumber =<< toNumber json)
40+ SigString -> SString <$> mFail " Expected a string" (toString json)
41+ SigChar -> SChar <$> mFail " Expected a char" (toChar =<< toString json)
42+ SigBoolean -> SBoolean <$> mFail " Expected a boolean" (toBoolean json)
43+ SigArray thunk -> do
44+ jArr <- mFail " Expected an array" $ toArray json
45+ SArray <$> traverse (map const <<< gDecodeJson' (thunk unit)) jArr
46+ SigRecord props -> do
47+ jObj <- mFail " Expected an object" $ toObject json
48+ SRecord <$> for props \({recLabel: lbl, recValue: val}) -> do
49+ pf <- mFail (" '" <> lbl <> " ' property missing" ) (M .lookup lbl jObj)
50+ sp <- gDecodeJson' (val unit) pf
51+ pure { recLabel: lbl, recValue: const sp }
52+ SigProd alts -> do
53+ jObj <- mFail " Expected an object" $ toObject json
54+ tag <- mFail " 'tag' string property is missing" (toString =<< M .lookup " tag" jObj)
55+ case find ((tag ==) <<< _.sigConstructor) alts of
56+ Nothing -> Left (" '" <> tag <> " ' isn't a valid constructor" )
57+ Just { sigValues: sigValues } -> do
58+ vals <- mFail " 'values' array is missing" (toArray =<< M .lookup " values" jObj)
59+ sps <- zipWithA (\k -> gDecodeJson' (k unit)) sigValues vals
60+ pure (SProd tag (const <$> sps))
8061 where
81- mFail :: forall a . String -> Maybe a -> Either String a
82- mFail msg = maybe (Left msg) Right
62+ mFail :: forall a . String -> Maybe a -> Either String a
63+ mFail msg = maybe (Left msg) Right
8364
8465instance decodeJsonMaybe :: (DecodeJson a ) => DecodeJson (Maybe a ) where
8566 decodeJson j = (Just <$> decodeJson j) <|> pure Nothing
8667
8768instance decodeJsonTuple :: (DecodeJson a , DecodeJson b ) => DecodeJson (Tuple a b ) where
88- decodeJson j = decodeJson j >>= f where
69+ decodeJson j = decodeJson j >>= f
70+ where
8971 f (Cons a (Cons b Nil )) = Tuple <$> decodeJson a <*> decodeJson b
72+ f _ = Left " Couldn't decode Tuple"
9073
9174instance decodeJsonEither :: (DecodeJson a , DecodeJson b ) => DecodeJson (Either a b ) where
9275 decodeJson j = (Left <$> decodeJson j) <|> (Right <$> decodeJson j)
9376
9477instance decodeJsonNull :: DecodeJson Unit where
95- decodeJson = foldJsonNull (Left " Not null. " ) (const $ Right unit)
78+ decodeJson = foldJsonNull (Left " Not null" ) (const $ Right unit)
9679
9780instance decodeJsonBoolean :: DecodeJson Boolean where
98- decodeJson = foldJsonBoolean (Left " Not a Boolean. " ) Right
81+ decodeJson = foldJsonBoolean (Left " Not a Boolean" ) Right
9982
10083instance decodeJsonNumber :: DecodeJson Number where
101- decodeJson = foldJsonNumber (Left " Not a Number. " ) Right
84+ decodeJson = foldJsonNumber (Left " Not a Number" ) Right
10285
10386instance decodeJsonInt :: DecodeJson Int where
104- decodeJson num = foldJsonNumber (Left " Not a Number. " ) go num
105- where go num = maybe (Left " Not an Int" ) Right $ fromNumber num
87+ decodeJson num = foldJsonNumber (Left " Not a Number" ) go num
88+ where go num = maybe (Left " Not an Int" ) Right $ fromNumber num
10689
10790instance decodeJsonString :: DecodeJson String where
108- decodeJson = foldJsonString (Left " Not a String. " ) Right
91+ decodeJson = foldJsonString (Left " Not a String" ) Right
10992
11093instance decodeJsonJson :: DecodeJson Json where
11194 decodeJson = Right
@@ -116,17 +99,17 @@ instance decodeJsonChar :: DecodeJson Char where
11699 go (Just c) = Right c
117100
118101instance decodeStrMap :: (DecodeJson a ) => DecodeJson (M.StrMap a ) where
119- decodeJson json = maybe (Left " Couldn't decode. " ) Right $ do
102+ decodeJson json = maybe (Left " Couldn't decode StrMap " ) Right $ do
120103 obj <- toObject json
121104 traverse decodeMaybe obj
122105
123106instance decodeArray :: (DecodeJson a ) => DecodeJson (Array a ) where
124- decodeJson json = maybe (Left " Couldn't decode. " ) Right $ do
107+ decodeJson json = maybe (Left " Couldn't decode Array " ) Right $ do
125108 obj <- toArray json
126109 traverse decodeMaybe obj
127110
128111instance decodeList :: (DecodeJson a ) => DecodeJson (List a ) where
129- decodeJson json = maybe (Left " Couldn't decode. " ) Right $ do
112+ decodeJson json = maybe (Left " Couldn't decode List " ) Right $ do
130113 lst <- toList <$> toArray json
131114 traverse decodeMaybe lst
132115
0 commit comments