Skip to content

Commit 493002f

Browse files
thomashoneymanthomashoneyman
authored
Merge pull request #61 from purescript-contrib/non-empty
Add NonEmptyArray and NonEmptyList instances
2 parents 1dedbad + f9b9831 commit 493002f

File tree

3 files changed

+116
-88
lines changed

3 files changed

+116
-88
lines changed

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

Lines changed: 41 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -4,12 +4,16 @@ import Prelude
44

55
import Data.Argonaut.Core (Json, isNull, caseJsonNull, caseJsonBoolean, caseJsonNumber, caseJsonString, toArray, toObject, toString, stringify)
66
import Data.Array as Arr
7+
import Data.Array.NonEmpty (NonEmptyArray)
8+
import Data.Array.NonEmpty as NEA
79
import Data.Bifunctor (lmap, rmap)
810
import Data.Either (Either(..), note)
911
import Data.Identity (Identity(..))
1012
import Data.Int (fromNumber)
1113
import Data.List (List(..), (:), fromFoldable)
1214
import Data.List as L
15+
import Data.List.NonEmpty (NonEmptyList)
16+
import Data.List.NonEmpty as NEL
1317
import Data.Map as M
1418
import Data.Maybe (maybe, Maybe(..))
1519
import Data.NonEmpty (NonEmpty, (:|))
@@ -63,49 +67,59 @@ instance decodeJsonNumber :: DecodeJson Number where
6367
decodeJson = caseJsonNumber (Left "Value is not a Number") Right
6468

6569
instance decodeJsonInt :: DecodeJson Int where
66-
decodeJson
67-
= maybe (Left "Value is not an integer") Right
68-
<<< fromNumber
69-
<=< decodeJson
70+
decodeJson =
71+
maybe (Left "Value is not an integer") Right
72+
<<< fromNumber
73+
<=< decodeJson
7074

7175
instance decodeJsonString :: DecodeJson String where
7276
decodeJson = caseJsonString (Left "Value is not a String") Right
7377

7478
instance decodeJsonJson :: DecodeJson Json where
7579
decodeJson = Right
7680

77-
instance decodeJsonNonEmptyArray :: (DecodeJson a) => DecodeJson (NonEmpty Array a) where
78-
decodeJson
79-
= lmap ("Couldn't decode NonEmpty Array: " <> _)
80-
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< Arr.uncons) <=< decodeJArray)
81+
instance decodeJsonNonEmpty_Array :: (DecodeJson a) => DecodeJson (NonEmpty Array a) where
82+
decodeJson =
83+
lmap ("Couldn't decode NonEmpty Array: " <> _)
84+
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< Arr.uncons) <=< decodeJArray)
8185

82-
instance decodeJsonNonEmptyList :: (DecodeJson a) => DecodeJson (NonEmpty List a) where
83-
decodeJson
84-
= lmap ("Couldn't decode NonEmpty List: " <> _)
85-
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< L.uncons) <=< map (map fromFoldable) decodeJArray)
86+
instance decodeJsonNonEmptyArray :: (DecodeJson a) => DecodeJson (NonEmptyArray a) where
87+
decodeJson =
88+
lmap ("Couldn't decode NonEmptyArray: " <> _)
89+
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> NEA.cons' x.head x.tail) <<< note " is empty" <<< Arr.uncons) <=< decodeJArray)
90+
91+
instance decodeJsonNonEmpty_List :: (DecodeJson a) => DecodeJson (NonEmpty List a) where
92+
decodeJson =
93+
lmap ("Couldn't decode NonEmpty List: " <> _)
94+
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< L.uncons) <=< map (map fromFoldable) decodeJArray)
95+
96+
instance decodeJsonNonEmptyList :: (DecodeJson a) => DecodeJson (NonEmptyList a) where
97+
decodeJson =
98+
lmap ("Couldn't decode NonEmptyList: " <> _)
99+
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> NEL.cons' x.head x.tail) <<< note " is empty" <<< L.uncons) <=< map (map fromFoldable) decodeJArray)
86100

