|
1 | 1 | module Data.Argonaut.Decode.Class where
|
2 | 2 |
|
3 |
| -import Prelude |
| 3 | +import Prelude (class Ord, Unit, Void, bind, ($), (<<<), (<>)) |
4 | 4 |
|
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) |
8 | 6 | 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) |
16 | 10 | import Data.List.NonEmpty (NonEmptyList)
|
17 |
| -import Data.List.NonEmpty as NEL |
18 | 11 | 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) |
21 | 14 | import Data.Set as S
|
22 |
| -import Data.String (CodePoint, codePointAt) |
| 15 | +import Data.String (CodePoint) |
23 | 16 | 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) |
27 | 18 | import Foreign.Object as FO
|
28 | 19 | import Prim.Row as Row
|
29 | 20 | import Prim.RowList as RL
|
30 | 21 | import Record as Record
|
31 | 22 | import Type.Data.RowList (RLProxy(..))
|
| 23 | +import Data.Argonaut.Decode.Decoders |
32 | 24 |
|
33 | 25 | class DecodeJson a where
|
34 | 26 | decodeJson :: Json -> Either String a
|
35 | 27 |
|
36 | 28 | instance decodeIdentity :: DecodeJson a => DecodeJson (Identity a) where
|
37 |
| - decodeJson j = Identity <$> decodeJson j |
| 29 | + decodeJson = decodeIdentity decodeJson |
38 | 30 |
|
39 | 31 | 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 |
43 | 33 |
|
44 | 34 | 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 |
50 | 36 |
|
51 | 37 | 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 |
61 | 39 |
|
62 | 40 | instance decodeJsonNull :: DecodeJson Unit where
|
63 |
| - decodeJson = caseJsonNull (Left "Value is not a null") (const $ Right unit) |
| 41 | + decodeJson = decodeNull |
64 | 42 |
|
65 | 43 | instance decodeJsonBoolean :: DecodeJson Boolean where
|
66 |
| - decodeJson = caseJsonBoolean (Left "Value is not a Boolean") Right |
| 44 | + decodeJson = decodeBoolean |
67 | 45 |
|
68 | 46 | instance decodeJsonNumber :: DecodeJson Number where
|
69 |
| - decodeJson = caseJsonNumber (Left "Value is not a Number") Right |
| 47 | + decodeJson = decodeNumber |
70 | 48 |
|
71 | 49 | instance decodeJsonInt :: DecodeJson Int where
|
72 |
| - decodeJson = |
73 |
| - maybe (Left "Value is not an integer") Right |
74 |
| - <<< fromNumber |
75 |
| - <=< decodeJson |
| 50 | + decodeJson = decodeInt |
76 | 51 |
|
77 | 52 | instance decodeJsonString :: DecodeJson String where
|
78 |
| - decodeJson = caseJsonString (Left "Value is not a String") Right |
| 53 | + decodeJson = decodeString |
79 | 54 |
|
80 | 55 | instance decodeJsonJson :: DecodeJson Json where
|
81 | 56 | decodeJson = Right
|
82 | 57 |
|
83 | 58 | 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 |
87 | 60 |
|
88 | 61 | 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 |
92 | 63 |
|
93 | 64 | 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 |
97 | 66 |
|
98 | 67 | 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 |
102 | 69 |
|
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 |
107 | 72 |
|
108 | 73 | 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 |
112 | 75 |
|
113 | 76 | 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 |
120 | 78 |
|
121 | 79 | 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 |
125 | 81 |
|
126 | 82 | 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 |
128 | 84 |
|
129 | 85 | 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 |
131 | 87 |
|
132 | 88 | 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 |
140 | 90 |
|
141 | 91 | instance decodeRecord
|
142 | 92 | :: ( GDecodeJson row list
|
@@ -178,9 +128,3 @@ instance gDecodeJsonCons
|
178 | 128 |
|
179 | 129 | Nothing ->
|
180 | 130 | 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 |
0 commit comments