Skip to content

Add NonEmptyArray and NonEmptyList instances #61

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Aug 28, 2019
Merged

Add NonEmptyArray and NonEmptyList instances #61

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
69 changes: 41 additions & 28 deletions src/Data/Argonaut/Decode/Class.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,12 +4,16 @@ import Prelude

import Data.Argonaut.Core (Json, isNull, caseJsonNull, caseJsonBoolean, caseJsonNumber, caseJsonString, toArray, toObject, toString, stringify)
import Data.Array as Arr
import Data.Array.NonEmpty (NonEmptyArray)
import Data.Array.NonEmpty as NEA
import Data.Bifunctor (lmap, rmap)
import Data.Either (Either(..), note)
import Data.Identity (Identity(..))
import Data.Int (fromNumber)
import Data.List (List(..), (:), fromFoldable)
import Data.List as L
import Data.List.NonEmpty (NonEmptyList)
import Data.List.NonEmpty as NEL
import Data.Map as M
import Data.Maybe (maybe, Maybe(..))
import Data.NonEmpty (NonEmpty, (:|))
Expand Down Expand Up @@ -63,49 +67,59 @@ instance decodeJsonNumber :: DecodeJson Number where
decodeJson = caseJsonNumber (Left "Value is not a Number") Right

instance decodeJsonInt :: DecodeJson Int where
decodeJson
= maybe (Left "Value is not an integer") Right
<<< fromNumber
<=< decodeJson
decodeJson =
maybe (Left "Value is not an integer") Right
<<< fromNumber
<=< decodeJson

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

instance decodeJsonJson :: DecodeJson Json where
decodeJson = Right

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

instance decodeJsonNonEmptyList :: (DecodeJson a) => DecodeJson (NonEmpty List a) where
decodeJson
= lmap ("Couldn't decode NonEmpty List: " <> _)
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< L.uncons) <=< map (map fromFoldable) decodeJArray)
instance decodeJsonNonEmptyArray :: (DecodeJson a) => DecodeJson (NonEmptyArray a) where
decodeJson =
lmap ("Couldn't decode NonEmptyArray: " <> _)
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> NEA.cons' x.head x.tail) <<< note " is empty" <<< Arr.uncons) <=< decodeJArray)

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

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

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

instance decodeForeignObject :: DecodeJson a => DecodeJson (FO.Object a) where
decodeJson
= lmap ("Couldn't decode ForeignObject: " <> _)
<<< (traverse decodeJson <=< decodeJObject)
decodeJson =
lmap ("Couldn't decode ForeignObject: " <> _)
<<< (traverse decodeJson <=< decodeJObject)

instance decodeArray :: DecodeJson a => DecodeJson (Array a) where
decodeJson
= lmap ("Couldn't decode Array (" <> _)
<<< (traverseWithIndex f <=< decodeJArray)
decodeJson =
lmap ("Couldn't decode Array (" <> _)
<<< (traverseWithIndex f <=< decodeJArray)
where
msg i m = "Failed at index " <> show i <> "): " <> m
f i = lmap (msg i) <<< decodeJson
msg i m = "Failed at index " <> show i <> "): " <> m
f i = lmap (msg i) <<< decodeJson

instance decodeList :: DecodeJson a => DecodeJson (List a) where
decodeJson
= lmap ("Couldn't decode List: " <> _)
<<< (traverse decodeJson <=< map (map fromFoldable) decodeJArray)
decodeJson =
lmap ("Couldn't decode List: " <> _)
<<< (traverse decodeJson <=< map (map fromFoldable) decodeJArray)

instance decodeSet :: (Ord a, DecodeJson a) => DecodeJson (S.Set a) where
decodeJson = map (S.fromFoldable :: List a -> S.Set a) <<< decodeJson
Expand All @@ -127,7 +141,6 @@ instance decodeRecord
, RL.RowToList row list
)
=> DecodeJson (Record row) where

decodeJson json =
case toObject json of
Just object -> gDecodeJson object (RLProxy :: RLProxy list)
Expand All @@ -147,12 +160,12 @@ instance gDecodeJsonCons
, Row.Lacks field rowTail
)
=> GDecodeJson row (RL.Cons field value tail) where

gDecodeJson object _ = do
let sProxy :: SProxy field
sProxy = SProxy
let
sProxy :: SProxy field
sProxy = SProxy

fieldName = reflectSymbol sProxy
fieldName = reflectSymbol sProxy

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

Expand Down
47 changes: 27 additions & 20 deletions src/Data/Argonaut/Encode/Class.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,11 +4,15 @@ import Prelude