87101
instance decodeJsonChar :: DecodeJson CodePoint where
88102
decodeJson j =
89103
maybe (Left $ "Expected character but found: " <> stringify j) Right
90104
=<< codePointAt 0 <$> decodeJson j
91105

92106
instance decodeForeignObject :: DecodeJson a => DecodeJson (FO.Object a) where
93-
decodeJson
94-
= lmap ("Couldn't decode ForeignObject: " <> _)
95-
<<< (traverse decodeJson <=< decodeJObject)
107+
decodeJson =
108+
lmap ("Couldn't decode ForeignObject: " <> _)
109+
<<< (traverse decodeJson <=< decodeJObject)
96110

97111
instance decodeArray :: DecodeJson a => DecodeJson (Array a) where
98-
decodeJson
99-
= lmap ("Couldn't decode Array (" <> _)
100-
<<< (traverseWithIndex f <=< decodeJArray)
112+
decodeJson =
113+
lmap ("Couldn't decode Array (" <> _)
114+
<<< (traverseWithIndex f <=< decodeJArray)
101115
where
102-
msg i m = "Failed at index " <> show i <> "): " <> m
103-
f i = lmap (msg i) <<< decodeJson
116+
msg i m = "Failed at index " <> show i <> "): " <> m
117+
f i = lmap (msg i) <<< decodeJson
104118

105119
instance decodeList :: DecodeJson a => DecodeJson (List a) where
106-
decodeJson
107-
= lmap ("Couldn't decode List: " <> _)
108-
<<< (traverse decodeJson <=< map (map fromFoldable) decodeJArray)
120+
decodeJson =
121+
lmap ("Couldn't decode List: " <> _)
122+
<<< (traverse decodeJson <=< map (map fromFoldable) decodeJArray)
109123

110124
instance decodeSet :: (Ord a, DecodeJson a) => DecodeJson (S.Set a) where
111125
decodeJson = map (S.fromFoldable :: List a -> S.Set a) <<< decodeJson
@@ -127,7 +141,6 @@ instance decodeRecord
127141
, RL.RowToList row list
128142
)
129143
=> DecodeJson (Record row) where
130-
131144
decodeJson json =
132145
case toObject json of
133146
Just object -> gDecodeJson object (RLProxy :: RLProxy list)
@@ -147,12 +160,12 @@ instance gDecodeJsonCons
147160
, Row.Lacks field rowTail
148161
)
149162
=> GDecodeJson row (RL.Cons field value tail) where
150-
151163
gDecodeJson object _ = do
152-
let sProxy :: SProxy field
153-
sProxy = SProxy
164+
let
165+
sProxy :: SProxy field
166+
sProxy = SProxy
154167

155-
fieldName = reflectSymbol sProxy
168+
fieldName = reflectSymbol sProxy
156169

157170
rest <- gDecodeJson object (RLProxy :: RLProxy tail)
158171

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

Lines changed: 27 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -4,11 +4,15 @@ import Prelude
44

55
import Data.Argonaut.Core (Json, fromArray, fromBoolean, fromNumber, fromObject, fromString, jsonNull)
66
import Data.Array as Arr
7+
import Data.Array.NonEmpty (NonEmptyArray)
8+
import Data.Array.NonEmpty as NEA
79
import Data.Either (Either, either)
810
import Data.Identity (Identity(..))
911
import Data.Int (toNumber)
1012
import Data.List (List(..), (:), toUnfoldable)
1113
import Data.List as L
14+
import Data.List.NonEmpty as NEL
15+
import Data.List.Types (NonEmptyList)
1216
import Data.Map as M
1317
import Data.Maybe (Maybe(..))
1418
import Data.NonEmpty (NonEmpty(..))
@@ -31,8 +35,9 @@ instance encodeIdentity :: EncodeJson a => EncodeJson (Identity a) where
3135
encodeJson (Identity a) = encodeJson a
3236

3337
instance encodeJsonMaybe :: EncodeJson a => EncodeJson (Maybe a) where
34-
encodeJson Nothing = jsonNull
35-
encodeJson (Just a) = encodeJson a
38+
encodeJson = case _ of
39+
Nothing -> jsonNull
40+
Just a -> encodeJson a
3641

