Added encode/decode instances for NonEmpty Array and NonEmpty List.

Author: dgendill

src/Data/Argonaut/Decode/Class.purs

@@ -6,7 +6,10 @@ module Data.Argonaut.Decode.Class
   ) where
 
 import Prelude
-
+import Data.Array as Arr
+import Data.Map as M
+import Data.StrMap as SM
+import Control.Alternative (class Plus)
 import Data.Argonaut.Core (Json, JArray, JObject, isNull, foldJsonNull, foldJsonBoolean, foldJsonNumber, foldJsonString, toArray, toNumber, toObject, toString, toBoolean)
 import Data.Array (zipWithA)
 import Data.Bifunctor (lmap)
@@ -15,13 +18,12 @@ import Data.Foldable (find)
 import Data.Generic (class Generic, GenericSpine(..), GenericSignature(..), fromSpine, toSignature)
 import Data.Int (fromNumber)
 import Data.List (List(..), (:), fromFoldable)
-import Data.Map as M
+import Data.List as L
 import Data.Maybe (maybe, Maybe(..))
+import Data.NonEmpty (NonEmpty, singleton, (:|))
 import Data.String (charAt, toChar)
-import Data.StrMap as SM
 import Data.Traversable (traverse, for)
 import Data.Tuple (Tuple(..))
-
 import Type.Proxy (Proxy(..))
 
 class DecodeJson a where
@@ -110,6 +112,23 @@ instance decodeJsonString :: DecodeJson String where
 instance decodeJsonJson :: DecodeJson Json where
   decodeJson = Right
 
+
+toNonEmpty :: forall a f. (Plus f) => ({ head :: f a -> Maybe a, tail :: f a -> Maybe (f a) }) -> (f a) -> Either String (NonEmpty f a)
+toNonEmpty i a = case (Tuple (i.head a) (i.tail a)) of
+  (Tuple Nothing _) -> Left "is empty."
+  (Tuple (Just h) Nothing) -> Right $ singleton h
+  (Tuple (Just h) (Just t)) -> Right $ h :| t
+
+instance decodeJsonNonEmptyArray :: (DecodeJson a) => DecodeJson (NonEmpty Array a) where
+  decodeJson
+    = lmap ("Couldn't decode Array: " <> _)
+    <<< (traverse decodeJson <=< (toNonEmpty { head : Arr.head, tail : Arr.tail } ) <=< decodeJArray)
+
+instance decodeJsonNonEmptyList :: (DecodeJson a) => DecodeJson (NonEmpty List a) where
+  decodeJson
+    = lmap ("Couldn't decode NonEmpty List: " <> _)
+    <<< (traverse decodeJson <=< (lmap ("List" <> _) <<< toNonEmpty { head : L.head, tail : L.tail }) <=< map (map fromFoldable) decodeJArray)
+
 instance decodeJsonChar :: DecodeJson Char where
   decodeJson j =
     maybe (Left $ "Expected character but found: " <> show j) Right

src/Data/Argonaut/Encode/Class.purs

@@ -1,15 +1,16 @@
 module Data.Argonaut.Encode.Class where
 
 import Prelude
-
 import Data.Argonaut.Core (Json(), jsonNull, fromBoolean, fromNumber, fromString, fromArray, fromObject)
 import Data.Either (Either(), either)
+import Data.Array as Arr
 import Data.Foldable (foldr)
 import Data.Generic (class Generic, GenericSpine(..), toSpine)
 import Data.Int (toNumber)
 import Data.List (List(..), (:), toUnfoldable)
 import Data.Map as M
 import Data.Maybe (Maybe(..))
+import Data.NonEmpty (NonEmpty(..))
 import Data.String (singleton)
 import Data.StrMap as SM
 import Data.Tuple (Tuple(..))
@@ -74,6 +75,12 @@ instance encodeJsonJString :: EncodeJson String where
 instance encodeJsonJson :: EncodeJson Json where
   encodeJson = id
 
+instance encodeJsonNonEmptyArray :: (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 $ Arr.cons h (toUnfoldable t)
+
 instance encodeJsonChar :: EncodeJson Char where
   encodeJson = encodeJson <<< singleton
 

test/Test/Main.purs

@@ -1,9 +1,8 @@
 module Test.Main where
 
 import Prelude
-
+import Data.StrMap as SM
 import Control.Monad.Eff.Console (log, logShow)
-
 import Data.Argonaut.Core (JObject, Json, toObject, fromObject, fromArray, fromString, fromNumber, fromBoolean, jsonNull)
 import Data.Argonaut.Decode (decodeJson)
 import Data.Argonaut.Encode (encodeJson, gEncodeJson, (:=), (~>))
@@ -12,11 +11,11 @@ import Data.Either (Either(..))
 import Data.Foldable (foldl)
 import Data.Function (on)
 import Data.Generic (class Generic)
-import Data.List (fromFoldable)
+import Data.List (List, fromFoldable, singleton)
+import Data.List as L
 import Data.Maybe (Maybe(..), maybe, isJust)
-import Data.StrMap as SM
+import Data.NonEmpty (NonEmpty(..), (:|))
 import Data.Tuple (Tuple(..), fst)
-
 import Test.StrongCheck (SC, quickCheck, quickCheck', (<?>))
 import Test.StrongCheck.Arbitrary (class Arbitrary, arbitrary)
 import Test.StrongCheck.Data.AlphaNumString (AlphaNumString(..))
@@ -144,6 +143,8 @@ data User
       { name :: String
       , bio :: Maybe String
       , age :: Int
+      , hobbies :: NonEmpty Array String
+      , accesslog :: NonEmpty List String
       , balance :: Number
       , banned :: Boolean
       , tweets :: Array String
@@ -170,13 +171,17 @@ genericsCheck = do
     , balance: 26.6
     , banned: false
     , tweets: ["Hello", "What's up"]
+    , hobbies: "Jump Rope" :| ["Sightseeing"]
+    , accesslog: "223.67.92.1" :| L.singleton "210.5.2.25"
     , followers:
         [ Anonymous
         , Guest "someGuest"
         , Registered
             { name: "user2"
             , bio: Nothing
             , age: 6
+            , hobbies: "Jump Rope" :| ["Cooking"]
+            , accesslog: "152.67.25.1" :| L.singleton "210.5.2.25"
             , balance: 32.1
             , banned: false
             , tweets: ["Hi"]