Skip to content

Commit 2ad2147

Browse files
author
Serhii Khoma
authored
decoder implementation that is not dependent on class -> move implementation to Implementation module (#74)
* feat: decoder implementation that is not dependent on class -> move implementation to Implementation module * feat: encoder implementation that is not dependent on class -> move implementation to Implementation module * refactor: review notes -> rename Implementation to Decoders/Encoders * refactor: review notes -> encodeJsonXXX to encodeXXX, remove encodeJson function as it is done for decoders * feat: review notes -> remove Decoder/Encoder types
1 parent fdd873c commit 2ad2147

File tree

9 files changed

+364
-180
lines changed

9 files changed

+364
-180
lines changed

‎src/Data/Argonaut/Decode.purs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,4 +4,4 @@ module Data.Argonaut.Decode
44
) where
55

66
import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson)
7-
import Data.Argonaut.Decode.Combinators ( getField, getFieldDeprecated, getFieldOptional, getFieldOptionalDeprecated, getFieldOptional', defaultField, defaultFieldDeprecated, (.:), (.?), (.:!), (.:?), (.??), (.!=), (.?=))
7+
import Data.Argonaut.Decode.Combinators (getField, getFieldDeprecated, getFieldOptional, getFieldOptionalDeprecated, getFieldOptional', defaultField, defaultFieldDeprecated, (.:), (.?), (.:!), (.:?), (.??), (.!=), (.?=))

‎src/Data/Argonaut/Decode/Class.purs

Lines changed: 31 additions & 87 deletions
Original file line numberDiff line numberDiff line change
@@ -1,142 +1,92 @@
11
module Data.Argonaut.Decode.Class where
22

3-
import Prelude
3+
import Prelude (class Ord, Unit, Void, bind, ($), (<<<), (<>))
44

5-
import Control.Apply (lift2)
6-
import Data.Argonaut.Core (Json, isNull, caseJsonNull, caseJsonBoolean, caseJsonNumber, caseJsonString, toArray, toObject, toString, stringify)
7-
import Data.Array as Arr
5+
import Data.Argonaut.Core (Json, toObject)
86
import Data.Array.NonEmpty (NonEmptyArray)
9-
import Data.Array.NonEmpty as NEA
10-
import Data.Bifunctor (lmap, rmap)
11-
import Data.Either (Either(..), note)
12-
import Data.Identity (Identity(..))
13-
import Data.Int (fromNumber)
14-
import Data.List (List, fromFoldable)
15-
import Data.List as L
7+
import Data.Either (Either(..))
8+
import Data.Identity (Identity)
9+
import Data.List (List)
1610
import Data.List.NonEmpty (NonEmptyList)
17-
import Data.List.NonEmpty as NEL
1811
import Data.Map as M
19-
import Data.Maybe (maybe, Maybe(..))
20-
import Data.NonEmpty (NonEmpty, (:|))
12+
import Data.Maybe (Maybe(..))
13+
import Data.NonEmpty (NonEmpty)
2114
import Data.Set as S
22-
import Data.String (CodePoint, codePointAt)
15+
import Data.String (CodePoint)
2316
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
24-
import Data.Traversable (traverse)
25-
import Data.TraversableWithIndex (traverseWithIndex)
26-
import Data.Tuple (Tuple(..))
17+
import Data.Tuple (Tuple)
2718
import Foreign.Object as FO
2819
import Prim.Row as Row
2920
import Prim.RowList as RL
3021
import Record as Record
3122
import Type.Data.RowList (RLProxy(..))
23+
import Data.Argonaut.Decode.Decoders
3224

3325
class DecodeJson a where
3426
decodeJson :: Json -> Either String a
3527

3628
instance decodeIdentity :: DecodeJson a => DecodeJson (Identity a) where
37-
decodeJson j = Identity <$> decodeJson j
29+
decodeJson = decodeIdentity decodeJson
3830

3931
instance decodeJsonMaybe :: DecodeJson a => DecodeJson (Maybe a) where
40-
decodeJson j
41-
| isNull j = pure Nothing
42-
| otherwise = Just <$> decodeJson j
32+
decodeJson = decodeMaybe decodeJson
4333

4434
instance decodeJsonTuple :: (DecodeJson a, DecodeJson b) => DecodeJson (Tuple a b) where
45-
decodeJson j = do
46-
decoded <- decodeJson j
47-
case decoded of
48-
[a, b] -> lift2 Tuple (decodeJson a) (decodeJson b)
49-
_ -> Left "Couldn't decode Tuple"
35+
decodeJson = decodeTuple decodeJson decodeJson
5036

5137
instance decodeJsonEither :: (DecodeJson a, DecodeJson b) => DecodeJson (Either a b) where
52-
decodeJson json =
53-
lmap ("Couldn't decode Either: " <> _) $
54-
decodeJObject json >>= \obj -> do
55-
tag <- maybe (Left "Expected field 'tag'") Right $ FO.lookup "tag" obj
56-
val <- maybe (Left "Expected field 'value'") Right $ FO.lookup "value" obj
57-
case toString tag of
58-
Just "Right" -> Right <$> decodeJson val
59-
Just "Left" -> Left <$> decodeJson val
60-
_ -> Left "'tag' field was not \"Left\" or \"Right\""
38+
decodeJson = decodeEither decodeJson decodeJson
6139

6240
instance decodeJsonNull :: DecodeJson Unit where
63-
decodeJson = caseJsonNull (Left "Value is not a null") (const $ Right unit)
41+
decodeJson = decodeNull
6442

6543
instance decodeJsonBoolean :: DecodeJson Boolean where
66-
decodeJson = caseJsonBoolean (Left "Value is not a Boolean") Right
44+
decodeJson = decodeBoolean
6745

6846
instance decodeJsonNumber :: DecodeJson Number where
69-
decodeJson = caseJsonNumber (Left "Value is not a Number") Right
47+
decodeJson = decodeNumber
7048

7149
instance decodeJsonInt :: DecodeJson Int where
72-
decodeJson =
73-
maybe (Left "Value is not an integer") Right
74-
<<< fromNumber
75-
<=< decodeJson
50+
decodeJson = decodeInt
7651

7752
instance decodeJsonString :: DecodeJson String where
78-
decodeJson = caseJsonString (Left "Value is not a String") Right
53+
decodeJson = decodeString
7954

8055
instance decodeJsonJson :: DecodeJson Json where
8156
decodeJson = Right
8257

8358
instance decodeJsonNonEmpty_Array :: (DecodeJson a) => DecodeJson (NonEmpty Array a) where
84-
decodeJson =
85-
lmap ("Couldn't decode NonEmpty Array: " <> _)
86-
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< Arr.uncons) <=< decodeJArray)
59+
decodeJson = decodeNonEmpty_Array decodeJson
8760