3742
instance encodeJsonTuple :: (EncodeJson a, EncodeJson b) => EncodeJson (Tuple a b) where
3843
encodeJson (Tuple a b) = encodeJson [encodeJson a, encodeJson b]
@@ -42,8 +47,9 @@ instance encodeJsonEither :: (EncodeJson a, EncodeJson b) => EncodeJson (Either
4247
where
4348
obj :: forall c. EncodeJson c => String -> c -> Json
4449
obj tag x =
45-
fromObject $ FO.fromFoldable $
46-
Tuple "tag" (fromString tag) : Tuple "value" (encodeJson x) : Nil
50+
fromObject
51+
$ FO.fromFoldable
52+
$ Tuple "tag" (fromString tag) : Tuple "value" (encodeJson x) : Nil
4753

4854
instance encodeJsonUnit :: EncodeJson Unit where
4955
encodeJson = const jsonNull
@@ -66,17 +72,23 @@ instance encodeJsonJson :: EncodeJson Json where
6672
instance encodeJsonCodePoint :: EncodeJson CodePoint where
6773
encodeJson = encodeJson <<< CP.singleton
6874

69-
instance encodeJsonNonEmptyArray :: (EncodeJson a) => EncodeJson (NonEmpty Array a) where
70-
encodeJson (NonEmpty h t) = encodeJson $ Arr.cons h t
75+
instance encodeJsonNonEmpty_Array :: (EncodeJson a) => EncodeJson (NonEmpty Array a) where
76+
encodeJson (NonEmpty h t) = encodeJson (Arr.cons h t)
7177

72-
instance encodeJsonNonEmptyList :: (EncodeJson a) => EncodeJson (NonEmpty List a) where
73-
encodeJson (NonEmpty h t) = encodeJson $ L.insertAt 0 h t
78+
instance encodeJsonNonEmptyArray :: (EncodeJson a) => EncodeJson (NonEmptyArray a) where
79+
encodeJson = encodeJson <<< NEA.toArray
80+
81+
instance encodeJsonNonEmpty_List :: (EncodeJson a) => EncodeJson (NonEmpty List a) where
82+
encodeJson (NonEmpty h t) = encodeJson (L.insertAt 0 h t)
83+
84+
instance encodeJsonNonEmptyList :: (EncodeJson a) => EncodeJson (NonEmptyList a) where
85+
encodeJson = encodeJson <<< NEL.toList
7486

7587
instance encodeJsonChar :: EncodeJson Char where
7688
encodeJson = encodeJson <<< CU.singleton
7789

7890
instance encodeJsonArray :: EncodeJson a => EncodeJson (Array a) where
79-
encodeJson json = fromArray (encodeJson <$> json)
91+
encodeJson = fromArray <<< map encodeJson
8092

8193
instance encodeJsonList :: EncodeJson a => EncodeJson (List a) where
8294
encodeJson = fromArray <<< map encodeJson <<< toUnfoldable
@@ -98,7 +110,6 @@ instance encodeRecord
98110
, RL.RowToList row list
99111
)
100112
=> EncodeJson (Record row) where
101-
102113
encodeJson rec = fromObject $ gEncodeJson rec (RLProxy :: RLProxy list)
103114

104115
class GEncodeJson (row :: # Type) (list :: RL.RowList) where
@@ -114,13 +125,9 @@ instance gEncodeJsonCons
114125
, Row.Cons field value tail' row
115126
)
116127
=> GEncodeJson row (RL.Cons field value tail) where
117-
118-
gEncodeJson row _ =
119-
let
120-
sProxy :: SProxy field
121-
sProxy = SProxy
122-
in
123-
FO.insert
124-
(reflectSymbol sProxy)
125-
(encodeJson $ Record.get sProxy row)
126-
(gEncodeJson row (RLProxy :: RLProxy tail))
128+
gEncodeJson row _ = do
129+
let sProxy = SProxy :: SProxy field
130+
FO.insert
131+
(reflectSymbol sProxy)
132+
(encodeJson $ Record.get sProxy row)
133+
(gEncodeJson row (RLProxy :: RLProxy tail))

0 commit comments

Comments
 (0)