add decoder for NonEmptyString (#94)

CHANGELOG.md

@@ -7,6 +7,7 @@ Notable changes to this project are documented in this file. The format is based
 Breaking changes (😱!!!):
 
 New features:
+- 2020-12-23: Per #91 - add decoders for NonEmptyString and add decodeNonempty function
 
 Bugfixes:
 
@@ -181,4 +182,4 @@ Updated dependencies
 
 ## [v0.1.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v0.1.0) - 2015-07-13
 
-- Initial release
+- Initial release

src/Data/Argonaut/Decode.purs

@@ -6,7 +6,7 @@ module Data.Argonaut.Decode
   ) where
 
 import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson)
-import Data.Argonaut.Decode.Combinators 
+import Data.Argonaut.Decode.Combinators
   ( getField
   , getFieldOptional
   , getFieldOptional'

src/Data/Argonaut/Decode/Class.purs

@@ -10,6 +10,7 @@ import Data.Either (Either(..))
 import Data.Identity (Identity)
 import Data.List (List)
 import Data.List.NonEmpty (NonEmptyList)
+import Data.String.NonEmpty (NonEmptyString)
 import Data.Map as M
 import Data.Maybe (Maybe(..))
 import Data.NonEmpty (NonEmpty)
@@ -54,6 +55,9 @@ instance decodeJsonInt :: DecodeJson Int where
 instance decodeJsonString :: DecodeJson String where
   decodeJson = decodeString
 
+instance decodeJsonNonEmptyString :: DecodeJson NonEmptyString where
+  decodeJson = decodeNonEmptyString
+
 instance decodeJsonJson :: DecodeJson Json where
   decodeJson = Right
 

src/Data/Argonaut/Decode/Decoders.purs

@@ -15,6 +15,8 @@ import Data.List (List, fromFoldable)
 import Data.List as L
 import Data.List.NonEmpty (NonEmptyList)
 import Data.List.NonEmpty as NEL
+import Data.String.NonEmpty (NonEmptyString)
+import Data.String.NonEmpty as NonEmptyString
 import Data.Map as M
 import Data.Maybe (maybe, Maybe(..))
 import Data.NonEmpty (NonEmpty, (:|))
@@ -25,14 +27,14 @@ import Data.TraversableWithIndex (traverseWithIndex)
 import Data.Tuple (Tuple(..))
 import Foreign.Object as FO
 
-decodeIdentity 
+decodeIdentity
   :: forall a
    . (Json -> Either JsonDecodeError a)
   -> Json
   -> Either JsonDecodeError (Identity a)
 decodeIdentity decoder json = Identity <$> decoder json
 
-decodeMaybe 
+decodeMaybe
   :: forall a
    . (Json -> Either JsonDecodeError a)
   -> Json
@@ -41,26 +43,26 @@ decodeMaybe decoder json
   | isNull json = pure Nothing
   | otherwise = Just <$> decoder json
 
-decodeTuple 
+decodeTuple
   :: forall a b
-   . (Json -> Either JsonDecodeError a) 
+   . (Json -> Either JsonDecodeError a)
   -> (Json -> Either JsonDecodeError b)
-  -> Json 
+  -> Json
   -> Either JsonDecodeError (Tuple a b)
 decodeTuple decoderA decoderB json = decodeArray Right json >>= f
   where
   f :: Array Json -> Either JsonDecodeError (Tuple a b)
-  f = case _ of 
+  f = case _ of
     [a, b] -> Tuple <$> decoderA a <*> decoderB b
     _ -> Left $ TypeMismatch "Tuple"
 
-decodeEither 
+decodeEither
   :: forall a b
    . (Json -> Either JsonDecodeError a)
   -> (Json -> Either JsonDecodeError b)
   -> Json
   -> Either JsonDecodeError (Either a b)
-decodeEither decoderA decoderB json = 
+decodeEither decoderA decoderB json =
   lmap (Named "Either") $ decodeJObject json >>= \obj -> do
     tag <- note (AtKey "tag" MissingValue) $ FO.lookup "tag" obj
     val <- note (AtKey "value" MissingValue) $ FO.lookup "value" obj
@@ -84,61 +86,66 @@ decodeInt = note (TypeMismatch "Integer") <<< fromNumber <=< decodeNumber
 decodeString :: Json -> Either JsonDecodeError String
 decodeString = caseJsonString (Left $ TypeMismatch "String") Right
 
-decodeNonEmpty_Array 
+decodeNonEmptyString :: Json -> Either JsonDecodeError NonEmptyString
+decodeNonEmptyString json =
+  note (Named "NonEmptyString" $ UnexpectedValue json)
+    =<< map (NonEmptyString.fromString) (decodeString json)
+
+decodeNonEmpty_Array
   :: forall a
    . (Json -> Either JsonDecodeError a)
   -> Json
   -> Either JsonDecodeError (NonEmpty Array a)
-decodeNonEmpty_Array decoder = 
-  lmap (Named "NonEmpty Array") 
-    <<< traverse decoder 
-    <=< map (\x -> x.head :| x.tail) 
-    <<< note (TypeMismatch "NonEmpty Array") 
+decodeNonEmpty_Array decoder =
+  lmap (Named "NonEmpty Array")
+    <<< traverse decoder
+    <=< map (\x -> x.head :| x.tail)
+    <<< note (TypeMismatch "NonEmpty Array")
     <<< Arr.uncons
     <=< decodeJArray
 
-decodeNonEmptyArray 
+decodeNonEmptyArray
   :: forall a
    . (Json -> Either JsonDecodeError a)
-  -> Json 
+  -> Json
   -> Either JsonDecodeError (NonEmptyArray a)
 decodeNonEmptyArray decoder =
   lmap (Named "NonEmptyArray")
-    <<< traverse decoder 
+    <<< traverse decoder
     <=< map (\x -> NEA.cons' x.head x.tail)
-    <<< note (TypeMismatch "NonEmptyArray") 
+    <<< note (TypeMismatch "NonEmptyArray")
     <<< Arr.uncons
     <=< decodeJArray
 
-decodeNonEmpty_List 
+decodeNonEmpty_List
   :: forall a
    . (Json -> Either JsonDecodeError a)
   -> Json
   -> Either JsonDecodeError (NonEmpty List a)
 decodeNonEmpty_List decoder =
   lmap (Named "NonEmpty List")
-    <<< traverse decoder 
+    <<< traverse decoder
     <=< map (\x -> x.head :| x.tail)
     <<< note (TypeMismatch "NonEmpty List")
     <<< L.uncons
     <=< map (map fromFoldable) decodeJArray
 
-decodeNonEmptyList 
+decodeNonEmptyList
   :: forall a
    . (Json -> Either JsonDecodeError a)
   -> Json
   -> Either JsonDecodeError (NonEmptyList a)
 decodeNonEmptyList decoder =
   lmap (Named "NonEmptyList")
-    <<< traverse decoder 
+    <<< traverse decoder
     <=< map (\x -> NEL.cons' x.head x.tail)
     <<< note (TypeMismatch "NonEmptyList")
     <<< L.uncons
     <=< map (map fromFoldable) decodeJArray
 
 decodeCodePoint :: Json -> Either JsonDecodeError CodePoint
-decodeCodePoint json = 
-  note (Named "CodePoint" $ UnexpectedValue json) 
+decodeCodePoint json =
+  note (Named "CodePoint" $ UnexpectedValue json)
     =<< map (codePointAt 0) (decodeString json)
 
 decodeForeignObject
@@ -147,47 +154,47 @@ decodeForeignObject
   -> Json
   -> Either JsonDecodeError (FO.Object a)
 decodeForeignObject decoder =
-  lmap (Named "ForeignObject") 
-    <<< traverse decoder 
+  lmap (Named "ForeignObject")
+    <<< traverse decoder
     <=< decodeJObject
 
-decodeArray 
+decodeArray
   :: forall a
    . (Json -> Either JsonDecodeError a)
   -> Json
   -> Either JsonDecodeError (Array a)
 decodeArray decoder =
   lmap (Named "Array")
-    <<< traverseWithIndex (\i -> lmap (AtIndex i) <<< decoder) 
+    <<< traverseWithIndex (\i -> lmap (AtIndex i) <<< decoder)
     <=< decodeJArray
 
-decodeList 
+decodeList
   :: forall a
    . (Json -> Either JsonDecodeError a)
   -> Json
   -> Either JsonDecodeError (List a)
 decodeList decoder =
   lmap (Named "List")
-    <<< traverse decoder 
+    <<< traverse decoder
     <=< map (map fromFoldable) decodeJArray
 
-decodeSet 
+decodeSet
   :: forall a
-   . Ord a 
+   . Ord a
   => (Json -> Either JsonDecodeError a)
   -> Json
   -> Either JsonDecodeError (S.Set a)
-decodeSet decoder = 
+decodeSet decoder =
   map (S.fromFoldable :: List a -> S.Set a) <<< decodeList decoder
 
-decodeMap 
+decodeMap
   :: forall a b
-   . Ord a 
+   . Ord a
   => (Json -> Either JsonDecodeError a)
   -> (Json -> Either JsonDecodeError b)
   -> Json
   -> Either JsonDecodeError (M.Map a b)
-decodeMap decoderA decoderB = 
+decodeMap decoderA decoderB =
   map (M.fromFoldable :: List (Tuple a b) -> M.Map a b)
     <<< decodeList (decodeTuple decoderA decoderB)
 
@@ -200,7 +207,7 @@ decodeJArray = note (TypeMismatch "Array") <<< toArray
 decodeJObject :: Json -> Either JsonDecodeError (FO.Object Json)
 decodeJObject = note (TypeMismatch "Object") <<< toObject
 
-getField 
+getField
   :: forall a
    . (Json -> Either JsonDecodeError a)
   -> FO.Object Json
@@ -212,7 +219,7 @@ getField decoder obj str =
     (lmap (AtKey str) <<< decoder)
     (FO.lookup str obj)
 
-getFieldOptional 
+getFieldOptional
   :: forall a
    . (Json -> Either JsonDecodeError a)
   -> FO.Object Json
@@ -223,7 +230,7 @@ getFieldOptional decoder obj str =
   where
   decode = lmap (AtKey str) <<< decoder
 
-getFieldOptional' 
+getFieldOptional'
   :: forall a
    . (Json -> Either JsonDecodeError a)
   -> FO.Object Json
@@ -232,8 +239,8 @@ getFieldOptional'
 getFieldOptional' decoder obj str =
   maybe (pure Nothing) decode (FO.lookup str obj)
   where
-  decode json = 
-    if isNull json then 
+  decode json =
+    if isNull json then
       pure Nothing
-    else 
+    else
       Just <$> (lmap (AtKey str) <<< decoder) json

src/Data/Argonaut/Decode/Error.purs

@@ -1,4 +1,4 @@
--- | Originally implemented in: 
+-- | Originally implemented in:
 -- | https://github.com/garyb/purescript-codec-argonaut
 module Data.Argonaut.Decode.Error where
 

src/Data/Argonaut/Decode/Parser.purs

@@ -11,4 +11,4 @@ import Data.Either (Either)
 -- | Attempt to parse a string as `Json`, failing with a typed error if the
 -- | JSON string is malformed.
 parseJson :: String -> Either JsonDecodeError Json
-parseJson = lmap (\_ -> TypeMismatch "JSON") <<< jsonParser
+parseJson = lmap (\_ -> TypeMismatch "JSON") <<< jsonParser

src/Data/Argonaut/Encode/Combinators.purs

@@ -15,7 +15,7 @@ import Data.Maybe (Maybe)
 import Data.Tuple (Tuple)
 import Data.Argonaut.Encode.Encoders as Encoders
 
--- | Creates a `Tuple String Json` entry, representing a key/value pair for 
+-- | Creates a `Tuple String Json` entry, representing a key/value pair for
 -- | an object.
 infix 7 assoc as :=
 

src/Data/Argonaut/Encode/Encoders.purs

@@ -88,8 +88,8 @@ encodeSet :: forall a. Ord a => (a -> Json) -> S.Set a -> Json
 encodeSet encoder = encodeList encoder <<< (S.toUnfoldable :: S.Set a -> List a)
 
 encodeMap :: forall a b. Ord a => (a -> Json) -> (b -> Json) -> M.Map a b -> Json
-encodeMap encoderA encoderB = 
-  encodeList (encodeTuple encoderA encoderB) 
+encodeMap encoderA encoderB =
+  encodeList (encodeTuple encoderA encoderB)
     <<< (M.toUnfoldable :: M.Map a b -> List (Tuple a b))
 
 encodeVoid :: Void -> Json
@@ -113,6 +113,6 @@ extend encoder (Tuple k v) =
 
 -- | The named Encoders of the `(~>?)` operator.
 extendOptional :: forall a. (a -> Json) -> Maybe (Tuple String Json) -> a -> Json
-extendOptional encoder = case _ of 
+extendOptional encoder = case _ of
   Just kv -> extend encoder kv
   Nothing -> encoder