8861
instance decodeJsonNonEmptyArray :: (DecodeJson a) => DecodeJson (NonEmptyArray a) where
89-
decodeJson =
90-
lmap ("Couldn't decode NonEmptyArray: " <> _)
91-
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> NEA.cons' x.head x.tail) <<< note " is empty" <<< Arr.uncons) <=< decodeJArray)
62+
decodeJson = decodeNonEmptyArray decodeJson
9263

9364
instance decodeJsonNonEmpty_List :: (DecodeJson a) => DecodeJson (NonEmpty List a) where
94-
decodeJson =
95-
lmap ("Couldn't decode NonEmpty List: " <> _)
96-
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< L.uncons) <=< map (map fromFoldable) decodeJArray)
65+
decodeJson = decodeNonEmpty_List decodeJson
9766

9867
instance decodeJsonNonEmptyList :: (DecodeJson a) => DecodeJson (NonEmptyList a) where
99-
decodeJson =
100-
lmap ("Couldn't decode NonEmptyList: " <> _)
101-
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> NEL.cons' x.head x.tail) <<< note " is empty" <<< L.uncons) <=< map (map fromFoldable) decodeJArray)
68+
decodeJson = decodeNonEmptyList decodeJson
10269

103-
instance decodeJsonChar :: DecodeJson CodePoint where
104-
decodeJson j =
105-
maybe (Left $ "Expected character but found: " <> stringify j) Right
106-
=<< codePointAt 0 <$> decodeJson j
70+
instance decodeJsonCodePoint :: DecodeJson CodePoint where
71+
decodeJson = decodeCodePoint
10772

10873
instance decodeForeignObject :: DecodeJson a => DecodeJson (FO.Object a) where
109-
decodeJson =
110-
lmap ("Couldn't decode ForeignObject: " <> _)
111-
<<< (traverse decodeJson <=< decodeJObject)
74+
decodeJson = decodeForeignObject decodeJson
11275

11376
instance decodeArray :: DecodeJson a => DecodeJson (Array a) where
114-
decodeJson =
115-
lmap ("Couldn't decode Array (" <> _)
116-
<<< (traverseWithIndex f <=< decodeJArray)
117-
where
118-
msg i m = "Failed at index " <> show i <> "): " <> m
119-
f i = lmap (msg i) <<< decodeJson
77+
decodeJson = decodeArray decodeJson
12078

12179
instance decodeList :: DecodeJson a => DecodeJson (List a) where
122-
decodeJson =
123-
lmap ("Couldn't decode List: " <> _)
124-
<<< (traverse decodeJson <=< map (map fromFoldable) decodeJArray)
80+
decodeJson = decodeList decodeJson
12581