import Data.Argonaut.Core (Json, fromArray, fromBoolean, fromNumber, fromObject, fromString, jsonNull)
import Data.Array as Arr
import Data.Array.NonEmpty (NonEmptyArray)
import Data.Array.NonEmpty as NEA
import Data.Either (Either, either)
import Data.Identity (Identity(..))
import Data.Int (toNumber)
import Data.List (List(..), (:), toUnfoldable)
import Data.List as L
import Data.List.NonEmpty as NEL
import Data.List.Types (NonEmptyList)
import Data.Map as M
import Data.Maybe (Maybe(..))
import Data.NonEmpty (NonEmpty(..))
Expand All @@ -31,8 +35,9 @@ instance encodeIdentity :: EncodeJson a => EncodeJson (Identity a) where
encodeJson (Identity a) = encodeJson a

instance encodeJsonMaybe :: EncodeJson a => EncodeJson (Maybe a) where
encodeJson Nothing = jsonNull
encodeJson (Just a) = encodeJson a
encodeJson = case _ of
Nothing -> jsonNull
Just a -> encodeJson a

instance encodeJsonTuple :: (EncodeJson a, EncodeJson b) => EncodeJson (Tuple a b) where
encodeJson (Tuple a b) = encodeJson [encodeJson a, encodeJson b]
Expand All @@ -42,8 +47,9 @@ instance encodeJsonEither :: (EncodeJson a, EncodeJson b) => EncodeJson (Either
where
obj :: forall c. EncodeJson c => String -> c -> Json
obj tag x =
fromObject $ FO.fromFoldable $
Tuple "tag" (fromString tag) : Tuple "value" (encodeJson x) : Nil
fromObject
$ FO.fromFoldable
$ Tuple "tag" (fromString tag) : Tuple "value" (encodeJson x) : Nil

instance encodeJsonUnit :: EncodeJson Unit where
encodeJson = const jsonNull
Expand All @@ -66,17 +72,23 @@ instance encodeJsonJson :: EncodeJson Json where
instance encodeJsonCodePoint :: EncodeJson CodePoint where
encodeJson = encodeJson <<< CP.singleton

instance encodeJsonNonEmptyArray :: (EncodeJson a) => EncodeJson (NonEmpty Array a) where
encodeJson (NonEmpty h t) = encodeJson $ Arr.cons h t
instance encodeJsonNonEmpty_Array :: (EncodeJson a) => EncodeJson (NonEmpty Array a) where
encodeJson (NonEmpty h t) = encodeJson (Arr.cons h t)

instance encodeJsonNonEmptyList :: (EncodeJson a) => EncodeJson (NonEmpty List a) where
encodeJson (NonEmpty h t) = encodeJson $ L.insertAt 0 h t
instance encodeJsonNonEmptyArray :: (EncodeJson a) => EncodeJson (NonEmptyArray a) where
encodeJson = encodeJson <<< NEA.toArray

instance encodeJsonNonEmpty_List :: (EncodeJson a) => EncodeJson (NonEmpty List a) where
encodeJson (NonEmpty h t) = encodeJson (L.insertAt 0 h t)

instance encodeJsonNonEmptyList :: (EncodeJson a) => EncodeJson (NonEmptyList a) where
encodeJson = encodeJson <<< NEL.toList

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

instance encodeJsonArray :: EncodeJson a => EncodeJson (Array a) where
encodeJson json = fromArray (encodeJson <$> json)
encodeJson = fromArray <<< map encodeJson

instance encodeJsonList :: EncodeJson a => EncodeJson (List a) where
encodeJson = fromArray <<< map encodeJson <<< toUnfoldable
Expand All @@ -98,7 +110,6 @@ instance encodeRecord
, RL.RowToList row list
)
=> EncodeJson (Record row) where

encodeJson rec = fromObject $ gEncodeJson rec (RLProxy :: RLProxy list)

class GEncodeJson (row :: # Type) (list :: RL.RowList) where
Expand All @@ -114,13 +125,9 @@ instance gEncodeJsonCons
, Row.Cons field value tail' row
)
=> GEncodeJson row (RL.Cons field value tail) where

gEncodeJson row _ =
let
sProxy :: SProxy field
sProxy = SProxy
in
FO.insert
(reflectSymbol sProxy)
(encodeJson $ Record.get sProxy row)
(gEncodeJson row (RLProxy :: RLProxy tail))
gEncodeJson row _ = do
let sProxy = SProxy :: SProxy field
FO.insert
(reflectSymbol sProxy)
(encodeJson $ Record.get sProxy row)
(gEncodeJson row (RLProxy :: RLProxy tail))
Loading