waargonaut 0.4.2.0 → 0.5.0.0
raw patch · 23 files changed
+452/−272 lines, 23 filesdep ~bifunctorsdep ~contravariantdep ~errorsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: bifunctors, contravariant, errors, lens, mmorph, mtl, natural, semigroupoids, tasty, witherable
API changes (from Hackage documentation)
- Waargonaut.Types.JChar: jCharBuilder :: HeXaDeCiMaL digit => JChar digit -> Builder
- Waargonaut.Types.JString: instance Waargonaut.Types.JString.AsJString Data.ByteString.Internal.ByteString
- Waargonaut.Types.JString: instance Waargonaut.Types.JString.AsJString Data.Text.Internal.Text
- Waargonaut.Types.JString: textToJString :: Text -> JString
+ Waargonaut.Decode: lazyByteString :: Monad f => Decoder f ByteString
+ Waargonaut.Decode: parseWith :: (CharParsing f, Show e) => (f a -> i -> Either e a) -> f a -> i -> Either DecodeError a
+ Waargonaut.Decode: strictByteString :: Monad f => Decoder f ByteString
+ Waargonaut.Decode.Internal: lazyByteString' :: AsJType a ws a => a -> Maybe ByteString
+ Waargonaut.Decode.Internal: strictByteString' :: AsJType a ws a => a -> Maybe ByteString
+ Waargonaut.Encode: string :: Applicative f => Encoder f String
+ Waargonaut.Encode: string' :: Encoder' String
+ Waargonaut.Test: roundTripSimple :: (Eq b, Monad f, CharParsing f, Monad g, Show e) => (f Json -> ByteString -> Either e Json) -> Encoder g b -> Decoder g b -> b -> g (Either (DecodeError, CursorHistory) Bool)
+ Waargonaut.Types.JChar: jCharBuilderByteStringL :: HeXaDeCiMaL digit => JChar digit -> Builder
+ Waargonaut.Types.JChar: jCharBuilderTextL :: HeXaDeCiMaL digit => JChar digit -> Builder
+ Waargonaut.Types.JChar: jCharBuilderWith :: (Monoid builder, Semigroup builder, HeXaDeCiMaL digit) => (Char -> builder) -> JChar digit -> builder
+ Waargonaut.Types.JString: _JStringText :: Prism' JString Text
+ Waargonaut.Types.JString: stringToJString :: String -> JString
- Waargonaut.Encode: simpleEncodeNoSpaces :: Applicative f => Encoder f a -> a -> f ByteString
+ Waargonaut.Encode: simpleEncodeNoSpaces :: Applicative f => Encoder f a -> a -> f Text
- Waargonaut.Encode: simplePureEncodeNoSpaces :: Encoder Identity a -> a -> ByteString
+ Waargonaut.Encode: simplePureEncodeNoSpaces :: Encoder Identity a -> a -> Text
Files
- changelog.md +7/−0
- src/Waargonaut/Decode.hs +50/−16
- src/Waargonaut/Decode/Internal.hs +18/−3
- src/Waargonaut/Decode/Traversal.hs +1/−1
- src/Waargonaut/Decode/ZipperMove.hs +9/−7
- src/Waargonaut/Encode.hs +23/−11
- src/Waargonaut/Test.hs +37/−0
- src/Waargonaut/Types/CommaSep.hs +4/−4
- src/Waargonaut/Types/JArray.hs +1/−1
- src/Waargonaut/Types/JChar.hs +63/−47
- src/Waargonaut/Types/JNumber.hs +46/−40
- src/Waargonaut/Types/JObject.hs +9/−10
- src/Waargonaut/Types/JString.hs +56/−51
- src/Waargonaut/Types/Json.hs +6/−5
- src/Waargonaut/Types/Whitespace.hs +7/−7
- test/Decoder.hs +4/−5
- test/Encoder.hs +5/−5
- test/Encoder/Laws.hs +2/−2
- test/Laws.hs +1/−1
- test/Main.hs +72/−22
- test/Types/Common.hs +9/−12
- test/Utils.hs +3/−4
- waargonaut.cabal +19/−18
changelog.md view
@@ -1,5 +1,12 @@ # Revision history for waargonaut +## 0.5.0.0 -- 2018-12-18++* Changed internal builder from `ByteString` to `Text` builder.+* Fixed bug for going from `JString` <-> `Text`, was breaking round-trip.+* Removed instances of `AsJString` for `Text` and `ByteString`, replaced with more correct `Prism` and some better functions.+* Added regression tests for round tripping text and bytestring (char8).+ ## 0.4.2.0 -- 2018-11-29 * Improved pretty printing of CursorHistory by condensing multiple numeric movements and removing the single movements following searching for keys.
src/Waargonaut/Decode.hs view
@@ -31,6 +31,7 @@ -- * Helpers , DI.ppCursorHistory+ , parseWith -- * Cursors , withCursor@@ -69,6 +70,8 @@ , scientific , integral , string+ , strictByteString+ , lazyByteString , unboundedChar , boundedChar , text@@ -90,16 +93,16 @@ import Control.Lens (Cons, Lens', Prism', Snoc, cons, lens, matching, modifying,- preview, snoc,+ over, preview, snoc, traverseOf, view, ( # ), (.~), (^.),- _Wrapped)+ _Left, _Wrapped) import Prelude (Bool, Bounded, Char, Eq, Int, Integral,- String,- fromIntegral, (-),- (==))+ Show, String,+ fromIntegral, show,+ (-), (==)) import Control.Applicative (Applicative (..)) import Control.Category ((.))@@ -137,11 +140,13 @@ successor', zero') import Data.Text (Text)+import qualified Data.Text as Text -import Data.ByteString.Char8 (ByteString)-import qualified Data.ByteString.Char8 as BS8+import Text.Parser.Char (CharParsing) -import Waargonaut.Types+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BL import HaskellWorks.Data.Positioning (Count) import qualified HaskellWorks.Data.Positioning as Pos@@ -155,11 +160,11 @@ import HaskellWorks.Data.Json.Cursor (JsonCursor (..)) import qualified HaskellWorks.Data.Json.Cursor as JC - import Waargonaut.Decode.Error (AsDecodeError (..), DecodeError (..), Err (..)) import Waargonaut.Decode.ZipperMove (ZipperMove (..))+import Waargonaut.Types import qualified Waargonaut.Decode.Internal as DI @@ -492,13 +497,6 @@ -- | A version of 'fromKey' that returns its result in 'Maybe'. If the key is -- not present in the object, 'Nothing' is returned. If the key is present, -- decoding will be performed as with 'fromKey'.------ For example, if a key could be absent and could be null if present,--- it could be decoded as follows:------ @--- join <$> fromKeyOptional "key" (maybeOrNull text)--- @ fromKeyOptional :: Monad f => Text@@ -515,6 +513,13 @@ -- | A version of 'atKey' that returns its result in 'Maybe'. If the key is -- not present in the object, 'Nothing' is returned. If the key is present, -- decoding will be performed as with 'atKey'.+--+-- For example, if a key could be absent and could be null if present,+-- it could be decoded as follows:+--+-- @+-- join \<$> atKeyOptional "key" (maybeOrNull text)+-- @ atKeyOptional :: Monad f => Text@@ -681,6 +686,27 @@ runPureDecode d parseFn . mkCursor +-- | Helper function to handle wrapping up a parse failure using the given+-- parsing function. Intended to be used with the 'runDecode' or 'simpleDecode'+-- functions.+--+-- @+-- import Data.Attoparsec.ByteString (parseOnly)+--+-- simpleDecode (list int) (parseWith (parseOnly parseWaargonaut)) "[1,1,2]"+-- @+--+parseWith+ :: ( CharParsing f+ , Show e+ )+ => (f a -> i -> Either e a)+ -> f a+ -> i+ -> Either DecodeError a+parseWith f p =+ over _Left (ParseFailed . Text.pack . show) . f p+ -- | Similar to the 'simpleDecode' function, however this function expects -- you've already converted your input to a 'JCurs'. runPureDecode@@ -766,6 +792,14 @@ -- | Decode a 'String' value. string :: Monad f => Decoder f String string = atCursor "string" DI.string'++-- | Decode a strict 'ByteString' value.+strictByteString :: Monad f => Decoder f ByteString+strictByteString = atCursor "strict bytestring" DI.strictByteString'++-- | Decode a lazy 'ByteString' value.+lazyByteString :: Monad f => Decoder f BL.ByteString+lazyByteString = atCursor "lazy bytestring" DI.lazyByteString' -- | Decode a 'Char' value that is equivalent to a Haskell 'Char' value, as Haskell 'Char' supports a wider range than JSON. unboundedChar :: Monad f => Decoder f Char
src/Waargonaut/Decode/Internal.hs view
@@ -25,6 +25,8 @@ , int' , text' , string'+ , lazyByteString'+ , strictByteString' , unboundedChar' , boundedChar' , bool'@@ -64,6 +66,9 @@ import Data.Semigroup ((<>)) import Data.Sequence (Seq, fromList) +import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Builder as BB import Data.Text (Text) import Data.Map (Map)@@ -79,9 +84,10 @@ import Natural (Natural, _Natural) import Waargonaut.Types (AsJType (..), JString,+ jCharBuilderByteStringL, jNumberToScientific, jsonAssocKey, jsonAssocVal,- _JChar, _JString)+ _JChar, _JStringText) import Waargonaut.Types.CommaSep (toList) import Waargonaut.Types.JChar (jCharToUtf8Char) @@ -288,13 +294,22 @@ prismDOrFail' e p d c = runDecoder' (L.preview p <$> d) c <!?> e --- | Try to decode a 'Text' value from some 'Json' or value.+-- | Try to decode a 'Text' value from some 'Json' or value. This will fail if+-- the input value is not a valid UTF-8 'Text' value, as checked by the+-- 'Data.Text.Encoding.decodeUtf8'' function. text' :: AsJType a ws a => a -> Maybe Text-text' = L.preview (_JStr . _1 . L.re _JString)+text' = L.preview (_JStr . _1 . _JStringText) -- | Try to decode a 'String' value from some 'Json' or value. string' :: AsJType a ws a => a -> Maybe String string' = L.preview (_JStr . _1 . _Wrapped . L.to (V.toList . V.map (_JChar L.#)))++strictByteString' :: AsJType a ws a => a -> Maybe ByteString+strictByteString' = fmap BL.toStrict . lazyByteString'++lazyByteString' :: AsJType a ws a => a -> Maybe BL.ByteString+lazyByteString' = L.preview (_JStr . _1 . _Wrapped . L.to mkBS)+ where mkBS = BB.toLazyByteString . foldMap jCharBuilderByteStringL -- | Decoder for a 'Char' value that cannot contain values in the range U+D800 -- to U+DFFF. This decoder will fail if the 'Char' is outside of this range.
src/Waargonaut/Decode/Traversal.hs view
@@ -389,7 +389,7 @@ >=> Z.within WT.jsonAssocVal ) where- shuffleToKey cu = Z.within WT.jsonAssocKey cu ^? L._Just . Z.focus . L.re WT._JString+ shuffleToKey cu = Z.within WT.jsonAssocKey cu ^? L._Just . Z.focus . WT._JStringText >>= Bool.bool (Just cu) (Z.rightward cu >>= shuffleToKey) . (/=k) intoElems = WT._JObj . L._1 . L._Wrapped . WT._CommaSeparated . L._2 . L._Just
src/Waargonaut/Decode/ZipperMove.hs view
@@ -12,6 +12,8 @@ import Data.Text (Text) import qualified Data.Text as Text +import Data.Semigroup ((<>))+ import Natural (Natural) import Text.PrettyPrint.Annotated.WL (Doc, (<+>))@@ -34,15 +36,15 @@ -- 'Waargonaut.Decode.Internal.CursorHistory'' to improve the readability of the errors. ppZipperMove :: ZipperMove -> Doc a ppZipperMove m = case m of- U -> WL.text "up/"- D -> WL.text "down\\"+ U -> WL.text "up/" <> WL.linebreak+ D -> WL.text "down\\" <> WL.linebreak - (L n) -> WL.text "-<-" <+> ntxt n- (R n) -> WL.text "->-" <+> ntxt n+ L n -> WL.text "-<-" <+> ntxt n+ R n -> WL.text " ->-" <+> ntxt n - (DAt k) -> WL.text "into\\" <+> itxt "key" k- (Item t) -> WL.text "-::" <+> itxt "item" t- (BranchFail t) -> WL.text "(attempted: " <+> ntxt t <+> WL.text ")"+ DAt k -> WL.text "into\\" <+> itxt "key" k <> WL.linebreak+ Item t -> WL.text "-::" <+> itxt "item" t <> WL.linebreak+ BranchFail t -> WL.text "(attempted: " <+> ntxt t <+> WL.text ")" <> WL.linebreak where itxt t k' = WL.parens (WL.text t <+> WL.colon <+> WL.text (Text.unpack k')) ntxt n' = WL.parens (WL.char 'i' <+> WL.char '+' <+> WL.text (show n'))
src/Waargonaut/Encode.hs view
@@ -32,6 +32,7 @@ , integral , scientific , bool+ , string , text , null , either@@ -66,6 +67,7 @@ , integral' , scientific' , bool'+ , string' , text' , null' , either'@@ -92,7 +94,8 @@ import qualified Control.Lens as L import Prelude (Bool, Int, Integral,- Monad, fromIntegral, fst)+ Monad, String,+ fromIntegral, fst) import Data.Foldable (Foldable, foldr, foldrM) import Data.Function (const, flip, ($), (&))@@ -112,13 +115,12 @@ import Data.Monoid (Monoid, mempty) import Data.Semigroup (Semigroup) -import qualified Data.ByteString.Builder as BB-import Data.ByteString.Lazy (ByteString)- import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text)+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Builder as TB import Waargonaut.Encode.Types (Encoder, Encoder', ObjEncoder, ObjEncoder',@@ -132,10 +134,12 @@ import Waargonaut.Types (AsJType (..), JAssoc (..), JObject, Json, MapLikeObj (..),- WS, textToJString,+ WS, stringToJString, toMapLikeObj, wsRemover, _JNumberInt,- _JNumberScientific)+ _JNumberScientific,+ _JStringText)+ import Waargonaut.Types.Json (waargonautBuilder) @@ -153,15 +157,15 @@ :: Applicative f => Encoder f a -> a- -> f ByteString+ -> f LT.Text simpleEncodeNoSpaces enc =- fmap (BB.toLazyByteString . waargonautBuilder wsRemover) . runEncoder enc+ fmap (TB.toLazyText . waargonautBuilder wsRemover) . runEncoder enc -- | As per 'simpleEncodeNoSpaces' but specialised the 'f' to 'Data.Functor.Identity' and remove it. simplePureEncodeNoSpaces :: Encoder Identity a -> a- -> ByteString+ -> LT.Text simplePureEncodeNoSpaces enc = runIdentity . simpleEncodeNoSpaces enc @@ -204,9 +208,13 @@ bool :: Applicative f => Encoder f Bool bool = encToJsonNoSpaces _JBool id +-- | Encode a 'String'+string :: Applicative f => Encoder f String+string = encToJsonNoSpaces _JStr stringToJString+ -- | Encode a 'Text' text :: Applicative f => Encoder f Text-text = encToJsonNoSpaces _JStr textToJString+text = encToJsonNoSpaces _JStr (_JStringText #) -- | Encode an explicit 'null'. null :: Applicative f => Encoder f ()@@ -299,6 +307,10 @@ bool' :: Encoder' Bool bool' = bool +-- | As per 'string' but with the 'f' specialised to 'Data.Functor.Identity'.+string' :: Encoder' String+string' = string+ -- | As per 'text' but with the 'f' specialised to 'Data.Functor.Identity'. text' :: Encoder' Text text' = text@@ -586,7 +598,7 @@ -> JObject WS Json -> f (JObject WS Json) onObj k b encB o = (\j -> o & _Wrapped L.%~ L.cons j)- . JAssoc (textToJString k) mempty mempty <$> runEncoder encB b+ . JAssoc (_JStringText # k) mempty mempty <$> runEncoder encB b -- | Encode key value pairs as a JSON object, allowing duplicate keys. keyValuesAsObj
+ src/Waargonaut/Test.hs view
@@ -0,0 +1,37 @@+module Waargonaut.Test+ ( roundTripSimple+ ) where++import qualified Data.Text.Encoding as Text+import qualified Data.Text.Lazy as TextL++import Data.ByteString (ByteString)++import Text.Parser.Char (CharParsing)++import Waargonaut.Types (Json, parseWaargonaut)++import Waargonaut.Encode (Encoder)+import qualified Waargonaut.Encode as E++import Waargonaut.Decode (CursorHistory, Decoder)+import qualified Waargonaut.Decode as D+import Waargonaut.Decode.Error (DecodeError)++roundTripSimple+ :: ( Eq b+ , Monad f+ , CharParsing f+ , Monad g+ , Show e+ )+ => (f Json -> ByteString -> Either e Json)+ -> Encoder g b+ -> Decoder g b+ -> b+ -> g (Either (DecodeError, CursorHistory) Bool)+roundTripSimple f e d a = do+ encodedA <- E.simpleEncodeNoSpaces e a+ (fmap . fmap) (== a) $ D.runDecode d+ (D.parseWith f parseWaargonaut)+ (D.mkCursor . Text.encodeUtf8 . TextL.toStrict $ encodedA)
src/Waargonaut/Types/CommaSep.hs view
@@ -78,8 +78,8 @@ import Data.Functor.Identity (Identity (..)) -import Data.ByteString.Builder (Builder)-import qualified Data.ByteString.Builder as BB+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as TB import Text.Parser.Char (CharParsing, char) import qualified Text.Parser.Combinators as C@@ -108,7 +108,7 @@ -- | Builder for UTF8 Comma commaBuilder :: Builder-commaBuilder = BB.charUtf8 ','+commaBuilder = TB.singleton ',' {-# INLINE commaBuilder #-} -- | Parse a single comma (,)@@ -370,7 +370,7 @@ -> CommaSeparated ws a -> Builder commaSeparatedBuilder op fin wsB aB (CommaSeparated lws sepElems) =- BB.charUtf8 op <> wsB lws <> maybe mempty buildElems sepElems <> BB.charUtf8 fin+ TB.singleton op <> wsB lws <> maybe mempty buildElems sepElems <> TB.singleton fin where elemBuilder :: Foldable f
src/Waargonaut/Types/JArray.hs view
@@ -37,7 +37,7 @@ import Data.Semigroup (Semigroup (..)) import Data.Traversable (Traversable) -import Data.ByteString.Builder (Builder)+import Data.Text.Lazy.Builder (Builder) import Text.Parser.Char (CharParsing, char)
src/Waargonaut/Types/JChar.hs view
@@ -27,7 +27,10 @@ , parseJChar , parseJCharEscaped , parseJCharUnescaped- , jCharBuilder+ , jCharBuilderWith+ , jCharBuilderTextL+ , jCharBuilderByteStringL+ , jCharToChar -- * Conversion@@ -35,49 +38,51 @@ , jCharToUtf8Char ) where -import Prelude (Char, Eq, Int, Ord, Show,- otherwise, quotRem, (&&),- (*), (+), (-), (/=), (<=), (==),- (>=))+import Prelude (Char, Eq, Int, Ord, Show,+ otherwise, quotRem, (&&), (*),+ (+), (-), (/=), (<=), (==), (>=)) -import Control.Category (id, (.))-import Control.Lens (Lens', Prism', Rewrapped,- Wrapped (..), failing, has, iso,- prism, prism', to, ( # ), (^?),- _Just)+import Control.Category (id, (.))+import Control.Lens (Lens', Prism', Rewrapped,+ Wrapped (..), failing, has, iso,+ prism, prism', to, ( # ), (^?),+ _Just) -import Control.Applicative (pure, (*>), (<$>), (<*>), (<|>))-import Control.Monad ((=<<))+import Control.Applicative (pure, (*>), (<$>), (<*>), (<|>))+import Control.Monad ((=<<)) -import Control.Error.Util (note)+import Control.Error.Util (note) -import Data.Bits ((.&.))+import Data.Bits ((.&.)) -import Data.Char (chr, ord)-import Data.Either (Either (..))-import Data.Foldable (Foldable, any, asum, foldMap,- foldl)-import Data.Function (const, ($))-import Data.Functor (Functor)-import Data.Maybe (Maybe (..), fromMaybe)-import Data.Semigroup ((<>))-import Data.Traversable (Traversable, traverse)+import Data.Char (chr, ord)+import Data.Either (Either (..))+import Data.Foldable (Foldable, any, asum, foldMap,+ foldl)+import Data.Function (const, ($))+import Data.Functor (Functor)+import Data.Maybe (Maybe (..), fromMaybe)+import Data.Monoid (Monoid)+import Data.Semigroup (Semigroup, (<>))+import Data.Traversable (Traversable, traverse) -import qualified Data.Text.Internal as Text+import qualified Data.Text.Internal as Text -import Data.Digit (HeXDigit, HeXaDeCiMaL)-import qualified Data.Digit as D+import Data.Digit (HeXDigit, HeXaDeCiMaL)+import qualified Data.Digit as D -import Data.ByteString.Builder (Builder)-import qualified Data.ByteString.Builder as BB+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as TB -import Waargonaut.Types.Whitespace (Whitespace (..),- escapedWhitespaceChar,- unescapedWhitespaceChar,- _WhitespaceChar)+import qualified Data.ByteString.Lazy.Builder as BB -import Text.Parser.Char (CharParsing, char, satisfy)+import Waargonaut.Types.Whitespace (Whitespace (..),+ escapedWhitespaceChar,+ unescapedWhitespaceChar,+ _WhitespaceChar) +import Text.Parser.Char (CharParsing, char, satisfy)+ -- $setup -- >>> :set -XOverloadedStrings -- >>> import Control.Monad (return)@@ -445,19 +450,30 @@ (WhiteSpace ws) -> _WhiteSpace # ws Hex hexDig4 -> hexDigit4ToChar hexDig4 --- | Create a 'Builder' for the given 'JChar'.-jCharBuilder- :: HeXaDeCiMaL digit- => JChar digit- -> Builder-jCharBuilder (UnescapedJChar (JCharUnescaped c)) = BB.charUtf8 c-jCharBuilder (EscapedJChar jca) = BB.charUtf8 '\\' <> case jca of- QuotationMark -> BB.charUtf8 '"'- ReverseSolidus -> BB.charUtf8 '\\'- Solidus -> BB.charUtf8 '/'- Backspace -> BB.charUtf8 'b'- (WhiteSpace ws) -> BB.charUtf8 (unescapedWhitespaceChar ws)- Hex (HexDigit4 a b c d) -> BB.charUtf8 'u' <> foldMap hexChar [a,b,c,d]+jCharBuilderWith+ :: ( Monoid builder+ , Semigroup builder+ , HeXaDeCiMaL digit+ )+ => (Char -> builder)+ -> JChar digit+ -> builder+jCharBuilderWith f (UnescapedJChar (JCharUnescaped c)) = f c+jCharBuilderWith f (EscapedJChar jca) = f '\\' <> case jca of+ QuotationMark -> f '"'+ ReverseSolidus -> f '\\'+ Solidus -> f '/'+ Backspace -> f 'b'+ (WhiteSpace ws) -> f (unescapedWhitespaceChar ws)+ Hex (HexDigit4 a b c d) -> f 'u' <> foldMap hexChar [a,b,c,d] where hexChar =- BB.charUtf8 . (D.charHeXaDeCiMaL #)+ f . (D.charHeXaDeCiMaL #)++-- | Create a Lazy 'Text' 'Data.Text.Lazy.Builder' for the given 'JChar'.+jCharBuilderTextL :: HeXaDeCiMaL digit => JChar digit -> Builder+jCharBuilderTextL = jCharBuilderWith TB.singleton++-- | Create a Lazy 'ByteString' 'Data.ByteString.Lazy.Builder' for a given 'JChar'+jCharBuilderByteStringL :: HeXaDeCiMaL digit => JChar digit -> BB.Builder+jCharBuilderByteStringL = jCharBuilderWith BB.charUtf8
src/Waargonaut/Types/JNumber.hs view
@@ -31,45 +31,48 @@ , jNumberToScientific ) where -import Prelude (Bool (..), Eq, Int, Ord, Show, Integral, abs,- fromIntegral, maxBound, minBound,- negate, (-), (<), (>), (||))+import Prelude (Bool (..), Eq, Int, Integral, Ord,+ Show, abs, fromIntegral, maxBound,+ minBound, negate, (-), (<), (>),+ (||)) -import Data.Scientific (Scientific)-import qualified Data.Scientific as Sci+import Data.Scientific (Scientific)+import qualified Data.Scientific as Sci -import Control.Category (id, (.))-import Control.Lens (Lens', Prism', Rewrapped,- Wrapped (..), iso, prism, ( # ), (^?),- _Just, _Wrapped)+import Control.Category (id, (.))+import Control.Lens (Lens', Prism', Rewrapped,+ Wrapped (..), iso, prism, ( # ),+ (^?), _Just, _Wrapped) -import Control.Applicative (pure, (*>), (<$), (<$>), (<*>))-import Control.Monad (Monad, (=<<))+import Control.Applicative (pure, (*>), (<$), (<$>), (<*>))+import Control.Monad (Monad, (=<<)) -import Control.Error.Util (note)+import Control.Error.Util (note) -import Data.Either (Either (..))-import Data.Function (const, ($))-import Data.Functor (fmap)-import Data.Maybe (Maybe (..), fromMaybe, isJust, maybe)-import Data.Monoid (mappend, mempty)-import Data.Semigroup ((<>))-import Data.Traversable (traverse)-import Data.Tuple (uncurry)+import Data.Either (Either (..))+import Data.Function (const, ($))+import Data.Functor (fmap)+import Data.Maybe (Maybe (..), fromMaybe, isJust,+ maybe)+import Data.Monoid (mappend, mempty)+import Data.Semigroup ((<>))+import Data.Traversable (traverse)+import Data.Tuple (uncurry) -import Data.List.NonEmpty (NonEmpty ((:|)), some1)-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty (NonEmpty ((:|)), some1)+import qualified Data.List.NonEmpty as NE -import Data.Foldable (asum, foldMap, length)+import Data.Foldable (asum, foldMap, length) -import Data.Digit (DecDigit)-import qualified Data.Digit as D+import Data.Digit (DecDigit)+import qualified Data.Digit as D -import Text.Parser.Char (CharParsing, char)-import Text.Parser.Combinators (many, optional)+import Text.Parser.Char (CharParsing, char)+import Text.Parser.Combinators (many, optional) -import Data.ByteString.Builder (Builder)-import qualified Data.ByteString.Builder as BB+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as TB+import qualified Data.Text.Lazy.Builder.Int as TB -- $setup -- >>> :set -XOverloadedStrings@@ -81,7 +84,7 @@ -- >>> import qualified Data.Digit as D -- >>> import Waargonaut.Decode.Error (DecodeError) -- >>> import Data.ByteString.Lazy (toStrict)--- >>> import Data.ByteString.Builder (toLazyByteString)+-- >>> import Data.Text.Lazy.Builder (toLazyText) -- >>> import Utils -- | Represent a JSON "int"@@ -340,8 +343,8 @@ eBuilder :: E -> Builder-eBuilder Ee = BB.charUtf8 'e'-eBuilder EE = BB.charUtf8 'E'+eBuilder Ee = TB.singleton 'e'+eBuilder EE = TB.singleton 'E' -- | Parse the fractional component of a JSON number. --@@ -409,8 +412,8 @@ getExpSymbol :: Maybe Bool -> Builder-getExpSymbol (Just True) = BB.charUtf8 '-'-getExpSymbol (Just False) = BB.charUtf8 '+'+getExpSymbol (Just True) = TB.singleton '-'+getExpSymbol (Just False) = TB.singleton '+' getExpSymbol _ = mempty -- | Builder for a list of digits.@@ -418,7 +421,10 @@ :: NonEmpty DecDigit -> Builder digitsBuilder =- foldMap (BB.int8Dec . (D.integralDecimal #))+ foldMap (int8 . (D.integralDecimal #))+ where+ int8 :: Int -> Builder+ int8 = TB.decimal -- | Builder for the exponent portion. expBuilder@@ -481,13 +487,13 @@ -- | Printing of JNumbers ----- >>> toLazyByteString $ jNumberBuilder (JNumber {_minus = False, _numberint = JIntInt D.DecDigit3 [], _frac = Just (Frac (D.DecDigit4 :| [D.DecDigit5])), _expn = Just (Exp {_ex = Ee, _minusplus = Just False, _expdigits = D.DecDigit1 :| [D.DecDigit0]})})+-- >>> toLazyText $ jNumberBuilder (JNumber {_minus = False, _numberint = JIntInt D.DecDigit3 [], _frac = Just (Frac (D.DecDigit4 :| [D.DecDigit5])), _expn = Just (Exp {_ex = Ee, _minusplus = Just False, _expdigits = D.DecDigit1 :| [D.DecDigit0]})}) -- "3.45e+10" ----- >>> toLazyByteString $ jNumberBuilder (JNumber {_minus = True, _numberint = JIntInt D.DecDigit3 [], _frac = Just (Frac (D.DecDigit4 :| [D.DecDigit5])), _expn = Just (Exp {_ex = Ee, _minusplus = Just True, _expdigits = D.DecDigit0 :| [D.x2]})})+-- >>> toLazyText $ jNumberBuilder (JNumber {_minus = True, _numberint = JIntInt D.DecDigit3 [], _frac = Just (Frac (D.DecDigit4 :| [D.DecDigit5])), _expn = Just (Exp {_ex = Ee, _minusplus = Just True, _expdigits = D.DecDigit0 :| [D.x2]})}) -- "-3.45e-02" ----- >>> toLazyByteString $ jNumberBuilder (JNumber {_minus = False, _numberint = JIntInt D.DecDigit0 [D.DecDigit0], _frac = Nothing, _expn = Nothing})+-- >>> toLazyText $ jNumberBuilder (JNumber {_minus = False, _numberint = JIntInt D.DecDigit0 [D.DecDigit0], _frac = Nothing, _expn = Nothing}) -- "00" -- jNumberBuilder@@ -496,9 +502,9 @@ jNumberBuilder (JNumber sign digs mfrac mexp) = s <> digits <> frac' <> expo where- s = if sign then BB.charUtf8 '-' else mempty+ s = if sign then TB.singleton '-' else mempty digits = digitsBuilder . jIntToDigits $ digs- frac' = foldMap (mappend (BB.charUtf8 '.') . fracBuilder) mfrac+ frac' = foldMap (mappend (TB.singleton '.') . fracBuilder) mfrac expo = foldMap expBuilder mexp -- | Returns a normalised 'Scientific' value or Nothing if the exponent
src/Waargonaut/Types/JObject.hs view
@@ -35,12 +35,11 @@ import Control.Applicative ((<*), (<*>)) import Control.Category (id, (.))-import Control.Lens (AsEmpty (..), At (..), Index, +import Control.Lens (AsEmpty (..), At (..), Index, IxValue, Ixed (..), Lens', Prism',- Rewrapped, Wrapped (..), cons, - isn't, iso, nearly, prism', re, to,- ( # ), (.~), (<&>), (^.), (^?),- _Wrapped)+ Rewrapped, Wrapped (..), cons,+ isn't, iso, nearly, prism', to,+ ( # ), (.~), (<&>), (^.), _Wrapped) import Control.Monad (Monad) import Data.Bifoldable (Bifoldable (bifoldMap))@@ -56,8 +55,8 @@ import Data.Text (Text) import Data.Traversable (Traversable, traverse) -import Data.ByteString.Builder (Builder)-import qualified Data.ByteString.Builder as BB+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as TB import qualified Data.Witherable as W @@ -133,7 +132,7 @@ -- This function is analogus to the 'Data.Map.alterF' function. jAssocAlterF :: (Monoid ws, Functor f) => Text -> (Maybe a -> f (Maybe a)) -> Maybe (JAssoc ws a) -> f (Maybe (JAssoc ws a)) jAssocAlterF k f mja = fmap g <$> f (_jsonAssocVal <$> mja) where- g v = maybe (JAssoc (textToJString k) mempty mempty v) (jsonAssocVal .~ v) mja+ g v = maybe (JAssoc (_JStringText # k) mempty mempty v) (jsonAssocVal .~ v) mja -- | The representation of a JSON object. --@@ -255,7 +254,7 @@ -- Compare a 'Text' to the key for a 'JAssoc' value. textKeyMatch :: Text -> JAssoc ws a -> Bool-textKeyMatch k = (== Just k) . (^? jsonAssocKey . re _JString)+textKeyMatch k = (== k) . (^. jsonAssocKey . _JStringText) -- | Parse a single "key:value" pair parseJAssoc@@ -275,7 +274,7 @@ -> JAssoc ws a -> Builder jAssocBuilder ws aBuilder (JAssoc k ktws vpws v) =- jStringBuilder k <> ws ktws <> BB.charUtf8 ':' <> ws vpws <> aBuilder ws v+ jStringBuilder k <> ws ktws <> TB.singleton ':' <> ws vpws <> aBuilder ws v -- | --
src/Waargonaut/Types/JString.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} -- | Types and functions for handling JSON strings. module Waargonaut.Types.JString@@ -13,45 +14,50 @@ , JString' (..) , AsJString (..) + , _JStringText+ , stringToJString+ -- * Parser / Builder , parseJString , jStringBuilder-- , textToJString ) where -import Prelude (Eq, Ord, Show, String)+import Prelude (Eq, Ord, Show, String, foldr) -import Control.Applicative ((*>), (<*))-import Control.Category (id, (.))-import Control.Error.Util (note)-import Control.Lens (Prism', Rewrapped, Wrapped (..), iso,- preview, prism, ( # ), (^?))+import Control.Applicative ((*>), (<*))+import Control.Category (id, (.))+import Control.Error.Util (note)+import Control.Lens (Prism', Rewrapped, Wrapped (..),+ iso, prism, review, ( # ), (^?)) -import Data.Either (Either (Right))-import Data.Foldable (Foldable, foldMap)-import Data.Function (($))-import Data.Functor (Functor, (<$>))-import Data.Semigroup ((<>))-import Data.Text (Text)-import qualified Data.Text as Text-import Data.Traversable (Traversable, traverse)+import Data.Bifunctor (first)+import Data.Either (Either (Right))+import Data.Foldable (Foldable, foldMap)+import Data.Function (const, ($))+import Data.Functor (Functor, fmap, (<$>))+import Data.Semigroup ((<>))+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import Data.Traversable (Traversable, traverse) -import Data.Vector (Vector)-import qualified Data.Vector as V+import Data.Vector (Vector)+import qualified Data.Vector as V -import Data.Digit (HeXDigit)+import Data.Digit (HeXDigit) -import Text.Parser.Char (CharParsing, char)-import Text.Parser.Combinators (many)+import Text.Parser.Char (CharParsing, char)+import Text.Parser.Combinators (many) -import Data.ByteString (ByteString)-import qualified Data.ByteString.Builder as BB-import qualified Data.ByteString.Char8 as BS8+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as TB -import Waargonaut.Types.JChar (JChar, jCharBuilder, parseJChar,- utf8CharToJChar, _JChar)+import qualified Data.ByteString.Lazy.Char8 as BS8 +import Waargonaut.Types.JChar (JChar, jCharBuilderTextL,+ parseJChar, utf8CharToJChar,+ _JChar)+ -- $setup -- >>> :set -XOverloadedStrings -- >>> import Control.Lens ((#))@@ -64,6 +70,7 @@ -- >>> import Waargonaut.Decode.Error (DecodeError) -- >>> import Waargonaut.Types.Whitespace -- >>> import Waargonaut.Types.JChar+-- >>> import Data.Text.Lazy.Builder (toLazyText) ---- -- | A JSON string is a list of JSON acceptable characters, we use a newtype to@@ -94,13 +101,19 @@ _JString = prism (\(JString' cs) -> V.toList cs) (Right . JString' . V.fromList) instance AsJString String where- _JString = prism (\(JString' cx) -> V.toList $ (_JChar #) <$> cx) (\x -> JString' . V.fromList <$> traverse (note x . (^? _JChar)) x)--instance AsJString Text where- _JString = prism (Text.pack . (_JString #)) (\x -> note x . preview _JString . Text.unpack $ x)+ _JString = prism+ (\(JString' cx) -> V.toList $ (_JChar #) <$> cx)+ (\x -> JString' . V.fromList <$> traverse (note x . (^? _JChar)) x) -instance AsJString ByteString where- _JString = prism (BS8.pack . (_JString #)) (\x -> note x . preview _JString . BS8.unpack $ x)+-- | Prism between a 'JString' and 'Text'.+--+-- JSON strings a wider range of encodings than 'Text' and to be consistent with+-- the 'Text' type, these invalid types are replaced with a placeholder value.+--+_JStringText :: Prism' JString Text+_JStringText = prism+ (JString' . V.fromList . fmap utf8CharToJChar . Text.unpack)+ (\x -> first (const x) . Text.decodeUtf8' . BS8.toStrict . BS8.pack . review _JString $ x) -- | Parse a 'JString', storing escaped characters and any explicitly escaped -- character encodings '\uXXXX'.@@ -133,39 +146,31 @@ -- | Builder for a 'JString'. ----- >>> BB.toLazyByteString $ jStringBuilder ((JString' V.empty) :: JString)+-- >>> toLazyText $ jStringBuilder ((JString' V.empty) :: JString) -- "\"\"" ----- >>> BB.toLazyByteString $ jStringBuilder ((JString' $ V.fromList [UnescapedJChar (JCharUnescaped 'a'),UnescapedJChar (JCharUnescaped 'b'),UnescapedJChar (JCharUnescaped 'c')]) :: JString)+-- >>> toLazyText $ jStringBuilder ((JString' $ V.fromList [UnescapedJChar (JCharUnescaped 'a'),UnescapedJChar (JCharUnescaped 'b'),UnescapedJChar (JCharUnescaped 'c')]) :: JString) -- "\"abc\"" ----- >>> BB.toLazyByteString $ jStringBuilder ((JString' $ V.fromList [UnescapedJChar (JCharUnescaped 'a'),EscapedJChar (WhiteSpace CarriageReturn),UnescapedJChar (JCharUnescaped 'b'),UnescapedJChar (JCharUnescaped 'c')]) :: JString)+-- >>> toLazyText $ jStringBuilder ((JString' $ V.fromList [UnescapedJChar (JCharUnescaped 'a'),EscapedJChar (WhiteSpace CarriageReturn),UnescapedJChar (JCharUnescaped 'b'),UnescapedJChar (JCharUnescaped 'c')]) :: JString) -- "\"a\\rbc\"" ----- >>> BB.toLazyByteString $ jStringBuilder ((JString' $ V.fromList [UnescapedJChar (JCharUnescaped 'a'),EscapedJChar (WhiteSpace CarriageReturn),UnescapedJChar (JCharUnescaped 'b'),UnescapedJChar (JCharUnescaped 'c'),EscapedJChar (Hex (HexDigit4 HeXDigita HeXDigitb HeXDigit1 HeXDigit2)),EscapedJChar (WhiteSpace NewLine),UnescapedJChar (JCharUnescaped 'd'),UnescapedJChar (JCharUnescaped 'e'),UnescapedJChar (JCharUnescaped 'f'),EscapedJChar QuotationMark]) :: JString)+-- >>> toLazyText $ jStringBuilder ((JString' $ V.fromList [UnescapedJChar (JCharUnescaped 'a'),EscapedJChar (WhiteSpace CarriageReturn),UnescapedJChar (JCharUnescaped 'b'),UnescapedJChar (JCharUnescaped 'c'),EscapedJChar (Hex (HexDigit4 HeXDigita HeXDigitb HeXDigit1 HeXDigit2)),EscapedJChar (WhiteSpace NewLine),UnescapedJChar (JCharUnescaped 'd'),UnescapedJChar (JCharUnescaped 'e'),UnescapedJChar (JCharUnescaped 'f'),EscapedJChar QuotationMark]) :: JString) -- "\"a\\rbc\\uab12\\ndef\\\"\"" ----- >>> BB.toLazyByteString $ jStringBuilder ((JString' $ V.singleton (UnescapedJChar (JCharUnescaped 'a'))) :: JString)+-- >>> toLazyText $ jStringBuilder ((JString' $ V.singleton (UnescapedJChar (JCharUnescaped 'a'))) :: JString) -- "\"a\"" ----- >>> BB.toLazyByteString $ jStringBuilder (JString' $ V.singleton (EscapedJChar ReverseSolidus) :: JString)+-- >>> toLazyText $ jStringBuilder (JString' $ V.singleton (EscapedJChar ReverseSolidus) :: JString) -- "\"\\\\\"" -- jStringBuilder :: JString- -> BB.Builder+ -> Builder jStringBuilder (JString' jcs) =- BB.charUtf8 '\"' <> foldMap jCharBuilder jcs <> BB.charUtf8 '\"'+ TB.singleton '\"' <> foldMap jCharBuilderTextL jcs <> TB.singleton '\"' --- | Prism between a 'JString' and 'Text'.------ JSON strings a wider range of encodings than 'Text' and to be consistent with--- the 'Text' type, these invalid types are replaced with a placeholder value.----textToJString :: Text -> JString-textToJString = JString' . Text.foldr (V.cons . utf8CharToJChar) V.empty+-- | Convert a 'String' to a 'JString'.+stringToJString :: String -> JString+stringToJString = JString' . foldr (V.cons . utf8CharToJChar) V.empty --- _JStringText :: Prism' JString Text--- _JStringText = prism--- ()--- (\j@(JString' v) -> note j $ Text.pack . V.toList <$> traverse jCharToUtf8Char v)
src/Waargonaut/Types/Json.hs view
@@ -62,11 +62,12 @@ import Data.Traversable (Traversable (..)) import Data.Tuple (uncurry) -import Data.ByteString.Builder (Builder)-import qualified Data.ByteString.Builder as BB import Data.Maybe (Maybe) import Data.Text (Text) +import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as TB+ import Text.Parser.Char (CharParsing, text) import Waargonaut.Types.JArray (JArray (..), jArrayBuilder,@@ -219,9 +220,9 @@ jTypesBuilder :: (WS -> Builder) -> JType WS Json- -> BB.Builder-jTypesBuilder s (JNull tws) = BB.stringUtf8 "null" <> s tws-jTypesBuilder s (JBool b tws) = BB.stringUtf8 (if b then "true" else "false") <> s tws+ -> Builder+jTypesBuilder s (JNull tws) = TB.fromText "null" <> s tws+jTypesBuilder s (JBool b tws) = TB.fromText (if b then "true" else "false") <> s tws jTypesBuilder s (JNum jn tws) = jNumberBuilder jn <> s tws jTypesBuilder s (JStr js tws) = jStringBuilder js <> s tws jTypesBuilder s (JArr js tws) = jArrayBuilder s waargonautBuilder js <> s tws
src/Waargonaut/Types/Whitespace.hs view
@@ -25,8 +25,8 @@ mapped, nearly, over, prism, prism', to, uncons, (^.), _2, _Wrapped) -import Data.ByteString.Builder (Builder)-import qualified Data.ByteString.Builder as BB+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as TB import Data.Vector (Vector) import qualified Data.Vector as V@@ -171,11 +171,11 @@ -- | Create a 'Data.ByteString.Builder' from a 'Whitespace' whitespaceBuilder :: Whitespace -> Builder-whitespaceBuilder Space = BB.charUtf8 ' '-whitespaceBuilder HorizontalTab = BB.charUtf8 '\t'-whitespaceBuilder LineFeed = BB.charUtf8 '\f'-whitespaceBuilder CarriageReturn = BB.charUtf8 '\r'-whitespaceBuilder NewLine = BB.charUtf8 '\n'+whitespaceBuilder Space = TB.singleton ' '+whitespaceBuilder HorizontalTab = TB.singleton '\t'+whitespaceBuilder LineFeed = TB.singleton '\f'+whitespaceBuilder CarriageReturn = TB.singleton '\r'+whitespaceBuilder NewLine = TB.singleton '\n' {-# INLINE whitespaceBuilder #-} -- | Reconstitute the given whitespace into its original form.
test/Decoder.hs view
@@ -96,7 +96,7 @@ r <- D.runDecode d parseBS (D.mkCursor j) Either.either- (\(e, _) -> assertBool "Incorrect Error - Expected KeyDecodeFailed" (e == D.KeyNotFound "bar") )+ (\(e, _) -> assertBool "Incorrect Error - Expected KeyDecodeFailed" (e == D.KeyNotFound "bar")) (\_ -> assertFailure "Expected Error!") r @@ -184,10 +184,9 @@ decodeAltError = D.runDecode decodeEitherAlt parseBS (D.mkCursor "{\"foo\":33}") >>= Either.either (\(_,h) -> assertBool "BranchFail error not found in history" $- case Seq.viewr (unCursorHistory' h) of- _ Seq.:> (BranchFail _, _) -> True- _ -> False-+ case Seq.viewr (unCursorHistory' h) of+ _ Seq.:> (BranchFail _, _) -> True+ _ -> False ) (\_ -> assertFailure "Alt Error Test should fail")
test/Encoder.hs view
@@ -17,7 +17,7 @@ import Waargonaut.Encode (Encoder, Encoder') import qualified Waargonaut.Encode as E -import Data.ByteString.Lazy (ByteString)+import Data.Text.Lazy (Text) import Types.Common (Image (..), Overlayed (..), testFudge, testImageDataType)@@ -25,7 +25,7 @@ import Waargonaut.Generic (GWaarg, mkEncoder, proxy) import Waargonaut.Types.Json (oat) -testImageEncodedNoSpaces :: ByteString+testImageEncodedNoSpaces :: Text testImageEncodedNoSpaces = "{\"Width\":800,\"Height\":600,\"Title\":\"View from 15th Floor\",\"Animated\":false,\"IDs\":[116,943,234,38793]}" -- | The recommended way of defining an Encoder is to be explicit.@@ -37,13 +37,13 @@ . E.boolAt "Animated" (_imageAnimated img) . E.listAt E.int "IDs" (_imageIDs img) -testFudgeEncodedWithConsName :: ByteString+testFudgeEncodedWithConsName :: Text testFudgeEncodedWithConsName = "{\"fudgey\":\"Chocolate\"}" testOverlayed :: Overlayed testOverlayed = Overlayed "fred" testFudge -testOverlayedOut :: ByteString+testOverlayedOut :: Text testOverlayedOut = "{\"id\":\"fred\",\"fudgey\":\"Chocolate\"}" encodeOverlay :: Applicative f => Encoder f Overlayed@@ -56,7 +56,7 @@ :: TestName -> Encoder' a -> a- -> ByteString+ -> Text -> TestTree tCase nm enc a expected = testCase nm $ E.simplePureEncodeNoSpaces enc a @?= expected
test/Encoder/Laws.hs view
@@ -5,9 +5,9 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testProperty) -import Data.ByteString.Lazy (ByteString) import Data.Functor.Contravariant (contramap) import Data.Functor.Identity (Identity)+import Data.Text.Lazy (Text) import Hedgehog import qualified Hedgehog.Function as Fn@@ -18,7 +18,7 @@ import qualified Laws -runSE :: ShowEncoder a -> a -> ByteString+runSE :: ShowEncoder a -> a -> Text runSE (SE e) = E.simplePureEncodeNoSpaces e newtype ShowEncoder a = SE (Encoder Identity a)
test/Laws.hs view
@@ -154,7 +154,7 @@ ( Show a, Arg a, Vary a, Eq a , Show b, Arg b, Vary b , Show (f a), Eq (f a)- , Show (f a), Eq (f b)+ , Eq (f b) , Applicative f ) => (forall x. x -> f x)
test/Main.hs view
@@ -2,6 +2,8 @@ {-# LANGUAGE TupleSections #-} module Main (main) where +import GHC.Word (Word8)+ import Control.Lens (( # ), (^.), (^?), _2) import qualified Control.Lens as L import Control.Monad (when)@@ -10,16 +12,19 @@ import qualified Data.Scientific as Sci -import Data.ByteString (ByteString)-import qualified Data.ByteString.Builder as BB-import qualified Data.ByteString.Char8 as BS8-import qualified Data.ByteString.Lazy.Char8 as BSL8-+import Data.Functor.Contravariant ((>$<)) import Data.Maybe (fromMaybe) import Data.Semigroup ((<>)) import Data.Text (Text)+import qualified Data.Text as Text import qualified Data.Text.Encoding as Text+import qualified Data.Text.IO as Text +import qualified Data.Text.Lazy as TextL+import qualified Data.Text.Lazy.Builder as TB++import qualified Data.ByteString as BS+ import qualified Data.Sequence as S import Hedgehog@@ -65,17 +70,9 @@ encodeText :: Json -> Text-encodeText =- Text.decodeUtf8 .- encodeByteString--encodeByteString- :: Json- -> ByteString-encodeByteString =- BSL8.toStrict .- BB.toLazyByteString .- W.waargonautBuilder WS.wsBuilder+encodeText = TextL.toStrict+ . TB.toLazyText+ . W.waargonautBuilder WS.wsBuilder decode :: Text@@ -162,12 +159,15 @@ maxI :: Integer maxI = 2 ^ (32 :: Integer) +simpleDecodeWith :: D.Decoder L.Identity a -> TextL.Text -> Either (DecodeError, D.CursorHistory) a+simpleDecodeWith d = D.simpleDecode d Common.parseBS . Text.encodeUtf8 . TextL.toStrict+ prop_tripping_int_list :: Property prop_tripping_int_list = property $ do xs <- forAll . Gen.list (Range.linear 0 100) $ Gen.int (Range.linear 0 9999) tripping xs (E.simplePureEncodeNoSpaces (E.traversable E.int))- (D.simpleDecode (D.list D.int) Common.parseBS . BSL8.toStrict)+ (simpleDecodeWith (D.list D.int)) prop_tripping_image_record_generic :: Property prop_tripping_image_record_generic = withTests 1 . property $@@ -210,7 +210,7 @@ where trippin' a = tripping a (E.simplePureEncodeNoSpaces enc)- (D.simpleDecode dec Common.parseBS . BSL8.toStrict)+ (simpleDecodeWith dec) enc = E.maybeOrNull' . E.mapLikeObj' . E.atKey' "boop" $ E.maybeOrNull' (E.mapLikeObj' (E.atKey' "beep" E.bool'))@@ -241,11 +241,11 @@ , testProperty "print . parse . print = print" prop_print_parse_print_id ] -parsePrint :: ByteString -> Either DecodeError ByteString-parsePrint = fmap encodeByteString . decode . Text.decodeUtf8+parsePrint :: Text -> Either DecodeError Text+parsePrint = fmap encodeText . decode -readTestFile :: FilePath -> IO ByteString-readTestFile fp = BS8.readFile ("test/json-data" <> "/" <> fp)+readTestFile :: FilePath -> IO Text+readTestFile fp = Text.readFile ("test/json-data" <> "/" <> fp) testFile :: FilePath -> Assertion testFile fp = do@@ -272,6 +272,29 @@ , "numbers.json" ] +mishandlingOfCharVsUtf8Bytes :: TestTree+mishandlingOfCharVsUtf8Bytes = testCaseSteps "Mishandling of UTF-8 Bytes vs Haskell Char" $ \step -> do+ let+ valChar = '\128' :: Char+ valText = "\128" :: Text+ valStr = [valChar] :: String+ encVal = "\"\128\"" :: Text+ valUtf8Bytes = [34,194,128,34] :: [Word8]++ step "Pack String to Text"+ Text.pack valStr @?= valText++ step "Encoder via Text"+ x <- TextL.toStrict <$> E.simpleEncodeNoSpaces E.text valText+ x @?= encVal++ step "encoder output ~ packed bytes"+ Text.encodeUtf8 x @?= BS.pack valUtf8Bytes++ step "Decoder via Text"+ y <- D.runDecode D.text Common.parseBS (D.mkCursor (Text.encodeUtf8 x))+ y @?= Right valText+ regressionTests :: TestTree regressionTests = testGroup "Regression Tests - Failure to parse = Success" (toTestFail <$> fs)@@ -290,10 +313,37 @@ , tripping_properties , unitTests , regressionTests+ , mishandlingOfCharVsUtf8Bytes , Decoder.decoderTests , Encoder.encoderTests , Decoder.Laws.decoderLaws , Encoder.Laws.encoderLaws++ , testGroup "text gen - text e/d"+ [ testProperty "unicode" $ p Gen.text Gen.unicode E.text D.text+ , testProperty "latin1" $ p Gen.text Gen.latin1 E.text D.text+ , testProperty "ascii" $ p Gen.text Gen.ascii E.text D.text+ ]+ , testGroup "bytestring gen - via text e/d"+ [ testProperty "unicode" $ p Gen.utf8 Gen.unicode bsE bsD+ , testProperty "latin1" $ p Gen.utf8 Gen.latin1 bsE bsD+ , testProperty "ascii" $ p Gen.utf8 Gen.ascii bsE bsD+ ] ]+ where+ bsE = Text.decodeUtf8 >$< E.text+ bsD = Text.encodeUtf8 <$> D.text++ p :: ( Eq a+ , Show a+ )+ => (Range Int -> Gen Char -> Gen a)+ -> Gen Char+ -> E.Encoder' a+ -> D.Decoder L.Identity a+ -> Property+ p f g e d = property $ do+ inp <- forAll $ f (Range.linear 0 1000) g+ tripping inp (E.simplePureEncodeNoSpaces e) (simpleDecodeWith d)
test/Types/Common.hs view
@@ -17,7 +17,6 @@ , hexadecimalDigitLower , prop_generic_tripping- , parseWith , parseBS , parseText @@ -37,7 +36,7 @@ import Generics.SOP (Generic, HasDatatypeInfo) import qualified GHC.Generics as GHC -import Control.Lens (makeClassy, over, _Left)+import Control.Lens (makeClassy) import Control.Monad ((>=>)) import Data.Functor.Identity (Identity)@@ -45,18 +44,19 @@ import Data.List.NonEmpty (NonEmpty) import Data.Maybe (fromMaybe) import Data.Text (Text)-import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text++import qualified Data.Text.Lazy as TextL+ import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy.Char8 as BSL8 import qualified Data.Attoparsec.ByteString as AB import qualified Data.Attoparsec.Text as AT-import Data.Attoparsec.Types (Parser) import Data.Tagged (Tagged) import qualified Data.Tagged as T@@ -69,7 +69,7 @@ import qualified Waargonaut.Decode as SD -import Waargonaut.Decode.Error (DecodeError (ParseFailed))+import Waargonaut.Decode.Error (DecodeError) import qualified Waargonaut.Encode as E import Waargonaut.Types (Json) import Waargonaut.Types.Whitespace (Whitespace (..))@@ -252,14 +252,11 @@ genText :: Gen Text genText = Gen.text ( Range.linear 0 100 ) Gen.unicodeAll -parseWith :: (Parser t a -> t -> Either String a) -> Parser t a -> t -> Either DecodeError a-parseWith f p = over _Left (ParseFailed . Text.pack . show) . f p- parseBS :: ByteString -> Either DecodeError Json-parseBS = parseWith AB.parseOnly parseWaargonaut+parseBS = SD.parseWith AB.parseOnly parseWaargonaut parseText :: Text -> Either DecodeError Json-parseText = parseWith AT.parseOnly parseWaargonaut+parseText = SD.parseWith AT.parseOnly parseWaargonaut prop_generic_tripping :: ( MonadTest m@@ -272,4 +269,4 @@ -> m () prop_generic_tripping e d a = tripping a (E.simplePureEncodeNoSpaces (T.untag e))- (SD.runPureDecode (T.untag d) parseBS . SD.mkCursor . BSL8.toStrict)+ (SD.runPureDecode (T.untag d) parseBS . SD.mkCursor . Text.encodeUtf8 . TextL.toStrict)
test/Utils.hs view
@@ -12,16 +12,15 @@ import Data.Attoparsec.Text (Parser, anyChar, endOfInput, parseOnly) +import Waargonaut.Decode (parseWith) import Waargonaut.Decode.Error (DecodeError) -import Types.Common (parseWith)- testparse :: Parser a -> Text -> Either DecodeError a-testparse =- parseWith parseOnly+testparse p =+ parseWith parseOnly p testparsetheneof :: Parser a
waargonaut.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.4.2.0+version: 0.5.0.0 -- A short (one-line) description of the package. synopsis: JSON wrangling@@ -60,8 +60,8 @@ tested-with: GHC==7.10.3 , GHC==8.0.2 , GHC==8.2.2- , GHC==8.4.3- , GHC==8.6.1+ , GHC==8.4.4+ , GHC==8.6.2 custom-setup setup-depends: base >= 4 && <5@@ -96,6 +96,7 @@ , Waargonaut.Encode , Waargonaut.Generic+ , Waargonaut.Test , Waargonaut @@ -103,8 +104,8 @@ -- Other library packages from which modules are imported. build-depends: base >= 4.7 && < 4.13- , lens >= 4.15 && < 5- , mtl >= 2.2.2 && < 3+ , lens >= 4.15 && < 4.18+ , mtl >= 2.2.2 && < 2.3 , text >= 1.2 && < 1.3 , bytestring >= 0.10.6 && < 0.11 , parsers >= 0.12 && < 0.13@@ -115,15 +116,15 @@ , nats >= 1 && <1.2 , zippers >= 0.2 && < 0.3 , vector >= 0.12 && < 0.13- , errors >= 2.2 && < 3+ , errors >= 2.2 && < 2.4 , hoist-error >= 0.2 && < 0.3 , containers >= 0.5.6 && < 0.7- , witherable >= 0.2 && < 0.3+ , witherable >= 0.2 && < 0.4 , generics-sop >= 0.3.2 && < 0.4- , mmorph >= 1.1 && < 2+ , mmorph >= 1.1 && < 1.2 , transformers >= 0.4 && < 0.6- , bifunctors >= 5 && < 6- , contravariant >= 1.4 && < 2+ , bifunctors >= 5 && < 5.6+ , contravariant >= 1.4 && < 1.6 , wl-pprint-annotated >= 0.1 && < 0.2 , hw-json >= 0.9.0.1 && < 0.10 , hw-prim >= 0.6 && < 0.7@@ -131,8 +132,8 @@ , hw-rankselect >= 0.10 && < 0.13 , hw-bits >= 0.7 && < 0.8 , tagged >= 0.8.6 && < 0.9- , semigroupoids >= 5.2.2 && < 6- , natural >= 0.3 && < 4+ , semigroupoids >= 5.2.2 && < 5.4+ , natural >= 0.3 && < 0.4 -- Directories containing source files. hs-source-dirs: src@@ -180,13 +181,13 @@ hs-source-dirs: test build-depends: base >= 4.7 && < 4.13- , tasty >= 0.11 && < 2+ , tasty >= 0.11 && < 1.2 , tasty-hunit >= 0.10 && < 0.11 , tasty-expected-failure >= 0.11 && < 0.12 , hedgehog >= 0.6 && < 0.7 , hedgehog-fn >= 0.6 && < 0.7 , tasty-hedgehog >= 0.2 && < 0.3- , lens >= 4.15 && < 5+ , lens >= 4.15 && < 4.18 , distributive >= 0.5 && < 0.7 , bytestring >= 0.10.6 && < 0.11 , digit >= 0.7 && < 0.8@@ -198,11 +199,11 @@ , attoparsec >= 0.13 && < 0.15 , scientific >= 0.3 && < 0.4 , tagged >= 0.8.6 && < 0.9- , mtl >= 2.2.2 && < 3- , semigroupoids >= 5.2.2 && < 6+ , mtl >= 2.2.2 && < 2.3+ , semigroupoids >= 5.2.2 && < 5.6 , containers >= 0.5.6 && < 0.7- , natural >= 0.3 && < 4- , contravariant >= 1.4 && < 2+ , natural >= 0.3 && < 0.4+ , contravariant >= 1.4 && < 1.6 , waargonaut