12682
instance decodeSet :: (Ord a, DecodeJson a) => DecodeJson (S.Set a) where
127-
decodeJson = map (S.fromFoldable :: List a -> S.Set a) <<< decodeJson
83+
decodeJson = decodeSet decodeJson
12884

12985
instance decodeMap :: (Ord a, DecodeJson a, DecodeJson b) => DecodeJson (M.Map a b) where
130-
decodeJson = map (M.fromFoldable :: List (Tuple a b) -> M.Map a b) <<< decodeJson
86+
decodeJson = decodeMap decodeJson decodeJson
13187

13288
instance decodeVoid :: DecodeJson Void where
133-
decodeJson _ = Left "Value cannot be Void"
134-
135-
decodeJArray :: Json -> Either String (Array Json)
136-
decodeJArray = maybe (Left "Value is not an Array") Right <<< toArray
137-
138-
decodeJObject :: Json -> Either String (FO.Object Json)
139-
decodeJObject = maybe (Left "Value is not an Object") Right <<< toObject
89+
decodeJson = decodeVoid
14090

14191
instance decodeRecord
14292
:: ( GDecodeJson row list
@@ -178,9 +128,3 @@ instance gDecodeJsonCons
178128

179129
Nothing ->
180130
Left $ "JSON was missing expected field: " <> fieldName
181-
182-
elaborateFailure :: ∀ a. String -> Either String a -> Either String a
183-
elaborateFailure s e =
184-
lmap msg e
185-
where
186-
msg m = "Failed to decode key '" <> s <> "': " <> m

‎src/Data/Argonaut/Decode/Combinators.purs

Lines changed: 10 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -15,25 +15,22 @@ module Data.Argonaut.Decode.Combinators
1515
, (.?=)
1616
) where
1717

18-
import Prelude
18+
import Prelude ((<$>))
1919

20-
import Data.Argonaut.Core (Json, isNull)
21-
import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson, elaborateFailure)
22-
import Data.Either (Either(..))
23-
import Data.Maybe (Maybe(..), fromMaybe, maybe)
20+
import Data.Argonaut.Core (Json)
21+
import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson)
22+
import Data.Either (Either)
23+
import Data.Maybe (Maybe, fromMaybe)
2424
import Foreign.Object as FO
2525
import Prim.TypeError (class Warn, Text)
26+
import Data.Argonaut.Decode.Decoders as Decoders
2627

2728
-- | Attempt to get the value for a given key on an `Object Json`.
2829
-- |
2930
-- | Use this accessor if the key and value *must* be present in your object.
3031
-- | If the key and value are optional, use `getFieldOptional'` (`.:?`) instead.
3132
getField :: forall a. DecodeJson a => FO.Object Json -> String -> Either String a
32-
getField o s =
33-
maybe
34-
(Left $ "Expected field " <> show s)
35-
(elaborateFailure s <<< decodeJson)
36-
(FO.lookup s o)
33+
getField = Decoders.getField decodeJson
3734

3835
infix 7 getField as .:
3936

@@ -55,16 +52,7 @@ infix 7 getFieldDeprecated as .?
5552
-- | Use this accessor if the key and value are optional in your object.
5653
-- | If the key and value are mandatory, use `getField` (`.:`) instead.
5754
getFieldOptional' :: forall a. DecodeJson a => FO.Object Json -> String -> Either String (Maybe a)
58-
getFieldOptional' o s =
59-
maybe
60-
(pure Nothing)
61-
decode
62-
(FO.lookup s o)
63-
where
64-
decode json =
65-
if isNull json
66-
then pure Nothing
67-
else Just <$> (elaborateFailure s <<< decodeJson) json
55+
getFieldOptional' = Decoders.getFieldOptional' decodeJson
6856

6957
infix 7 getFieldOptional' as .:?
7058

@@ -77,13 +65,7 @@ infix 7 getFieldOptional' as .:?
7765
-- | If you would like to treat `null` values the same as absent values, use
7866
-- | `getFieldOptional'` (`.:?`) instead.
7967
getFieldOptional :: forall a. DecodeJson a => FO.Object Json -> String -> Either String (Maybe a)
80-
getFieldOptional o s =
81-
maybe
82-
(pure Nothing)
83-
decode
84-
(FO.lookup s o)
85-
where
86-
decode json = Just <$> (elaborateFailure s <<< decodeJson) json
68+
getFieldOptional = Decoders.getFieldOptional decodeJson
8769

8870
infix 7 getFieldOptional as .:!
8971

@@ -93,7 +75,7 @@ getFieldOptionalDeprecated
9375
=> FO.Object Json
9476
-> String
9577
-> Either String (Maybe a)
96-
getFieldOptionalDeprecated = getFieldOptional
78+
getFieldOptionalDeprecated = Decoders.getFieldOptional decodeJson
9779

9880
infix 7 getFieldOptionalDeprecated as .??
9981

0 commit comments

Comments
 (0)