diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,36 @@ # Revision history for waargonaut +## 0.8.0.0 -- 2019-09-04 + +* Add `onObj'` which is just `onObj` but specialised to `Identity`. + +* Add `gObjEncoder` for deriving `ObjEncoder` structures for record types only. Using the + `IsRecord` constraint from `record-sop` package. This makes it easier to leverage the + Contravariant functionality of the `ObjEncoder` without losing the benefits of deriving + more trivial encoders. + +* Added the `FieldNameAsKey` option to the newtype options for generic derived enc/decoders. + +* Fixes #69 by removing duplicate call to `_optionsFieldName` function. Added regression test. + +* Improved the handling of newtype options for generic deriving to give a bit more + flexibility and avoid strangeness with respect to some combinations of options. + +* Change the building of escaped whitespace chars to actually use the + `escapedWhitespaceChar` function, instead of incorrectly generating an unescaped + character. + +* Add haddock to gObjEncoder function + +* Correctly bump version to 0.8.0.0 as this is a breaking change because of new + constructors on an exported sum type. + +* Remove some commented out code. + +* Add a better failure message to "impossible" error case. + +* Regenerate nix after cabal file changes + ## 0.6.1.0 -- 2019-02-27 * Add `passKeysToValues` decoder for decoding JSON objects where the key should diff --git a/src/Waargonaut.hs b/src/Waargonaut.hs --- a/src/Waargonaut.hs +++ b/src/Waargonaut.hs @@ -52,7 +52,7 @@ -- } -- @ -- --- We'll need to import the 'Decode' module. You may of course use whatever import scheme you like, +-- We'll need to import the @Waargonaut.Decode@ module. You may of course use whatever import scheme you like, -- I prefer this method: -- -- @ @@ -60,37 +60,39 @@ -- import qualified Waargonaut.Decode as D -- @ -- --- The 'Waargonaut.Decode.Decoder' is based upon a data structure called a 'zipper'. This allows us +-- The 'Waargonaut.Decode.Decoder' is based upon a data structure called a "zipper". This allows us -- to move around the JSON structure using arbitrary movements. Such as -- 'Waargonaut.Decode.moveRight1' to move from a key on an object to the value at that key. Or -- 'Waargonaut.Decode.down' to move into the first element of an array or object. Waargonaut -- provides a suite of these functions to move around and dissect the JSON input. -- --- This zipper is combined with a 'StateT' transformer that maintains a history of your movements. +-- This zipper is combined with a 'Control.Monad.State.StateT' transformer that maintains a history +-- of your movements. +-- -- So if the JSON input is not as your 'Waargonaut.Decode.Decoder' expects you are given a complete -- path to where things went awry. -- -- Decoding a JSON value is done by moving the cursor to specific points of interest, then focusing -- on that point with a 'Waargonaut.Decode.Decoder' of the desired value. -- --- NB: The 'Monad' constraint is provided as a flexibility for more interesting and nefarious uses +-- NB: The "Monad" constraint is provided as a flexibility for more interesting and nefarious uses -- of 'Waargonaut.Decode.Decoder'. -- --- Here is the 'Waargonaut.Decode.Decoder' for our 'Person' data type. It will help to turn on the --- 'OverloadedStrings' language pragma as these functions expect 'Data.Text.Text' input. +-- Here is the 'Waargonaut.Decode.Decoder' for our @Person@ data type. It will help to turn on the +-- @OverloadedStrings@ language pragma as these functions expect 'Data.Text.Text' input. -- -- @ -- personDecoder :: Monad f => Decoder f Person -- personDecoder = D.withCursor $ \\c -> do -- o <- D.down c --- name <- D.fromKey "name" D.text o --- age <- D.fromKey "age" D.int o --- addr <- D.fromKey "address" D.text o --- lotto <- D.fromKey "numbers" (D.list D.int) o +-- name <- D.fromKey \"name\" D.text o +-- age <- D.fromKey \"age\" D.int o +-- addr <- D.fromKey \"address\" D.text o +-- lotto <- D.fromKey \"numbers\" (D.list D.int) o -- pure $ Person name age addr lotto -- @ -- --- The 'Waargonaut.Decode.withCursor' function provides our cursor: 'c'. We then move +-- The 'Waargonaut.Decode.withCursor' function provides our cursor: "c". We then move -- 'Waargonaut.Decode.down' into the JSON object. The reasons for this are: -- -- * The initial cursor position is always at the very beginning of the input. On freshly indexed @@ -125,10 +127,10 @@ -- @ -- personDecoder2 :: Monad f => Decoder f Person -- personDecoder2 = Person --- \<$> D.atKey "name" D.text --- \<*> D.atKey "age" D.int --- \<*> D.atKey "address" D.text --- \<*> D.atKey "numbers" (D.list D.int) +-- \<$> D.atKey \"name\" D.text +-- \<*> D.atKey \"age\" D.int +-- \<*> D.atKey \"address\" D.text +-- \<*> D.atKey \"numbers\" (D.list D.int) -- @ -- -- Using the 'Waargonaut.Decode.atKey' function which tries to handle those basic movements for us @@ -140,10 +142,10 @@ -- @ -- -- The next part is being able to apply our 'Waargonaut.Decode.Decoder' to some input. Assuming we --- have some input 'in'. We want to pass it through our 'personDecoder' for a result. Waargonaut uses +-- have some input. We want to pass it through our @personDecoder@ for a result. Waargonaut uses -- the package to define its parser. This -- allows you to choose your own favourite parsing library to do the heavy lifting. Provided it --- implements the right typeclasses from 'parsers'. +-- implements the right typeclasses from the @parsers@ package. -- -- To apply a 'Waargonaut.Decode.Decoder' to some input you will need one of the -- decoder running functions from 'Waargonaut.Decode'. There are a few different @@ -164,8 +166,8 @@ -- -- -- As well as a parsing function from your parsing library of choice, that also --- has an implementation of the 'CharParsing' typeclass from 'parsers'. We will --- use 'attoparsec' in the examples below. +-- has an implementation of the 'Text.Parser.Char.CharParsing' typeclass from @parsers@. We will +-- use @attoparsec@ in the examples below. -- -- @ -- import qualified Data.Attoparsec.ByteString as AB @@ -175,14 +177,14 @@ -- decodeFromByteString AB.parseOnly personDecode inp -- @ -- --- Which will run the 'personDecode' 'Waargonaut.Decode.Decoder' using the parsing function --- (@AB.parseOnly@), starting at the cursor from the top of the 'inp' input. +-- Which will run the @personDecode@ 'Waargonaut.Decode.Decoder' using the parsing function +-- (@AB.parseOnly@), starting at the cursor from the top of the @inp@ input. -- --- Again the 'Monad' constraint is there so that you have more options available for utilising the +-- Again the 'Control.Monad.Monad' constraint is there so that you have more options available for utilising the -- 'Waargonaut.Decode.Decoder' in ways we haven't thought of. -- --- Or if you don't need the 'Monad' constraint then you may use 'Waargonaut.Decode.pureDecodeFromByteString'. --- This function specialises the 'Monad' constraint to 'Data.Functor.Identity'.: +-- Or if you don't need the 'Control.Monad.Monad' constraint then you may use 'Waargonaut.Decode.pureDecodeFromByteString'. +-- This function specialises the 'Control.Monad.Monad' constraint to 'Data.Functor.Identity'.: -- -- @ -- pureDecodeFromByteString @@ -200,11 +202,11 @@ -- pureDecodeFromByteString AB.parseOnly personDecode inp -- @ -- --- Waargonaut provides some default implementations using the package in the 'Waargonaut.Attoparsec' module. These functions have exactly the same behaviour as the functions above, without the need to provide the parsing function. +-- Waargonaut provides some default implementations using the package in the @Waargonaut.Attoparsec@ module. These functions have exactly the same behaviour as the functions above, without the need to provide the parsing function. -- $basicencode -- --- To create an 'Waargonaut.Encode.Encoder' for our 'Person' record, we will encode it as a "map +-- To create an 'Waargonaut.Encode.Encoder' for our @Person@ record, we will encode it as a "map -- like object", that is we have decided that there are no duplicate keys allowed. We can then use -- the following functions to build up the structure we want: -- @@ -235,7 +237,7 @@ -- @ -- -- These types may seem pretty wild, but their usage is mundane. The 'Waargonaut.Encode.mapLikeObj' --- function is used when we want to encode some particular type 'i' as a JSON object. In such a way +-- function is used when we want to encode some particular type @i@ as a JSON object. In such a way -- as to prevent duplicate keys from appearing. The 'Waargonaut.Encode.atKey' function is designed -- such that it can be composed with itself to build up an object with multiple keys. -- @@ -278,7 +280,7 @@ -- simplePureEncodeByteStringNoSpaces :: Encoder' a -> a -> ByteString -- @ -- --- The latter functions specialise the 'f' to be 'Data.Functor.Identity'. +-- The latter functions specialise the @f@ to be 'Data.Functor.Identity'. -- -- Then, like the use of the 'Waargonaut.Decode.Decoder' you select the 'Waargonaut.Encode.Encoder' -- you wish to use and run it against a value of a matching type: diff --git a/src/Waargonaut/Attoparsec.hs b/src/Waargonaut/Attoparsec.hs --- a/src/Waargonaut/Attoparsec.hs +++ b/src/Waargonaut/Attoparsec.hs @@ -5,9 +5,9 @@ -- different parsing libraries, depending on your needs. This module provides -- some convenient defaults using the package. -- --- These functions are implemented using the 'decodeFromX' functions in the --- 'Waargonaut.Decode' module. They use the @parseOnly@ function, from either --- the @Text@ or @ByteString@ attoparsec modules. +-- These functions are implemented using the @decodeFromX@ functions in the +-- @Waargonaut.Decode@ module. They use the @parseOnly@ function, from either +-- the 'Data.Attoparsec.Text' or 'Data.Attoparsec.ByteString' attoparsec modules. -- module Waargonaut.Attoparsec ( -- * Decoders diff --git a/src/Waargonaut/Decode.hs b/src/Waargonaut/Decode.hs --- a/src/Waargonaut/Decode.hs +++ b/src/Waargonaut/Decode.hs @@ -10,11 +10,182 @@ -- -- Types and Functions for turning JSON into Haskell. -- +-- We will work through a basic example, using the following type: +-- +-- @ +-- data Person = Person +-- { _personName :: Text +-- , _personAge :: Int +-- , _personAddress :: Text +-- , _personFavouriteLotteryNumbers :: [Int] +-- } +-- deriving (Eq, Show) +-- @ +-- +-- Expect the following JSON as input: +-- +-- @ +-- { \"name\": \"Krag\" +-- , \"age\": 88 +-- , \"address\": \"Red House 4, Three Neck Lane, Greentown.\" +-- , \"numbers\": [86,3,32,42,73] +-- } +-- @ +-- +-- We'll need to import the 'Waargonaut.Decode' module. You may of course use whatever import scheme you like, +-- I prefer this method: +-- +-- @ +-- import Waargonaut.Decode (Decoder) +-- import qualified Waargonaut.Decode as D +-- @ +-- +-- The 'Waargonaut.Decode.Decoder' is based upon a data structure called a @zipper@. This allows us +-- to move around the JSON structure using arbitrary movements. Such as +-- 'Waargonaut.Decode.moveRight1' to move from a key on an object to the value at that key. Or +-- 'Waargonaut.Decode.down' to move into the first element of an array or object. Waargonaut +-- provides a suite of these functions to move around and dissect the JSON input. +-- +-- This zipper is combined with a 'Control.Monad.State.StateT' transformer that maintains a history of your movements. +-- So if the JSON input is not as your 'Waargonaut.Decode.Decoder' expects you are given a complete +-- path to where things went awry. +-- +-- Decoding a JSON value is done by moving the cursor to specific points of interest, then focusing +-- on that point with a 'Waargonaut.Decode.Decoder' of the desired value. +-- +-- NB: The "Monad" constraint is provided as a flexibility for more interesting and nefarious uses +-- of 'Waargonaut.Decode.Decoder'. +-- +-- Here is the 'Waargonaut.Decode.Decoder' for our @Person@ data type. It will help to turn on the +-- @OverloadedStrings@ language pragma as these functions expect 'Data.Text.Text' input. +-- +-- @ +-- personDecoder :: Monad f => Decoder f Person +-- personDecoder = D.withCursor $ \\c -> do +-- o <- D.down c +-- name <- D.fromKey "name" D.text o +-- age <- D.fromKey "age" D.int o +-- addr <- D.fromKey "address" D.text o +-- lotto <- D.fromKey "numbers" (D.list D.int) o +-- pure $ Person name age addr lotto +-- @ +-- +-- The 'Waargonaut.Decode.withCursor' function provides our cursor: @c@. We then move +-- 'Waargonaut.Decode.down' into the JSON object. The reasons for this are: +-- +-- * The initial cursor position is always at the very beginning of the input. On freshly indexed +-- JSON input, using our example, the cursor will be at: +-- +-- @ +-- \{ \"name\": \"Krag\" +-- , \"age\": 88 +-- ... +-- @ +-- +-- * Because of the above reason, our decoder makes an assumption about the placement of the cursor +-- on the JSON input. This sort of assumption is reasonable for reasons we will go over later. +-- +-- The cursor output from 'Waargonaut.Decode.down' will located here: +-- +-- @ +-- { \\"name\": \"Krag\" +-- , \"age\": 88 +-- ... +-- @ +-- +-- Then we use one of the helper functions, 'Waargonaut.Decode.fromKey' to find the "key - value" +-- pair that we're interested in and decode it for us: +-- +-- @ +-- fromKey :: Monad f => Text -> Decoder f b -> JCurs -> DecodeResult f b +-- @ +-- +-- We could also write this 'Waargonaut.Decode.Decoder' as: +-- +-- @ +-- personDecoder2 :: Monad f => Decoder f Person +-- personDecoder2 = Person +-- \<$> D.atKey \"name\" D.text +-- \<*> D.atKey \"age\" D.int +-- \<*> D.atKey \"address\" D.text +-- \<*> D.atKey \"numbers\" (D.list D.int) +-- @ +-- +-- Using the 'Waargonaut.Decode.atKey' function which tries to handle those basic movements for us +-- and has those assumptions included. Very useful for when the JSON input closely mirrors your data +-- structure. +-- +-- @ +-- atKey :: Monad f => Text -> Decoder f a -> Decoder f a +-- @ +-- +-- The next part is being able to apply our 'Waargonaut.Decode.Decoder' to some input. Assuming we +-- have some input. We want to pass it through our @personDecoder@ for a result. Waargonaut uses +-- the package to define its parser. This +-- allows you to choose your own favourite parsing library to do the heavy lifting. Provided it +-- implements the right typeclasses from the @parsers@ package. +-- +-- To apply a 'Waargonaut.Decode.Decoder' to some input you will need one of the +-- decoder running functions from 'Waargonaut.Decode'. There are a few different +-- functions provided for some of the common input text-like types.: +-- +-- @ +-- decodeFromByteString +-- :: ( CharParsing f +-- , Monad f +-- , Monad g +-- , Show e +-- ) +-- => (forall a. f a -> ByteString -> Either e a) +-- -> Decoder g x +-- -> ByteString +-- -> g (Either (DecodeError, CursorHistory) x) +-- @ +-- +-- +-- As well as a parsing function from your parsing library of choice, that also +-- has an implementation of the 'Text.Parser.Char.CharParsing' typeclass from @parsers@. We will +-- use @attoparsec@ in the examples below. +-- +-- @ +-- import qualified Data.Attoparsec.ByteString as AB +-- @ +-- +-- @ +-- decodeFromByteString AB.parseOnly personDecode inp +-- @ +-- +-- Which will run the @personDecode@ 'Waargonaut.Decode.Decoder' using the parsing function +-- (@AB.parseOnly@), starting at the cursor from the top of the @inp@ input. +-- +-- Again the 'Control.Monad.Monad' constraint is there so that you have more options available for utilising the +-- 'Waargonaut.Decode.Decoder' in ways we haven't thought of. +-- +-- Or if you don't need the 'Control.Monad.Monad' constraint then you may use 'Waargonaut.Decode.pureDecodeFromByteString'. +-- This function specialises the 'Control.Monad.Monad' constraint to 'Data.Functor.Identity'.: +-- +-- @ +-- pureDecodeFromByteString +-- :: ( Monad f +-- , CharParsing f +-- , Show e +-- ) +-- => (forall a. f a -> ByteString -> Either e a) +-- -> Decoder Identity x +-- -> ByteString +-- -> Either (DecodeError, CursorHistory) x +-- @ +-- +-- @ +-- pureDecodeFromByteString AB.parseOnly personDecode inp +-- @ +-- +-- Waargonaut provides some default implementations using the package in the @Waargonaut.Attoparsec@ module. These functions have exactly the same behaviour as the functions above, without the need to provide the parsing function. module Waargonaut.Decode ( -- * Types CursorHistory - , SuccinctCursor + , Cursor , DecodeResult (..) , Decoder (..) , JCurs (..) @@ -165,8 +336,8 @@ import HaskellWorks.Data.Bits ((.?.)) import HaskellWorks.Data.TreeCursor (TreeCursor (..)) -import HaskellWorks.Data.Json.Backend.Standard.Cursor (JsonCursor (..)) -import qualified HaskellWorks.Data.Json.Backend.Standard.Cursor as JC +import HaskellWorks.Data.Json.Standard.Cursor.Fast (Cursor) +import qualified HaskellWorks.Data.Json.Standard.Cursor.Generic as JC import Waargonaut.Decode.Error (AsDecodeError (..), DecodeError (..), @@ -182,11 +353,10 @@ Decoder (..), JCurs (..), JsonType (..), - SuccinctCursor, jsonTypeAt, mkCursor) --- | Function to define a 'Decoder' for a specific data type. +-- | Function to define a 'Waargonaut.Decode.Decoder' for a specific data type. -- -- For example, given the following data type: -- @@ -200,8 +370,9 @@ -- } -- @ -- --- We can use 'withCursor' to write a decoder that will be given a cursor that --- we can use to build the data types that we need. +-- We can use 'Waargonaut.Decode.withCursor' to write a decoder that +-- will be given a cursor that we can use to build the data types that +-- we need. -- -- @ -- imageDecoder :: Monad f => Decoder f Image @@ -214,7 +385,7 @@ -- @ -- -- It's up to you to provide a cursor that is at the correct position for a --- 'Decoder' to operate, but building decoders in this way simplifies creating +-- 'Waargonaut.Decode.Decoder' to operate, but building decoders in this way simplifies creating -- decoders for larger structures, as the smaller pieces contain fewer -- assumptions. This encourages greater reuse of decoders and simplifies the -- debugging process. @@ -228,10 +399,10 @@ -- | Lens for accessing the 'rank' of the 'JsonCursor'. The 'rank' forms part of -- the calculation that is the cursors current position in the index. -- -cursorRankL :: Lens' (JsonCursor s i p) Count -cursorRankL = lens JC.cursorRank (\c r -> c { cursorRank = r }) +cursorRankL :: Lens' Cursor Count +cursorRankL = lens JC.cursorRank (\c r -> c { JC.cursorRank = r }) --- | Execute the given function 'n' times'. +-- | Execute the given function @n@ times. manyMoves :: Monad m => Natural -> (b -> m b) -> b -> m b manyMoves i g = foldl (>=>) pure (replicate i g) @@ -245,7 +416,7 @@ -- successful. moveCursBasic :: Monad f - => (SuccinctCursor -> Maybe SuccinctCursor) + => (Cursor -> Maybe Cursor) -> ZipperMove -> JCurs -> DecodeResult f JCurs @@ -326,7 +497,7 @@ then pure $ c & _Wrapped . cursorRankL .~ newRank else throwing _InputOutOfBounds newRank --- | Move the cursor rightwards 'n' times. +-- | Move the cursor rightwards @n@ times. -- -- Starting position: -- @@ -374,7 +545,7 @@ in setRank <$> BP.findOpen (JC.balancedParens c) prev InputOutOfBounds prev --- | Move the cursor leftwards 'n' times. +-- | Move the cursor leftwards @n@ times. moveLeftN :: Monad f => Natural @@ -498,8 +669,8 @@ -- -- myRecDecoder :: Decoder f MyRec -- myRecDecoder = MyRec --- \<$> atKey "field_a" text --- \<*> atKey "field_b" int +-- \<$> atKey \"field_a\" text +-- \<*> atKey \"field_b\" int -- @ -- atKey @@ -534,7 +705,7 @@ -- it could be decoded as follows: -- -- @ --- join \<$> atKeyOptional "key" (maybeOrNull text) +-- join \<$> atKeyOptional \"key\" (maybeOrNull text) -- @ atKeyOptional :: Monad f @@ -568,7 +739,7 @@ -- withType JsonTypeArray d -- @ -- --- 'd' will only be entered if the cursor at the current position is a JSON +-- @d@ will only be entered if the cursor at the current position is a JSON -- array: '[]'. -- withType @@ -675,9 +846,9 @@ -- -- decodeMyEnum :: Monad f => Decoder f MyEnum -- decodeMyEnum = D.oneOf D.text \"MyEnum\" --- [ ("a", A) --- , ("b", B) --- , ("c", C) +-- [ (\"a\", A) +-- , (\"b\", B) +-- , (\"c\", C) -- ] -- -- decodeMyEnumFromInt :: Monad f => Decoder f MyEnum @@ -704,7 +875,7 @@ err = throwing _ConversionFailure l -- | From the current cursor position, move leftwards one position at a time and --- push each 'a' onto the front of some 'Cons' structure. +-- push each @a@ onto the front of some 'Cons' structure. leftwardCons :: ( Monad f , Cons s s a a @@ -717,7 +888,7 @@ foldCursor (flip cons) moveLeft1 -- | From the current cursor position, move rightwards one position at a time, --- and append the 'a' to some 'Snoc' structure. +-- and append the @a@ to some 'Snoc' structure. rightwardSnoc :: ( Monad f , Snoc s s a a @@ -815,7 +986,7 @@ bool :: Monad f => Decoder f Bool bool = atCursor "bool" DI.bool' --- | Given a 'Decoder' for 'a', attempt to decode a 'NonEmpty' list of 'a' at +-- | Given a 'Decoder' for @a@, attempt to decode a 'NonEmpty' list of @a@ at -- the current cursor position. nonemptyAt :: Monad f @@ -832,7 +1003,7 @@ nonempty :: Monad f => Decoder f a -> Decoder f (NonEmpty a) nonempty d = withCursor (nonemptyAt d) --- | Like 'nonemptyAt', this takes a 'Decoder' of 'a' and at the given cursor +-- | Like 'nonemptyAt', this takes a 'Decoder' of @a@ and at the given cursor -- will try to decode a '[a]'. listAt :: Monad f @@ -877,7 +1048,7 @@ withDefault def hasD = fromMaybe def <$> hasD --- | Named to match it's 'Encoder' counterpart, this function will decode an +-- | Named to match it's 'Waargonaut.Encode.Encoder' counterpart, this function will decode an -- optional value. maybeOrNull :: Monad f @@ -886,7 +1057,7 @@ maybeOrNull a = (Just <$> a) (Nothing <$ null) --- | Decode either an 'a' or a 'b', failing if neither 'Decoder' succeeds. The +-- | Decode either an @a@ or a @b@, failing if neither 'Decoder' succeeds. The -- 'Right' decoder is attempted first. either :: Monad f diff --git a/src/Waargonaut/Decode/Error.hs b/src/Waargonaut/Decode/Error.hs --- a/src/Waargonaut/Decode/Error.hs +++ b/src/Waargonaut/Decode/Error.hs @@ -11,7 +11,7 @@ import GHC.Word (Word64) -import HaskellWorks.Data.Json.Type (JsonType) +import HaskellWorks.Data.Json.Standard.Cursor.Type (JsonType) import Data.Text (Text) @@ -40,7 +40,7 @@ | ParseFailed Text deriving (Show, Eq) --- | Describes the sorts of errors that may be treated as a 'DecodeError', for use with 'lens'. +-- | Describes the sorts of errors that may be treated as a 'DecodeError', for use with 'Control.Lens.Prism's. class AsDecodeError r where _DecodeError :: Prism' r DecodeError _ConversionFailure :: Prism' r Text diff --git a/src/Waargonaut/Decode/Internal.hs b/src/Waargonaut/Decode/Internal.hs --- a/src/Waargonaut/Decode/Internal.hs +++ b/src/Waargonaut/Decode/Internal.hs @@ -97,9 +97,6 @@ DecodeError (..)) import Waargonaut.Decode.ZipperMove (ZipperMove (..), ppZipperMove) -import Waargonaut.Encode.Builder (bsBuilder) -import Waargonaut.Encode.Builder.JChar (jCharBuilder) --- | -- Track the history of the cursor as we move around the zipper. -- -- It is indexed over the type of the index used to navigate the zipper. @@ -156,7 +153,7 @@ compressHistory = L.over _Wrapped (fromList . L.transform (combineLRMoves . rmKeyJumps) . F.toList) -- | --- Pretty print the given 'CursorHistory'' to a more useful format compared to a 'Seq' of 'i'. +-- Pretty print the given 'CursorHistory'' to a more useful format compared to a 'Seq' of @i@. ppCursorHistory :: CursorHistory' i -> Doc a @@ -210,7 +207,7 @@ . runExceptT . runDecodeResult -- | --- Wrapper type to describe a "Decoder" from something that has a 'Json'ish +-- Wrapper type to describe a "Decoder" from something that has a "Json"ish -- value @c@, to some representation of @a@. -- newtype Decoder' c i e f a = Decoder' @@ -236,7 +233,7 @@ -- Helper function for constructing a 'Decoder''. -- -- This function is used by the implemented decoders to simplify constructing a --- more specific 'Decoder' type. +-- more specific 'Decoder'' type. -- -- @ -- withCursor' $ \curs -> @@ -251,7 +248,7 @@ Decoder' -- | --- Execute a given 'DecoderResultT'. +-- Execute a given 'Waargonaut.Decode.Internal.DecoderResultT'. -- -- If you're building your own decoder structure, this function will take care -- of the 'CursorHistory'' and error handling (via 'ExceptT'). @@ -274,14 +271,14 @@ recordZipperMove dir i = L._Wrapped %= (`L.snoc` (dir, i)) -- | --- Attempt a 'Decoder' action that might fail and return a 'Maybe' value +-- Attempt a 'Waargonaut.Decode.Internal.Decoder' action that might fail and return a 'Maybe' value -- instead. -- try :: MonadError e m => m a -> m (Maybe a) try d = catchError (pure <$> d) (const (pure Nothing)) -- | --- Build the basis for a 'Decoder' based on a 'Prism''. +-- Build the basis for a 'Waargonaut.Decode.Internal.Decoder' based on a 'Control.Lens.Prism''. -- prismDOrFail' :: ( AsDecodeError e @@ -295,24 +292,28 @@ prismDOrFail' e p d c = runDecoder' (L.preview p <$> d) c e --- | Try to decode a 'Text' value from some 'Json' or value. This will fail if +-- | Try to decode a 'Text' value from some 'Waargonaut.Types.Json.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 . _JStringText) --- | Try to decode a 'String' value from some 'Json' or value. +-- | Try to decode a 'String' value from some 'Waargonaut.Types.Json.Json' or value. string' :: AsJType a ws a => a -> Maybe String string' = L.preview (_JStr . _1 . _Wrapped . L.to (V.toList . V.map jCharToChar)) --- | Try to decode a 'Data.ByteString.ByteString' value from some 'Json' or value. +-- | Try to decode a 'Data.ByteString.ByteString' value from some 'Waargonaut.Types.Json.Json' or value. strictByteString' :: AsJType a ws a => a -> Maybe ByteString strictByteString' = fmap BL.toStrict . lazyByteString' --- | Try to decode a 'Data.ByteString.Lazy.ByteString' value from some 'Json' or value. +-- | Try to decode a 'Data.ByteString.Lazy.ByteString' value from some 'Waargonaut.Types.Json.Json' or value. lazyByteString' :: AsJType a ws a => a -> Maybe BL.ByteString lazyByteString' = L.preview (_JStr . _1 . _Wrapped . L.to mkBS) - where mkBS = BB.toLazyByteString . foldMap (jCharBuilder bsBuilder) + -- This uses the 'Data.ByteString.Builder.char8' function as parsing has + -- validated our inputs. If we use 'Data.ByteString.Builder.charUtf8' or + -- 'Waargonaut.Builder.bsBuilder' the input will be incorrectly "double + -- encoded" and everything will be wrong. + where mkBS = BB.toLazyByteString . foldMap (BB.char8 . jCharToChar) -- | 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. @@ -324,27 +325,27 @@ unboundedChar' :: AsJType a ws a => a -> Maybe Char unboundedChar' = L.preview (_JStr . _1 . _Wrapped . L._head . L.to jCharToChar) --- | Try to decode a 'Scientific' value from some 'Json' or value. +-- | Try to decode a 'Scientific' value from some 'Waargonaut.Types.Json.Json' or value. scientific' :: AsJType a ws a => a -> Maybe Scientific scientific' = L.preview (_JNum . _1) >=> jNumberToScientific --- | Try to decode a bounded 'Integral n => n' value from some 'Json' value. +-- | Try to decode a bounded 'Integral n => n' value from some 'Waargonaut.Types.Json.Json' value. integral' :: (Bounded i , Integral i , AsJType a ws a) => a -> Maybe i integral' = scientific' >=> Sci.toBoundedInteger --- | Try to decode an 'Int' from some 'Json' value +-- | Try to decode an 'Int' from some 'Waargonaut.Types.Json.Json' value int' :: AsJType a ws a => a -> Maybe Int int' = integral' --- | Try to decode a 'Bool' from some 'Json' value +-- | Try to decode a 'Bool' from some 'Waargonaut.Types.Json.Json' value bool' :: AsJType a ws a => a -> Maybe Bool bool' = L.preview (_JBool . _1) --- | Try to decode a 'null' value from some 'Json' value +-- | Try to decode a 'null' value from some 'Waargonaut.Types.Json.Json' value null' :: AsJType a ws a => a -> Maybe () null' a = L.preview _JNull a $> () --- | Combined with another decoder function 'f', try to decode a list of 'a' values. +-- | Combined with another decoder function @f@, try to decode a list of @a@ values. -- -- @ -- array' int' :: Json -> [Int] @@ -379,9 +380,9 @@ -- -- Starting from the given cursor position, try to move in the direction -- specified by the given cursor function. Attempting to decode each item at each --- position using the given 'Decoder', until the movement is unsuccessful. +-- position using the given 'Waargonaut.Decode.Internal.Decoder', until the movement is unsuccessful. -- --- The following could be used to leverage the 'Snoc' instance of '[]' to build '[Int]'. +-- The following could be used to leverage the 'Control.Lens.Snoc' instance of '[]' to build '[Int]'. -- -- @ -- intList :: Monad f => JCurs -> DecodeResult f [Int] diff --git a/src/Waargonaut/Decode/Runners.hs b/src/Waargonaut/Decode/Runners.hs --- a/src/Waargonaut/Decode/Runners.hs +++ b/src/Waargonaut/Decode/Runners.hs @@ -1,4 +1,8 @@ {-# LANGUAGE RankNTypes #-} +-- | +-- +-- Functions to execution of 'Waargonaut.Decode.Decoder's +-- module Waargonaut.Decode.Runners ( -- * General over @f@ @@ -48,14 +52,14 @@ Decoder (..), mkCursor) -- | General decoding function that takes a given parsing function and some --- functions to handle the transition from the input of the 'JCurs' to the +-- functions to handle the transition from the input of the 'Waargonaut.Decoder.Types.JCurs' to the -- desired input type. The indexer and cursor requires a 'ByteString' to work -- efficiently, but this does not preclude the use of other text types, provided -- the right functions are present. -- -- There are some specialised versions of this function provided for 'Text', -- 'String', and 'ByteString'. They are implemented using this function, for --- example to work with 'Text' input and the 'attoparsec' package: +-- example to work with 'Text' input and the @attoparsec@ package: -- -- @ -- import qualified Data.Attoparsec.Text as AT @@ -210,7 +214,7 @@ pureDecodeWithInput decodeFromString -- | Helper function to handle wrapping up a parse failure using the given --- parsing function. Intended to be used with the 'runDecode' or 'simpleDecode' +-- parsing function. Intended to be used with the 'Waargonaut.Decode.runDecode' or 'Waargonaut.Decode.Traversal.simpleDecode' -- functions. -- -- @ diff --git a/src/Waargonaut/Decode/Traversal.hs b/src/Waargonaut/Decode/Traversal.hs --- a/src/Waargonaut/Decode/Traversal.hs +++ b/src/Waargonaut/Decode/Traversal.hs @@ -163,8 +163,8 @@ -- | This is an alias to help explain a type from the zipper that is used to move -- around the 'Json' data structure. 'JCursor h a' represents a "cursor" that is --- currently located on a thing of type 'a', having previously been on a thing --- of type 'h'. +-- currently located on a thing of type @a@, having previously been on a thing +-- of type @h@. -- -- This type will grow as a form of "breadcrumb" trail as the cursor moves -- through the data structure. It may be used interchangably with 'h :>> a' from @@ -281,7 +281,7 @@ a <- mCurs FailedToMove dir a <$ DR.recordZipperMove dir (Z.tooth a) --- | Using a given 'LensLike', try to step down into the 'Json' data structure +-- | Using a given 'Control.Lens.LensLike', try to step down into the 'Json' data structure -- to the location targeted by the lens. -- -- This can be used to move large steps over the data structure, or more @@ -325,7 +325,7 @@ up = moveAndKeepHistory U . pure . Z.upward --- | From the current cursor location, try to move 'n' steps to the left. +-- | From the current cursor location, try to move @n@ steps to the left. moveLeftN :: Monad f => Natural @@ -334,7 +334,7 @@ moveLeftN n cur = moveAndKeepHistory (L n) (Z.jerks Z.leftward (n ^. re _Natural) cur) --- | From the current cursor location, try to move 'n' steps to the right. +-- | From the current cursor location, try to move @n@ steps to the right. moveRightN :: Monad f => Natural @@ -359,7 +359,7 @@ moveRight1 = moveRightN (successor' zero') --- | Provide a 'conversion' function and create a 'Decoder' that uses the +-- | Provide a @conversion@ function and create a 'Decoder' that uses the -- current cursor and runs the given function. Fails with 'ConversionFailure' and -- the given 'Text' description. atCursor @@ -423,8 +423,8 @@ -- -- myRecDecoder :: Decoder f MyRec -- myRecDecoder = MyRec --- <$> atKey "field_a" text --- <*> atKey "field_b" int +-- <$> atKey \"field_a\" text +-- <*> atKey \"field_b\" int -- @ -- atKey @@ -509,7 +509,7 @@ elemD -- | Use the 'Cons' typeclass and move leftwards from the current cursor --- position, 'consing' the values to the 's' as it moves. +-- position, "consing" the values to the @s@ as it moves. leftwardCons :: ( Monad f , Cons s s a a @@ -525,7 +525,7 @@ elemD -- | Use the 'Snoc' typeclass and move rightwards from the current cursor --- position, 'snocing' the values to the 's' as it moves. +-- position, "snocing" the values to the @s@ as it moves. rightwardSnoc :: ( Monad f , Snoc s s a a @@ -540,7 +540,7 @@ (unDecodeResult . moveRight1) elemD --- | Decode a 'NonEmpty' list of 'a' at the given cursor position. +-- | Decode a 'NonEmpty' list of @a@ at the given cursor position. nonEmptyAt :: Monad f => Decoder f a @@ -566,7 +566,7 @@ try (moveAndKeepHistory D (Z.within WT.jsonTraversal c)) >>= Maybe.maybe (pure mempty) (rightwardSnoc mempty elemD) --- | Create a 'Decoder' for a list of 'a' +-- | Create a 'Decoder' for a list of @a@ list :: Monad f => Decoder f b @@ -584,8 +584,8 @@ withDefault def hasD = withCursor (fmap (Maybe.fromMaybe def) . focus hasD) --- | Named to match it's 'Encoder' counterpart, this function will decode an --- optional value. +-- | Named to match it's 'Waargonaut.Encode.Encoder' counterpart, this +-- function will decode an optional value. maybeOrNull :: Monad f => Decoder f a @@ -593,7 +593,7 @@ maybeOrNull hasD = withCursor (try . focus hasD) --- | Decode either an 'a' or a 'b', failing if neither 'Decoder' succeeds. The +-- | Decode either an @a@ or a @b@, failing if neither 'Decoder' succeeds. The -- 'Right' decoder is attempted first. either :: Monad f diff --git a/src/Waargonaut/Decode/Types.hs b/src/Waargonaut/Decode/Types.hs --- a/src/Waargonaut/Decode/Types.hs +++ b/src/Waargonaut/Decode/Types.hs @@ -9,7 +9,7 @@ -- module Waargonaut.Decode.Types ( ParseFn - , SuccinctCursor + , Cursor , CursorHistory , Decoder (..) , DecodeResult (..) @@ -33,18 +33,13 @@ import Data.Functor.Alt (Alt (..)) import qualified Data.Text as Text -import GHC.Word (Word64) - import Data.ByteString (ByteString) -import Data.Vector.Storable (Vector) -import HaskellWorks.Data.BalancedParens (SimpleBalancedParens) -import HaskellWorks.Data.Json.Backend.Standard.Cursor (JsonCursor (..)) -import HaskellWorks.Data.Json.Backend.Standard.Fast (makeCursor) -import HaskellWorks.Data.Json.Type (JsonType (..), +import HaskellWorks.Data.Json.Standard.Cursor.Fast (Cursor,fromByteStringViaBlanking) +import HaskellWorks.Data.Json.Standard.Cursor.Generic (cursorRank) +import HaskellWorks.Data.Json.Standard.Cursor.Type (JsonType (..), JsonTypeAt (..)) import HaskellWorks.Data.Positioning (Count) -import HaskellWorks.Data.RankSelect.Poppy512 (Poppy512) import Waargonaut.Decode.Internal (CursorHistory', DecodeError (..), DecodeResultT (..), @@ -57,11 +52,7 @@ type CursorHistory = CursorHistory' Count --- | Convenience alias defined for the concrete 'JsonCursor' type. -type SuccinctCursor = - JsonCursor ByteString Poppy512 (SimpleBalancedParens (Vector Word64)) - --- Another convenience alias for the type of the function we will use to parse +-- | Convenience alias for the type of the function we will use to parse -- the input string into the 'Json' structure. type ParseFn = ByteString -> Either DecodeError Json @@ -100,19 +91,19 @@ -- | Wrapper type for the 'SuccinctCursor' newtype JCurs = JCurs - { unJCurs :: SuccinctCursor + { unJCurs :: Cursor } deriving JsonTypeAt instance JCurs ~ t => Rewrapped JCurs t instance Wrapped JCurs where - type Unwrapped JCurs = SuccinctCursor + type Unwrapped JCurs = Cursor _Wrapped' = iso unJCurs JCurs -- | Take a 'ByteString' input and build an index of the JSON structure inside -- mkCursor :: ByteString -> JCurs -mkCursor = JCurs . makeCursor +mkCursor = JCurs . fromByteStringViaBlanking -- | Provide some of the type parameters that the underlying 'DecodeResultT' -- requires. This contains the state and error management as we walk around our diff --git a/src/Waargonaut/Encode.hs b/src/Waargonaut/Encode.hs --- a/src/Waargonaut/Encode.hs +++ b/src/Waargonaut/Encode.hs @@ -7,6 +7,103 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -- | Types and functions to encode your data types to 'Json'. +-- +-- We will work through a basic example, using the following type: +-- +-- @ +-- data Person = Person +-- { _personName :: Text +-- , _personAge :: Int +-- , _personAddress :: Text +-- , _personFavouriteLotteryNumbers :: [Int] +-- } +-- deriving (Eq, Show) +-- @ +-- +-- To create an 'Waargonaut.Encode.Encoder' for our @Person@ record, we will encode it as a "map +-- like object", that is we have decided that there are no duplicate keys allowed. We can then use +-- the following functions to build up the structure we want: +-- +-- @ +-- mapLikeObj +-- :: ( AsJType Json ws a +-- , Semigroup ws -- This library supports GHC 7.10.3 and 'Semigroup' wasn't a superclass of 'Monoid' then. +-- , Monoid ws +-- , Applicative f +-- ) +-- => (i -> MapLikeObj ws a -> MapLikeObj ws a) +-- -> Encoder f i +-- @ +-- +-- And: +-- +-- @ +-- atKey' +-- :: ( At t +-- , IxValue t ~ Json +-- ) +-- => Index t +-- -> Encoder' a +-- -> a +-- -> t +-- -> t +-- @ +-- +-- These types may seem pretty wild, but their usage is mundane. The 'Waargonaut.Encode.mapLikeObj' +-- function is used when we want to encode some particular type @i@ as a JSON object. In such a way +-- as to prevent duplicate keys from appearing. The 'Waargonaut.Encode.atKey'' function is designed +-- such that it can be composed with itself to build up an object with multiple keys. +-- +-- @ +-- import Waargonaut.Encode (Encoder) +-- import qualified Waargonaut.Encode as E +-- @ +-- +-- @ +-- personEncoder :: Applicative f => Encoder f Person +-- personEncoder = E.mapLikeObj $ \\p -> +-- E.atKey' \"name\" E.text (_personName p) . +-- E.atKey' \"age\" E.int (_personAge p) . +-- E.atKey' \"address\" E.text (_personAddress p) . +-- E.atKey' \"numbers\" (E.list E.int) (_personFavouriteLotteryNumbers p) +-- @ +-- +-- The JSON RFC leaves the handling of duplicate keys on an object as a choice. It is up to the +-- implementor of a JSON handling package to decide what they will do. Waargonaut passes on this +-- choice to you. In both encoding and decoding, the handling of duplicate keys is up to you. +-- Waargonaut provides functionality to support /both/ use cases. +-- +-- To then turn these values into JSON output: +-- +-- @ +-- simpleEncodeText :: Applicative f => Encoder f a -> a -> f Text +-- simpleEncodeTextNoSpaces :: Applicative f => Encoder f a -> a -> f Text +-- +-- simpleEncodeByteString :: Applicative f => Encoder f a -> a -> f ByteString +-- simpleEncodeByteStringNoSpaces :: Applicative f => Encoder f a -> a -> f ByteString +-- @ +-- +-- Or +-- +-- @ +-- simplePureEncodeText :: Encoder' a -> a -> Text +-- simplePureEncodeTextNoSpaces :: Encoder' a -> a -> Text +-- +-- simplePureEncodeByteString :: Encoder' a -> a -> ByteString +-- simplePureEncodeByteStringNoSpaces :: Encoder' a -> a -> ByteString +-- @ +-- +-- The latter functions specialise the @f@ to be 'Data.Functor.Identity'. +-- +-- Then, like the use of the 'Waargonaut.Decode.Decoder' you select the 'Waargonaut.Encode.Encoder' +-- you wish to use and run it against a value of a matching type: +-- +-- @ +-- simplePureEncodeTextNoSpaces personEncoder (Person \"Krag\" 33 \"Red House 4, Three Neck Lane, Greentown.\" [86,3,32,42,73]) +-- = +-- "{\"name\":\"Krag\",\"age\":88,\"address\":\"Red House 4, Three Neck Lane, Greentown.\",\"numbers\":[86,3,32,42,73]}" +-- @ +-- module Waargonaut.Encode ( -- * Encoder type @@ -93,6 +190,7 @@ , keyValuesAsObj' , json' , asJson' + , onObj' , generaliseEncoder ) where @@ -160,7 +258,8 @@ import Waargonaut.Encode.Builder.Types (Builder) import Waargonaut.Encode.Builder.Whitespace (wsBuilder, wsRemover) --- | Create an 'Encoder'' for 'a' by providing a function from 'a -> f Json'. + +-- | Create an 'Encoder'' for @a@ by providing a function from 'a -> f Json'. encodeA :: (a -> f Json) -> Encoder f a encodeA = jsonEncoder @@ -235,7 +334,7 @@ simplePureEncodeWith builder buildRunner wsB enc = runIdentity . simpleEncodeWith builder buildRunner wsB enc --- | As per 'simpleEncodeText' but specialised the 'f' to 'Data.Functor.Identity'. +-- | As per 'simpleEncodeText' but specialised the @f@ to 'Data.Functor.Identity'. simplePureEncodeText :: Encoder Identity a -> a @@ -243,7 +342,7 @@ simplePureEncodeText enc = runIdentity . simpleEncodeText enc --- | As per 'simpleEncodeTextNoSpaces' but specialised the 'f' to 'Data.Functor.Identity'. +-- | As per 'simpleEncodeTextNoSpaces' but specialised the @f@ to 'Data.Functor.Identity'. simplePureEncodeTextNoSpaces :: Encoder Identity a -> a @@ -251,7 +350,7 @@ simplePureEncodeTextNoSpaces enc = runIdentity . simpleEncodeTextNoSpaces enc --- | As per 'simpleEncodeByteString' but specialised the 'f' to 'Data.Functor.Identity'. +-- | As per 'simpleEncodeByteString' but specialised the @f@ to 'Data.Functor.Identity'. simplePureEncodeByteString :: Encoder Identity a -> a @@ -259,7 +358,7 @@ simplePureEncodeByteString enc = runIdentity . simpleEncodeByteString enc --- | As per 'simpleEncodeByteStringNoSpaces' but specialised the 'f' to 'Data.Functor.Identity'. +-- | As per 'simpleEncodeByteStringNoSpaces' but specialised the @f@ to 'Data.Functor.Identity'. simplePureEncodeByteStringNoSpaces :: Encoder Identity a -> a @@ -359,7 +458,7 @@ . Either.either (runEncoder eA) . runEncoder --- | Encode some 'Traversable' of 'a' into a JSON array. +-- | Encode some 'Traversable' of @a@ into a JSON array. traversable :: ( Applicative f , Traversable t @@ -397,39 +496,39 @@ list = traversable --- | As per 'json' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | As per 'json' but with the @f@ specialised to 'Data.Functor.Identity'. json' :: Encoder' Json json' = json --- | As per 'int' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | As per 'int' but with the @f@ specialised to 'Data.Functor.Identity'. int' :: Encoder' Int int' = int --- | As per 'integral' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | As per 'integral' but with the @f@ specialised to 'Data.Functor.Identity'. integral' :: Integral n => Encoder' n integral' = integral --- | As per 'scientific' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | As per 'scientific' but with the @f@ specialised to 'Data.Functor.Identity'. scientific' :: Encoder' Scientific scientific' = scientific --- | As per 'bool' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | As per 'bool' but with the @f@ specialised to 'Data.Functor.Identity'. bool' :: Encoder' Bool bool' = bool --- | As per 'string' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | 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'. +-- | As per 'text' but with the @f@ specialised to 'Data.Functor.Identity'. text' :: Encoder' Text text' = text --- | As per 'null' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | As per 'null' but with the @f@ specialised to 'Data.Functor.Identity'. null' :: Encoder' () null' = null --- | As per 'maybe' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | As per 'maybe' but with the @f@ specialised to 'Data.Functor.Identity'. maybe' :: Encoder' () -> Encoder' a @@ -437,14 +536,14 @@ maybe' = maybe --- | As per 'maybeOrNull' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | As per 'maybeOrNull' but with the @f@ specialised to 'Data.Functor.Identity'. maybeOrNull' :: Encoder' a -> Encoder' (Maybe a) maybeOrNull' = maybeOrNull --- | As per 'either' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | As per 'either' but with the @f@ specialised to 'Data.Functor.Identity'. either' :: Encoder' a -> Encoder' b @@ -452,21 +551,21 @@ either' = either --- | As per 'nonempty' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | As per 'nonempty' but with the @f@ specialised to 'Data.Functor.Identity'. nonempty' :: Encoder' a -> Encoder' (NonEmpty a) nonempty' = traversable --- | As per 'list' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | As per 'list' but with the @f@ specialised to 'Data.Functor.Identity'. list' :: Encoder' a -> Encoder' [a] list' = traversable --- | Encode some 'a' that is contained with another 't' structure. +-- | Encode some @a@ that is contained with another @t@ structure. encodeWithInner :: ( Applicative f , Traversable t @@ -477,7 +576,7 @@ encodeWithInner f g = jsonEncoder $ fmap f . traverse (runEncoder g) --- | As per 'traversable' but with the 'f' specialised to 'Data.Functor.Identity'. +-- | As per 'traversable' but with the @f@ specialised to 'Data.Functor.Identity'. traversable' :: Traversable t => Encoder' a @@ -485,7 +584,7 @@ traversable' = traversable --- | Using the given function to convert the 'k' type keys to a 'Text' value, +-- | Using the given function to convert the @k@ type keys to a 'Text' value, -- encode a 'Map' as a JSON object. mapToObj' :: Encoder' a @@ -508,6 +607,7 @@ atKey k enc v t = (\v' -> t & at k ?~ v') <$> runEncoder enc v +-- | Optionally encode an @a@ if it is a @Just a@. A @Nothing@ will result in the key being absent from the object. atOptKey :: ( At t , IxValue t ~ Json @@ -521,7 +621,7 @@ atOptKey k enc = Maybe.maybe pure (atKey k enc) --- | Encode an 'a' at the given index on the JSON object. +-- | Encode an @a@ at the given index on the JSON object. atKey' :: ( At t , IxValue t ~ Json @@ -539,8 +639,8 @@ -- -- @ -- encoder = E.mapLikeObj \$ \\a -> --- atKey' "A" E.text (_getterA a) --- atOptKey' "B" E.int (_maybeB a) +-- atKey' \"A\" E.text (_getterA a) +-- atOptKey' \"B\" E.int (_maybeB a) -- -- simplePureEncodeByteString encoder (Foo "bob" (Just 33)) = "{\"A\":\"bob\",\"B\":33}" -- @@ -588,7 +688,7 @@ boolAt = flip atKey' bool --- | Encode a 'Foldable' of 'a' at the given index on a JSON object. +-- | Encode a 'Foldable' of @a@ at the given index on a JSON object. traversableAt :: ( At t , Traversable f @@ -709,9 +809,9 @@ floopObj = fromMapLikeObj . f . fst . toMapLikeObj -- | --- Given encoders for things that are represented in JSON as 'objects', and a --- way to get to the 'b' and 'c' from the 'a'. This function lets you create an --- encoder for 'a'. The two objects are combined to make one single JSON object. +-- Given encoders for things that are represented in JSON as @objects@, and a +-- way to get to the @b@ and @c@ from the @a@. This function lets you create an +-- encoder for @a@. The two objects are combined to make one single JSON object. -- -- Given -- @@ -723,7 +823,7 @@ -- @ -- -- We can use this function to utilise our already defined 'ObjEncoder' --- structures to give us an encoder for 'A': +-- structures to give us an encoder for @A@: -- -- @ -- combineObjects (\aRecord -> (_foo aRecord, _bar aRecord)) encodeFoo encodeBar :: ObjEncoder f Bar @@ -750,6 +850,16 @@ onObj k b encB o = (\j -> o & _Wrapped L.%~ L.cons j) . JAssoc (_JStringText # k) mempty mempty <$> asJson encB b +-- | As per 'onObj' but the @f@ is specialised to 'Identity'. +onObj' + :: Text + -> b + -> Encoder' b + -> JObject WS Json + -> JObject WS Json +onObj' k b encB o = (\j -> o & _Wrapped L.%~ L.cons j) + . JAssoc (_JStringText # k) mempty mempty $ asJson' encB b + -- | Encode key value pairs as a JSON object, allowing duplicate keys. keyValuesAsObj :: ( Foldable g @@ -771,7 +881,7 @@ keyValueTupleFoldable eA = encodeA $ fmap (\v -> _JObj # (v,mempty)) . foldrM (\(k,v) o -> onObj k v eA o) (_Empty # ()) --- | As per 'keyValuesAsObj' but with the 'f' specialised to 'Identity'. +-- | As per 'keyValuesAsObj' but with the @f@ specialised to 'Identity'. keyValuesAsObj' :: ( Foldable g , Functor g diff --git a/src/Waargonaut/Encode/Builder.hs b/src/Waargonaut/Encode/Builder.hs --- a/src/Waargonaut/Encode/Builder.hs +++ b/src/Waargonaut/Encode/Builder.hs @@ -1,4 +1,8 @@ {-# LANGUAGE RankNTypes #-} +-- | +-- +-- Builder structures to help with turning 'Json' into a textual encoding. +-- module Waargonaut.Encode.Builder where import Data.String (IsString, fromString) @@ -11,6 +15,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Builder.Prim as BP import Waargonaut.Types.Json (JType (..), Json (..)) import Waargonaut.Types.Whitespace (WS) @@ -21,18 +26,22 @@ import Waargonaut.Encode.Builder.JString (jStringBuilder) import Waargonaut.Encode.Builder.Types (Builder (..)) +-- | A 'T.Text' builder textBuilder :: Builder Text T.Builder textBuilder = Builder T.singleton T.fromText T.decimal +-- | A 'B.ByteString' builder bsBuilder :: Builder ByteString B.Builder bsBuilder = Builder - B.charUtf8 + (BP.primBounded BP.charUtf8) B.byteString B.intDec +-- | A general builder function for working with 'JType' values. +-- jTypesBuilder :: ( IsString t , Monoid b diff --git a/src/Waargonaut/Encode/Builder/CommaSep.hs b/src/Waargonaut/Encode/Builder/CommaSep.hs --- a/src/Waargonaut/Encode/Builder/CommaSep.hs +++ b/src/Waargonaut/Encode/Builder/CommaSep.hs @@ -1,4 +1,8 @@ {-# LANGUAGE RankNTypes #-} +-- | +-- +-- Builder functions for 'CommaSeparated' values. +-- module Waargonaut.Encode.Builder.CommaSep (commaSeparatedBuilder) where import Data.Monoid ((<>)) @@ -24,7 +28,7 @@ commaTrailingBuilder bldr wsB = foldMap ((commaBuilder bldr <>) . (wsB bldr) . snd) --- | Using the given builders for the whitespace and elements ('a'), create a +-- | Using the given builders for the whitespace and elements (@a@), create a -- builder for a 'CommaSeparated'. commaSeparatedBuilder :: forall ws a t b. Monoid b diff --git a/src/Waargonaut/Encode/Builder/JArray.hs b/src/Waargonaut/Encode/Builder/JArray.hs --- a/src/Waargonaut/Encode/Builder/JArray.hs +++ b/src/Waargonaut/Encode/Builder/JArray.hs @@ -1,3 +1,7 @@ +-- | +-- +-- Builder function for 'JArray' +-- module Waargonaut.Encode.Builder.JArray (jArrayBuilder) where import Waargonaut.Types.JArray (JArray (..)) diff --git a/src/Waargonaut/Encode/Builder/JChar.hs b/src/Waargonaut/Encode/Builder/JChar.hs --- a/src/Waargonaut/Encode/Builder/JChar.hs +++ b/src/Waargonaut/Encode/Builder/JChar.hs @@ -1,3 +1,7 @@ +-- | +-- +-- Builder structures for 'JChar's +-- module Waargonaut.Encode.Builder.JChar (jCharBuilder) where import Control.Lens (review) diff --git a/src/Waargonaut/Encode/Builder/JNumber.hs b/src/Waargonaut/Encode/Builder/JNumber.hs --- a/src/Waargonaut/Encode/Builder/JNumber.hs +++ b/src/Waargonaut/Encode/Builder/JNumber.hs @@ -1,3 +1,7 @@ +-- | +-- +-- Builders for 'JNumber' +-- module Waargonaut.Encode.Builder.JNumber ( jNumberBuilder ) where diff --git a/src/Waargonaut/Encode/Builder/JObject.hs b/src/Waargonaut/Encode/Builder/JObject.hs --- a/src/Waargonaut/Encode/Builder/JObject.hs +++ b/src/Waargonaut/Encode/Builder/JObject.hs @@ -1,3 +1,7 @@ +-- | +-- +-- Builder structures for 'JObject's +-- module Waargonaut.Encode.Builder.JObject (jObjectBuilder) where import Data.Monoid ((<>)) diff --git a/src/Waargonaut/Encode/Builder/JString.hs b/src/Waargonaut/Encode/Builder/JString.hs --- a/src/Waargonaut/Encode/Builder/JString.hs +++ b/src/Waargonaut/Encode/Builder/JString.hs @@ -1,3 +1,7 @@ +-- | +-- +-- Builder structures for 'JString's +-- module Waargonaut.Encode.Builder.JString (jStringBuilder) where import Data.Monoid ((<>)) diff --git a/src/Waargonaut/Encode/Builder/Types.hs b/src/Waargonaut/Encode/Builder/Types.hs --- a/src/Waargonaut/Encode/Builder/Types.hs +++ b/src/Waargonaut/Encode/Builder/Types.hs @@ -1,7 +1,12 @@ +-- | +-- +-- The structure used to contain the required character and related functions for running a "builder". +-- module Waargonaut.Encode.Builder.Types (Builder (..)) where +-- | The builder data type. data Builder t b = Builder - { fromChar :: Char -> b - , fromChunk :: t -> b - , fromInt :: Int -> b + { fromChar :: Char -> b -- ^ Create a builder from a Haskell 'Char' + , fromChunk :: t -> b -- ^ Create a builder from a chunk or piece of @t@ + , fromInt :: Int -> b -- ^ Create a builder from a Haskell 'Int' } diff --git a/src/Waargonaut/Encode/Builder/Whitespace.hs b/src/Waargonaut/Encode/Builder/Whitespace.hs --- a/src/Waargonaut/Encode/Builder/Whitespace.hs +++ b/src/Waargonaut/Encode/Builder/Whitespace.hs @@ -1,3 +1,7 @@ +-- | +-- +-- Builder structures for 'Whitespace' +-- module Waargonaut.Encode.Builder.Whitespace ( whitespaceBuilder , wsBuilder diff --git a/src/Waargonaut/Encode/Types.hs b/src/Waargonaut/Encode/Types.hs --- a/src/Waargonaut/Encode/Types.hs +++ b/src/Waargonaut/Encode/Types.hs @@ -121,7 +121,7 @@ jsonEncoder = EncoderFns id {-# INLINE jsonEncoder #-} --- | Helper function for creating a JSON 'object' 'Encoder'. Provides the +-- | Helper function for creating a JSON @object@ 'Encoder'. Provides the -- default 'finaliseEncoding' function for completing the 'JObject' to the -- necessary 'Json' type. objEncoder :: (a -> f (JObject WS Json)) -> EncoderFns (JObject WS Json) f a diff --git a/src/Waargonaut/Generic.hs b/src/Waargonaut/Generic.hs --- a/src/Waargonaut/Generic.hs +++ b/src/Waargonaut/Generic.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} @@ -46,6 +45,7 @@ -- * Creation , gEncoder , gDecoder + , gObjEncoder -- * Reexports , module Data.Tagged @@ -54,16 +54,21 @@ ) where import Generics.SOP +import Generics.SOP.Record (IsRecord) -import Control.Lens (findOf, folded, isn't, _Left) +import Control.Lens (findOf, folded, isn't, ( # ), + _Empty, _Left) import Control.Monad ((>=>)) import Control.Monad.Except (lift, throwError) import Control.Monad.Reader (runReaderT) import Control.Monad.State (modify) import qualified Data.Char as Char +import Data.Function ((&)) import Data.Maybe (fromMaybe) +import Data.Foldable (foldl') + import Data.List.NonEmpty (NonEmpty) import Data.ByteString (ByteString) @@ -77,11 +82,11 @@ import qualified Data.Tagged as T import Waargonaut (Json) +import Waargonaut.Types (JObject, WS) import Waargonaut.Encode (Encoder, Encoder') import qualified Waargonaut.Encode as E - import HaskellWorks.Data.Positioning (Count) import Waargonaut.Decode (Decoder) @@ -276,6 +281,18 @@ -- Will be encoded as: @ {"Foo":"Fred"} @ -- | ConstructorNameAsKey + + -- | Encode the newtype value as an object, treaing the field accessor as the "key", and + -- passing that field name through the '_optionsFieldName' function. + -- + -- @ + -- newtype Foo = Foo { deFoo :: Text } + -- + -- let x = Foo "Fred" + -- @ + -- + -- Will be encoded as: @ {"deFoo":"Fred"} @ + | FieldNameAsKey deriving (Show, Eq) -- | The configuration options for creating 'Generic' encoder or decoder values. @@ -335,7 +352,7 @@ -- instance JsonEncode GWaarg Foo where -- mkEncoder = Tagged fooEncoderIWroteEarlier -- @ --- + class JsonEncode t a where mkEncoder :: Applicative f => Tagged t (Encoder f a) @@ -406,14 +423,7 @@ JsonZero :: ConstructorName -> JsonInfo '[] JsonOne :: Tag -> JsonInfo '[a] JsonMul :: SListI xs => Tag -> JsonInfo xs - JsonRec :: SListI xs => Tag -> NP (K String) xs -> JsonInfo xs - -modFieldName - :: Options - -> String - -> Text -modFieldName opts = - Text.pack . _optionsFieldName opts + JsonRec :: SListI xs => Tag -> NP (K Text) xs -> JsonInfo xs inObj :: Encoder' a -> String -> Encoder' a inObj en t = E.mapLikeObj' (E.atKey' (Text.pack t) en) @@ -455,8 +465,8 @@ jInfoFor opts _ tag (Record n fs) = JsonRec (tag n) (hliftA fname fs) where - fname :: FieldInfo a -> K String a - fname (FieldInfo name) = K $ _optionsFieldName opts name + fname :: FieldInfo a -> K Text a + fname (FieldInfo name) = K . Text.pack $ _optionsFieldName opts name jsonInfo :: forall a. @@ -468,13 +478,13 @@ -> NP JsonInfo (Code a) jsonInfo opts pa = case datatypeInfo pa of - Newtype _ _ c -> JsonOne (newtypename (constructorName c)) :* Nil - ADT _ n cs -> hliftA (jInfoFor opts n (tag cs)) cs - where - newtypename n = case _optionsNewtypeWithConsName opts of - Unwrap -> NoTag - ConstructorNameAsKey -> Tag (_optionsFieldName opts n) + Newtype _ n c -> case _optionsNewtypeWithConsName opts of + Unwrap -> JsonOne NoTag :* Nil + ConstructorNameAsKey -> JsonOne (Tag $ _optionsFieldName opts n) :* Nil + FieldNameAsKey -> jInfoFor opts n (Tag . _optionsFieldName opts) c :* Nil + ADT _ n cs -> hliftA (jInfoFor opts n (tag cs)) cs + where tag :: NP ConstructorInfo (Code a) -> ConstructorName -> Tag tag (_ :* Nil) = const NoTag tag _ = Tag @@ -514,6 +524,65 @@ pjE = Proxy :: Proxy (JsonEncode t) pt = Proxy :: Proxy t +-- | Create a 'Tagged' 'ObjEncoder' for type @ a @, tagged by @ t @. +-- +-- This isn't compatible with the 'JsonEncode' typeclass because it creates an +-- 'ObjEncoder' and for consistency reasons the 'JsonEncode' typeclass produces +-- 'Encoder's. +-- +-- However it lets you more easily access the 'Data.Functor.Contravariant.Contravariant' +-- functionality that is part of the 'ObjEncoder' type. +-- +-- @ +-- data Foo = Foo { fooA :: Text, fooB :: Int } deriving (Eq, Show) +-- deriveGeneric ''Foo +-- +-- objEncFoo :: Applicative f => ObjEncoder f Foo +-- objEncFoo = untag $ gObjEncoder (defaultOps { _optionsFieldName = drop 3 }) +-- +-- @ +-- +-- NB: This function overrides the newtype options to use the 'FieldNameAsKey' option to +-- be consistent with the behaviour of the record encoding. +-- +gObjEncoder + :: forall t a f xs. + ( Generic a + , Applicative f + , HasDatatypeInfo a + , All2 (JsonEncode t) (Code a) + , IsRecord a xs + ) + => Options + -> Tagged t (E.ObjEncoder f a) +gObjEncoder opts = Tagged . E.objEncoder $ \a -> hcollapse $ hcliftA2 + (Proxy :: Proxy (All (JsonEncode t))) + createObject + (jsonInfo (opts { _optionsNewtypeWithConsName = FieldNameAsKey }) (Proxy :: Proxy a)) + (unSOP $ from a) + where + createObject :: ( All (JsonEncode t) ys + , Applicative f + ) + => JsonInfo ys + -> NP I ys + -> K (f (JObject WS Json)) ys + createObject (JsonRec _ fields) cs = K . pure . + foldl' (&) (_Empty # ()) . hcollapse $ hcliftA2 pjE toObj fields cs + + createObject (JsonOne (Tag t)) (I a :* Nil) = K . pure $ + E.onObj' (Text.pack t) (E.asJson' (T.proxy mkEncoder pt) a) E.json (_Empty # ()) + + -- IsRecord constraint should make this impossible. + createObject _ _ = + error "The impossible has happened. Please report this as a bug: https://github.com/qfpl/waargonaut" + + toObj :: JsonEncode t x => K Text x -> I x -> K (JObject WS Json -> JObject WS Json) x + toObj f a = K $ E.onObj' (unK f) (E.asJson' (T.proxy mkEncoder pt) (unI a)) E.json + + pt = Proxy :: Proxy t + pjE = Proxy :: Proxy (JsonEncode t) + gEncoder' :: forall xs f t. ( All (JsonEncode t) xs @@ -537,11 +606,11 @@ ik :: JsonEncode t x => I x -> K Json x ik = K . E.asJson' (T.proxy mkEncoder pT) . unI -gEncoder' p pT opts (JsonRec tag fields) cs = +gEncoder' p pT _ (JsonRec tag fields) cs = tagVal tag . enc . hcollapse $ hcliftA2 p tup fields cs where - tup :: JsonEncode t x => K String x -> I x -> K (Text, Json) x - tup f a = K ( modFieldName opts (unK f) + tup :: JsonEncode t x => K Text x -> I x -> K (Text, Json) x + tup f a = K ( unK f , E.asJson' (T.proxy mkEncoder pT) (unI a) ) @@ -657,10 +726,10 @@ where err = throwError (ConversionFailure "Generic List Decode Failed") -mkGDecoder2 opts pJDec cursor (JsonRec tag fields) = do +mkGDecoder2 _ pJDec cursor (JsonRec tag fields) = do c' <- D.down cursor hsequenceK $ hcliftA pJDec (mapKK (decodeAtKey c')) fields where decodeAtKey c k = unTagVal tag ( - D.withCursor $ D.fromKey (modFieldName opts k) D.rank + D.withCursor $ D.fromKey k D.rank ) c diff --git a/src/Waargonaut/Lens.hs b/src/Waargonaut/Lens.hs --- a/src/Waargonaut/Lens.hs +++ b/src/Waargonaut/Lens.hs @@ -4,6 +4,10 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} +-- | +-- +-- Some high level prisms for interacting with something that could be JSON. +-- module Waargonaut.Lens ( -- * Prisms diff --git a/src/Waargonaut/Prettier.hs b/src/Waargonaut/Prettier.hs --- a/src/Waargonaut/Prettier.hs +++ b/src/Waargonaut/Prettier.hs @@ -77,9 +77,9 @@ newtype IndentStep = IndentStep Natural deriving (Eq, Show) --- | Encode an @a@ directly to a 'ByteString' using the provided 'Encoder', the --- output will have newlines and indentation added based on the 'InlineOption' and --- 'NumSpaces'. +-- | Encode an @a@ directly to a 'Data.Text' using +-- the provided 'Encoder', the output will have newlines and +-- indentation added based on the 'InlineOption' and 'NumSpaces'. -- -- @ -- let two = successor' $ successor' zero' @@ -167,5 +167,5 @@ where longestKey = maybe 1 (+1) $ L.maximumOf (objelems . L.folded . jsonAssocKey . _Wrapped . L.to length) j - setnested = objelems . CS.elemsLast . CS.elemVal . jsonAssocVal %~ + setnested = objelems . traverse . jsonAssocVal %~ prettyJson inlineOpt (IndentStep step) (NumSpaces $ w <> step) diff --git a/src/Waargonaut/Test.hs b/src/Waargonaut/Test.hs --- a/src/Waargonaut/Test.hs +++ b/src/Waargonaut/Test.hs @@ -18,7 +18,7 @@ import qualified Waargonaut.Decode as D import Waargonaut.Decode.Error (DecodeError) --- | Test a 'Encoder' and 'Decoder' pair are able to maintain the 'round trip' +-- | Test a 'Encoder' and 'Decoder' pair are able to maintain the "round trip" -- property. That is, if you encode a given value, and then decode it, you should -- have the exact same value that you started with. roundTripSimple diff --git a/src/Waargonaut/Types/CommaSep.hs b/src/Waargonaut/Types/CommaSep.hs --- a/src/Waargonaut/Types/CommaSep.hs +++ b/src/Waargonaut/Types/CommaSep.hs @@ -160,19 +160,19 @@ instance Monoid ws => Witherable (CommaSeparated ws) where --- | Isomorphism between the internal pieces of a 'CommaSeparated' element. +-- | Isomorphism between the internal pieces of a 'Waargonaut.Types.CommaSep.CommaSeparated' element. _CommaSeparated :: Iso (CommaSeparated ws a) (CommaSeparated ws' b) (ws, Maybe (Elems ws a)) (ws', Maybe (Elems ws' b)) _CommaSeparated = iso (\(CommaSeparated ws a) -> (ws,a)) (uncurry CommaSeparated) {-# INLINE _CommaSeparated #-} --- | Cons elements onto a 'CommaSeparated' with provided whitespace information. +-- | Cons elements onto a 'Waargonaut.Types.CommaSep.CommaSeparated' with provided whitespace information. -- If you don't need explicit whitespace then the 'Cons' instance is more straightforward. consCommaSep :: Monoid ws => ((Comma,ws),a) -> CommaSeparated ws a -> CommaSeparated ws a consCommaSep (ews,a) = over (_CommaSeparated . _2) (pure . maybe new (consElems (ews,a))) where new = Elems mempty (Elem a Nothing) {-# INLINE consCommaSep #-} --- | Attempt to "uncons" elements from the front of a 'CommaSeparated' without +-- | Attempt to "uncons" elements from the front of a 'Waargonaut.Types.CommaSep.CommaSeparated' without -- discarding the elements' whitespace information. If you don't need explicit -- whitespace then the 'Cons' instance is more straightforward. unconsCommaSep :: Monoid ws => CommaSeparated ws a -> Maybe ((Maybe (Comma,ws), a), CommaSeparated ws a) @@ -195,17 +195,18 @@ then es & elemsLast . traverse %%~ f else es & elemsElems . ix i . traverse %%~ f --- | Convert a list of 'a' to a 'CommaSeparated' list, with no whitespace. +-- | Convert a list of @a@ to a 'Waargonaut.Types.CommaSep.CommaSeparated' list, with no whitespace. fromList :: (Monoid ws, Semigroup ws) => [a] -> CommaSeparated ws a fromList = foldr cons mempty {-# INLINE fromList #-} --- | Convert a 'CommaSeparated' of 'a' to @[a]@, discarding whitespace. +-- | Convert a 'Waargonaut.Types.CommaSep.CommaSeparated' of @a@ to @[a]@, discarding whitespace. toList :: CommaSeparated ws a -> [a] toList = maybe [] g . (^. _CommaSeparated . _2) where g e = snoc (e ^.. elemsElems . traverse . elemVal) (e ^. elemsLast . elemVal) {-# INLINE toList #-} +-- | Attempt convert a 'CommaSeparated' to some other value using the given functions. fromCommaSep :: Traversal' j (CommaSeparated ws x) -> v @@ -223,7 +224,7 @@ $ traverse decoder els -- Try to decode the values {-# INLINE fromCommaSep #-} --- | Parse a 'CommaSeparated' data structure. +-- | Parse a 'Waargonaut.Types.CommaSep.CommaSeparated' data structure. -- -- >>> testparse (parseCommaSeparated (char '[') (char ']') parseWhitespace charWS) "[]" -- Right (CommaSeparated (WS []) Nothing) diff --git a/src/Waargonaut/Types/CommaSep/Elem.hs b/src/Waargonaut/Types/CommaSep/Elem.hs --- a/src/Waargonaut/Types/CommaSep/Elem.hs +++ b/src/Waargonaut/Types/CommaSep/Elem.hs @@ -5,6 +5,11 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} +-- | +-- +-- Data structures and functions for managing a single element in a +-- 'Waargonaut.Types.CommaSep.CommaSeparated' structure. +-- module Waargonaut.Types.CommaSep.Elem ( -- * Types @@ -78,8 +83,8 @@ parseCommaTrailingMaybe = C.optional . liftA2 (,) parseComma --- | Data type to represent a single element in a 'CommaSeparated' list. Carries --- information about it's own trailing whitespace. Denoted by the 'f'. +-- | Data type to represent a single element in a 'Waargonaut.Types.CommaSep.CommaSeparated' list. Carries +-- information about it's own trailing whitespace. Denoted by the @f@. data Elem f ws a = Elem { _elemVal :: a , _elemTrailing :: f (Comma, ws) @@ -127,6 +132,7 @@ floopId :: Monoid ws => Iso' (Identity (Comma,ws)) (Maybe (Comma,ws)) floopId = iso (Just . runIdentity) (pure . fromMaybe (Comma, mempty)) +-- | 'Control.Lens.Iso' between an 'Elem' that is not on the trailing element and one that is. _ElemTrailingIso :: ( Monoid ws , Monoid ws' diff --git a/src/Waargonaut/Types/CommaSep/Elems.hs b/src/Waargonaut/Types/CommaSep/Elems.hs --- a/src/Waargonaut/Types/CommaSep/Elems.hs +++ b/src/Waargonaut/Types/CommaSep/Elems.hs @@ -7,6 +7,10 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TupleSections #-} +-- | +-- +-- Data structures and functions for handling the elements contained in a 'Waargonaut.Types.CommaSep.CommaSeparated' structure. +-- module Waargonaut.Types.CommaSep.Elems ( -- * Types @@ -110,10 +114,12 @@ (<>) (Elems as alast) (Elems bs blast) = Elems (snoc as (alast ^. from _ElemTrailingIso) <> bs) blast +-- | Add a value to the beginning of the 'Elems' consElems :: Monoid ws => ((Comma,ws), a) -> Elems ws a -> Elems ws a consElems (ews,a) e = e & elemsElems %~ cons (Elem a (Identity ews)) {-# INLINE consElems #-} +-- | Attempt to remove the initial value off the front of an 'Elems' unconsElems :: Monoid ws => Elems ws a -> ((Maybe (Comma,ws), a), Maybe (Elems ws a)) unconsElems e = maybe (e', Nothing) (\(em, ems) -> (idT em, Just $ e & elemsElems .~ ems)) es' where @@ -122,7 +128,7 @@ idT x = (x ^. elemTrailing . to (Just . runIdentity), x ^. elemVal) {-# INLINE unconsElems #-} --- | Parse the elements of a 'CommaSeparated' list, handling the optional trailing comma and its whitespace. +-- | Parse the elements of a 'Waargonaut.Types.CommaSep.CommaSeparated' list, handling the optional trailing comma and its whitespace. -- -- >>> testparse (parseCommaSeparatedElems parseWhitespace alphaNum) "a, b, c, d" -- Right (Elems {_elemsElems = [Elem {_elemVal = 'a', _elemTrailing = Identity (Comma,WS [Space])},Elem {_elemVal = 'b', _elemTrailing = Identity (Comma,WS [Space])},Elem {_elemVal = 'c', _elemTrailing = Identity (Comma,WS [Space])}], _elemsLast = Elem {_elemVal = 'd', _elemTrailing = Nothing}}) diff --git a/src/Waargonaut/Types/JArray.hs b/src/Waargonaut/Types/JArray.hs --- a/src/Waargonaut/Types/JArray.hs +++ b/src/Waargonaut/Types/JArray.hs @@ -6,7 +6,10 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} --- | JSON Array representation and functions. +-- | +-- +-- JSON Array representation and functions. +-- module Waargonaut.Types.JArray ( -- * Types diff --git a/src/Waargonaut/Types/JChar.hs b/src/Waargonaut/Types/JChar.hs --- a/src/Waargonaut/Types/JChar.hs +++ b/src/Waargonaut/Types/JChar.hs @@ -117,10 +117,12 @@ -- instance AsJChar Char HeXDigit where -- Don't implement this, it's not a lawful prism. +-- | Convert a 'JChar' to a Haskell 'Char' jCharToChar :: JChar HeXDigit -> Char jCharToChar (UnescapedJChar uejc) = review _Unescaped uejc jCharToChar (EscapedJChar ejc) = escapedToChar ejc +-- | Attempt to convert a Haskell 'Char' to a JSON acceptable 'JChar' charToJChar :: Char -> Maybe (JChar HeXDigit) charToJChar c = (UnescapedJChar <$> preview _Unescaped c) <|> @@ -131,7 +133,7 @@ | otherwise = Nothing -- | Convert a 'Char' to 'JChar HexDigit' and replace any invalid values with --- @U+FFFD@ as per the 'Text' documentation. +-- @U+FFFD@ as per the 'Data.Text.Text' documentation. -- -- Refer to documentation for more info. -- @@ -140,7 +142,7 @@ where scalarReplacement = EscapedJChar (Hex (HexDigit4 D.xf D.xf D.xf D.xd)) {-# INLINE utf8CharToJChar #-} --- | Try to convert a 'JChar' to a 'Text' safe 'Char' value. Refer to the link for more info: +-- | Try to convert a 'JChar' to a 'Data.Text.Text' safe 'Char' value. Refer to the link for more info: -- https://hackage.haskell.org/package/text-1.2.3.0/docs/Data-Text-Internal.html#v:safe jCharToUtf8Char :: JChar HeXDigit -> Maybe Char jCharToUtf8Char = utf8SafeChar . jCharToChar diff --git a/src/Waargonaut/Types/JChar/Escaped.hs b/src/Waargonaut/Types/JChar/Escaped.hs --- a/src/Waargonaut/Types/JChar/Escaped.hs +++ b/src/Waargonaut/Types/JChar/Escaped.hs @@ -47,7 +47,7 @@ hexDigit4ToChar, parseHexDigit4) import Waargonaut.Types.Whitespace (Whitespace (..), - unescapedWhitespaceChar, + escapedWhitespaceChar, _WhitespaceChar) -- $setup @@ -177,15 +177,17 @@ in char '\\' *> (z <|> h) +-- | Convert an 'Escaped' character to a Haskell 'Char' escapedToChar :: Escaped HeXDigit -> Char escapedToChar = \case QuotationMark -> '"' ReverseSolidus -> '\\' Solidus -> '/' Backspace -> '\b' - WhiteSpace wc -> unescapedWhitespaceChar wc + WhiteSpace wc -> escapedWhitespaceChar wc Hex hd -> hexDigit4ToChar hd +-- | Attempt to convert a Haskell 'Char' to an 'Escaped' JSON character charToEscaped :: Char -> Maybe (Escaped HeXDigit) charToEscaped c = case c of '"' -> Just QuotationMark diff --git a/src/Waargonaut/Types/JChar/HexDigit4.hs b/src/Waargonaut/Types/JChar/HexDigit4.hs --- a/src/Waargonaut/Types/JChar/HexDigit4.hs +++ b/src/Waargonaut/Types/JChar/HexDigit4.hs @@ -6,7 +6,10 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} --- | Types and functions for handling \\u0000 values in JSON. +-- | +-- +-- Types and functions for handling \\u0000 values in JSON. +-- module Waargonaut.Types.JChar.HexDigit4 ( -- * Types @@ -91,7 +94,7 @@ hexDigit4ToChar (HexDigit4 a b c d) = chr (D._HeXDigitsIntegral (Right $ a :| [b,c,d])) -- | Try to convert a Haskell 'Char' to a JSON acceptable character. NOTE: This --- cannot preserve the upper or lower casing of any original 'Json' data structure +-- cannot preserve the upper or lower casing of any original 'Waargonaut.Types.Json.Json' data structure -- inputs that may have been used to create this 'Char'. Also the JSON RFC -- specifies a "limited" range of @U+0000@ to @U+FFFF@ as permissible as a six -- character sequence: @\u0000@. diff --git a/src/Waargonaut/Types/JChar/Unescaped.hs b/src/Waargonaut/Types/JChar/Unescaped.hs --- a/src/Waargonaut/Types/JChar/Unescaped.hs +++ b/src/Waargonaut/Types/JChar/Unescaped.hs @@ -1,4 +1,7 @@ --- | Types and functions for handling valid unescaped characters in JSON. +-- | +-- +-- Types and functions for handling valid unescaped characters in JSON. +-- module Waargonaut.Types.JChar.Unescaped ( -- * Types diff --git a/src/Waargonaut/Types/JNumber.hs b/src/Waargonaut/Types/JNumber.hs --- a/src/Waargonaut/Types/JNumber.hs +++ b/src/Waargonaut/Types/JNumber.hs @@ -3,7 +3,10 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-} --- | Representation of a JSON number and its various components. +-- | +-- +-- Representation of a JSON number and its various components. +-- module Waargonaut.Types.JNumber ( -- * Types @@ -87,7 +90,7 @@ | JIntInt digit [DecDigit] deriving (Eq, Ord, Show) --- | Type alias to allow us to constrain the first 'digit' type. +-- | Type alias to allow us to constrain the first @digit@ type. type JInt = JInt' DecDigit -- | Prism for JSON zeroes. diff --git a/src/Waargonaut/Types/JObject.hs b/src/Waargonaut/Types/JObject.hs --- a/src/Waargonaut/Types/JObject.hs +++ b/src/Waargonaut/Types/JObject.hs @@ -127,7 +127,7 @@ bitraverse f g (JObject c) = JObject <$> bitraverse f (bitraverse f g) c -- | Without having an obviously correct "first" or "last" decision on which --- 'JString' key is the "right" one to use, a 'JObject' can only be indexed by a +-- 'Waargonaut.Types.JString' key is the "right" one to use, a 'JObject' can only be indexed by a -- numeric value. instance Monoid ws => Ixed (JObject ws a) where ix i f (JObject cs) = JObject <$> ix i (traverse f) cs @@ -149,7 +149,7 @@ deriving (Eq, Show, Functor, Foldable, Traversable) -- | --- 'Prism' for working with a 'JObject' as a 'MapLikeObj'. This optic will keep +-- 'Control.Lens.Prism' for working with a 'JObject' as a 'MapLikeObj'. This optic will keep -- the first unique key on a given 'JObject' and this information is not -- recoverable. If you want to create a 'MapLikeObj' from a 'JObject' and keep -- what is removed, then use the 'toMapLikeObj' function. diff --git a/src/Waargonaut/Types/Json.hs b/src/Waargonaut/Types/Json.hs --- a/src/Waargonaut/Types/Json.hs +++ b/src/Waargonaut/Types/Json.hs @@ -176,8 +176,8 @@ _ -> Left x ) --- | Top level Json type, we specialise the whitespace to 'WS' and the 'digit' --- type to 'Digit'. Also defining that our structures can recursively only contain +-- | Top level Json type, we specialise the whitespace to 'WS' and the @digit@ +-- type to 'Data.Digit.Digit'. Also defining that our structures can recursively only contain -- 'Json' types. newtype Json = Json (JType WS Json) @@ -210,7 +210,7 @@ jtypeTraversal = bitraverse pure -- | --- A 'Control.Lens.Traversal'' over the 'a' at the given 'Text' key on a JSON object. +-- A 'Control.Lens.Traversal'' over the @a@ at the given 'Text' key on a JSON object. -- -- >>> E.simplePureEncodeTextNoSpaces E.json (obj & oat "c" ?~ E.asJson' E.int 33) -- "{\"c\":33,\"a\":33,\"b\":\"Fred\"}" @@ -221,7 +221,7 @@ oat k = _JObj . _1 . _MapLikeObj . at k -- | --- A 'Control.Lens.Traversal'' over the 'a' at the given 'Int' position in a JSON object. +-- A 'Control.Lens.Traversal'' over the @a@ at the given 'Int' position in a JSON object. -- -- >>> E.simplePureEncodeTextNoSpaces E.json (obj & oix 0 .~ E.asJson' E.int 1) -- "{\"a\":1,\"b\":\"Fred\"}" @@ -231,7 +231,7 @@ oix i = _JObj . _1 . ix i -- | --- A 'Control.Lens.Traversal'' over the 'a' at the given 'Int' position in a JSON array. +-- A 'Control.Lens.Traversal'' over the @a@ at the given 'Int' position in a JSON array. -- -- >>> E.simplePureEncodeTextNoSpaces E.json ((E.asJson' (E.list E.int) [1,2,3]) & aix 0 .~ E.asJson' E.int 99) -- "[99,2,3]" @@ -261,7 +261,7 @@ <$ text "null" <*> ws --- | Parse a 'true' or 'false'. +-- | Parse a @true@ or @false@. -- -- >>> testparse (parseJBool (return ())) "true" -- Right (JBool True ()) diff --git a/src/Waargonaut/Types/Whitespace.hs b/src/Waargonaut/Types/Whitespace.hs --- a/src/Waargonaut/Types/Whitespace.hs +++ b/src/Waargonaut/Types/Whitespace.hs @@ -1,7 +1,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} --- | Parsers and builders for whitespace characters in our JSON. +-- | +-- +-- Parsers and builders for whitespace characters in our JSON. +-- module Waargonaut.Types.Whitespace ( Whitespace (..) diff --git a/test/Generics.hs b/test/Generics.hs new file mode 100644 --- /dev/null +++ b/test/Generics.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} +module Generics + ( genericsTests + ) where + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (Assertion, testCase, (@?=)) + +import Waargonaut.Encode (Encoder) +import qualified Waargonaut.Encode as E + +import qualified Types.Common as C + +import qualified Waargonaut.Generic as G + +testGenericFieldNameFunctionUsedOnce :: Assertion +testGenericFieldNameFunctionUsedOnce = do + let + encFudge :: Applicative f => Encoder f C.Fudge + encFudge = G.untag . G.gEncoder $ C.fudgeJsonOpts + { G._optionsFieldName = tail + } + + expected = "{\"udge\":\"Chocolate\"}" + + E.simplePureEncodeTextNoSpaces encFudge C.testFudge @?= expected + +genericsTests :: TestTree +genericsTests = testGroup "Generics" + [ testCase "Options fieldName function is used only once" testGenericFieldNameFunctionUsedOnce + ] diff --git a/test/Golden.hs b/test/Golden.hs --- a/test/Golden.hs +++ b/test/Golden.hs @@ -9,6 +9,7 @@ import System.FilePath (FilePath, takeBaseName) import System.IO (IO, print) +import Data.Semigroup ((<>)) import Data.Either (either) import Data.Function (($)) @@ -22,6 +23,8 @@ import qualified Waargonaut.Decode as D import qualified Waargonaut.Encode as E +import qualified Prettier.NestedObjs as WaargP + readAndEncodeFile :: FilePath -> IO ByteString readAndEncodeFile = readFile >=> D.decodeFromByteString parseOnly D.json . toStrict @@ -34,4 +37,6 @@ pure . testGroup "Golden Tests" $ [ goldenVsString (takeBaseName input) input (readAndEncodeFile input) | input <- fs + ] <> + [ WaargP.testGoldenPrettyNested ] diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -31,6 +31,7 @@ import qualified Encoder import qualified Encoder.Laws import qualified Golden +import qualified Generics import qualified Json import qualified Properties @@ -89,6 +90,8 @@ , Decoder.decoderTests , Encoder.encoderTests + + , Generics.genericsTests , goldens ] diff --git a/test/Prettier/NestedObjs.hs b/test/Prettier/NestedObjs.hs new file mode 100644 --- /dev/null +++ b/test/Prettier/NestedObjs.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Test case from +-- +-- https://gist.github.com/tonymorris/420fff469463037f5ed3f76339cb51e2 +-- +module Prettier.NestedObjs where + +import Data.Functor.Identity +import Prelude + +import qualified Data.Text.Lazy.Encoding as TLE + +import Data.Text.Lazy +import Natural + +import Waargonaut.Encode +import Waargonaut.Prettier + +import Test.Tasty (TestTree) +import Test.Tasty.Golden (goldenVsString) + +data Wibble = + Wibble { + _a1 :: String + , _a2 :: String + , _a3 :: String + , _a4 :: String + } deriving (Eq, Ord, Show) + +data Wobble = + Wobble { + _b1 :: Wibble + , _b2 :: Wibble + } deriving (Eq, Ord, Show) + +testWibble1 :: + Wibble +testWibble1 = + Wibble + "hi1" + "bye1" + "hello1" + "goodbye1" + +testWibble2 :: + Wibble +testWibble2 = + Wibble + "hi2" + "bye2" + "hello2" + "goodbye2" + +testWobble :: + Wobble +testWobble = + Wobble + testWibble1 + testWibble2 + +wibbleEncoder :: + Applicative f => + Encoder f Wibble +wibbleEncoder = + mapLikeObj $ \w -> + atKey' "a1" string (_a1 w) . + atKey' "a2" string (_a2 w) . + atKey' "a3" string (_a3 w) . + atKey' "a4" string (_a4 w) + +wobbleEncoder :: + Applicative f => + Encoder f Wobble +wobbleEncoder = + mapLikeObj $ \w -> + atKey' "b1" wibbleEncoder (_b1 w) . + atKey' "b2" wibbleEncoder (_b2 w) + +prettyied :: Text +prettyied = + let two = successor' (successor' zero') + in runIdentity (simpleEncodePretty ArrayOnly (IndentStep two) (NumSpaces two) wobbleEncoder testWobble) + +-- Expected this +{- +{ + "b1": { + "a1": "hi1", + "a2": "bye1", + "a3": "hello1", + "a4": "goodbye1" + }, + "b2": { + "a1": "hi2", + "a2": "bye2", + "a3": "hello2", + "a4": "goodbye2" + } +} +-} +-- +-- Got this +{- +{ + "b1": { + "a1": "hi1", + "a2": "bye1", + "a3": "hello1", + "a4": "goodbye1" +}, + "b2": { + "a1": "hi2", + "a2": "bye2", + "a3": "hello2", + "a4": "goodbye2" + } +} +-} +testGoldenPrettyNested :: TestTree +testGoldenPrettyNested = goldenVsString "'encodePretty' simple nested objects" + "test/Prettier/pretty_nested_objs.json" + (pure $ TLE.encodeUtf8 prettyied) diff --git a/test/Types/Common.hs b/test/Types/Common.hs --- a/test/Types/Common.hs +++ b/test/Types/Common.hs @@ -23,6 +23,7 @@ , testImageDataType , testFudge + , fudgeJsonOpts , imageDecodeGeneric , imageDecodeSuccinct @@ -132,7 +133,7 @@ instance JsonEncode GWaarg Image where mkEncoder = gEncoder imageOpts instance JsonDecode GWaarg Image where mkDecoder = gDecoder imageOpts -newtype Fudge = Fudge Text +newtype Fudge = Fudge { unCrepe :: Text } deriving (Eq, Show, GHC.Generic) instance Generic Fudge diff --git a/waargonaut.cabal b/waargonaut.cabal --- a/waargonaut.cabal +++ b/waargonaut.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.6.2.0 +version: 0.8.0.0 -- A short (one-line) description of the package. synopsis: JSON wrangling @@ -143,41 +143,40 @@ ghc-options: -Wall -- Other library packages from which modules are imported. - build-depends: base >= 4.9 && < 4.13 - , 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 - , digit >= 0.7 && < 0.8 - , semigroups >= 0.8.4 && < 0.20 - , scientific >= 0.3 && < 0.4 - , distributive >= 0.5 && < 0.7 - , nats >= 1 && <1.2 - , zippers >= 0.2 && < 0.3 - , vector >= 0.12 && < 0.13 - , errors >= 2.2 && < 2.4 - , hoist-error >= 0.2 && < 0.3 - , containers >= 0.5.6 && < 0.7 - , witherable >= 0.2 && < 0.4 - , generics-sop >= 0.4 && < 0.5 - , mmorph >= 1.1 && < 1.2 - , transformers >= 0.4 && < 0.6 - , bifunctors >= 5 && < 5.6 - , contravariant >= 1.4 && < 1.6 - , wl-pprint-annotated >= 0.1 && < 0.2 - - , hw-json >= 1.0.0.2 && < 1.2 - , hw-prim >= 0.6 && < 0.7 - , hw-balancedparens >= 0.2 && < 0.3 - , hw-rankselect >= 0.13 && < 0.14 - , hw-bits >= 0.7 && < 0.8 - - , tagged >= 0.8.5 && < 0.9 - , semigroupoids >= 5.2.2 && < 5.4 - , natural >= 0.3 && < 0.4 - , unordered-containers >= 0.2.9 && < 0.3 - , attoparsec >= 0.13 && < 0.15 + build-depends: base >= 4.9 && < 4.13 + , 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 + , digit >= 0.7 && < 0.9 + , semigroups >= 0.8.4 && < 0.20 + , scientific >= 0.3 && < 0.4 + , distributive >= 0.5 && < 0.7 + , nats >= 1 && <1.2 + , zippers >= 0.2 && < 0.4 + , vector >= 0.12 && < 0.13 + , errors >= 2.2 && < 2.4 + , hoist-error >= 0.2 && < 0.3 + , containers >= 0.5.6 && < 0.7 + , witherable >= 0.2 && < 0.4 + , generics-sop >= 0.4 && < 0.5 + , records-sop >= 0.1 && < 0.2 + , mmorph >= 1.1 && < 1.2 + , transformers >= 0.4 && < 0.6 + , bifunctors >= 5 && < 5.6 + , contravariant >= 1.4 && < 1.6 + , wl-pprint-annotated >= 0.1 && < 0.2 + , hw-json-standard-cursor >= 0.2.1.1 && < 0.3 + , hw-prim >= 0.6 && < 0.7 + , hw-balancedparens >= 0.2 && < 0.4 + , hw-rankselect >= 0.13 && < 0.14 + , hw-bits >= 0.7 && < 0.8 + , tagged >= 0.8.5 && < 0.9 + , semigroupoids >= 5.2.2 && < 5.4 + , natural >= 0.3 && < 0.4 + , unordered-containers >= 0.2.9 && < 0.3 + , attoparsec >= 0.13 && < 0.15 -- Directories containing source files. hs-source-dirs: src @@ -192,9 +191,9 @@ hs-source-dirs: test build-depends: base >= 4.9 && < 4.13 - , hedgehog >= 0.6 && < 0.7 + , hedgehog >= 0.6 && < 1.2 , text >= 1.2 && < 1.3 - , digit >= 0.7 && < 0.8 + , digit >= 0.7 && < 0.9 , attoparsec >= 0.13 && < 0.15 , doctest >= 0.9.7 , filepath >= 1.3 @@ -214,8 +213,10 @@ , Types.Json , Types.Whitespace + , Prettier.NestedObjs , Properties , Golden + , Generics , Laws , Utils , Encoder @@ -228,39 +229,38 @@ main-is: Main.hs hs-source-dirs: test - build-depends: base >= 4.9 && < 4.13 - , tasty >= 0.11 && < 1.3 - , 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 && < 4.18 - , distributive >= 0.5 && < 0.7 - , bytestring >= 0.10.6 && < 0.11 - , digit >= 0.7 && < 0.8 - , text >= 1.2 && < 1.3 - , semigroups >= 0.8.4 && < 0.20 - , zippers >= 0.2 && < 0.3 - , vector >= 0.12 && < 0.13 - , generics-sop >= 0.4 && < 0.5 - , attoparsec >= 0.13 && < 0.15 - , scientific >= 0.3 && < 0.4 - , tagged >= 0.8.5 && < 0.9 - , mtl >= 2.2.2 && < 2.3 - , semigroupoids >= 5.2.2 && < 5.6 - , containers >= 0.5.6 && < 0.7 - , natural >= 0.3 && < 0.4 - , contravariant >= 1.4 && < 1.6 - , filepath >= 1.4 && < 1.5 - , tasty-golden >= 2.3 && < 2.4 - , unordered-containers >= 0.2.9 && < 0.3 - - , hw-balancedparens >= 0.2 && < 0.3 - , hw-rankselect >= 0.13 && < 0.14 - , hw-bits >= 0.7 && < 0.8 - , hw-json >= 1.0.0.2 && < 1.2 - , hw-prim >= 0.6 && < 0.7 + build-depends: base >= 4.9 && < 4.13 + , tasty >= 0.11 && < 1.3 + , tasty-hunit >= 0.10 && < 0.11 + , tasty-expected-failure >= 0.11 && < 0.12 + , hedgehog >= 0.6 && < 1.2 + , hedgehog-fn >= 0.6 && < 2 + , tasty-hedgehog >= 0.2 && < 1.2 + , lens >= 4.15 && < 4.18 + , distributive >= 0.5 && < 0.7 + , bytestring >= 0.10.6 && < 0.11 + , digit >= 0.7 && < 0.9 + , text >= 1.2 && < 1.3 + , semigroups >= 0.8.4 && < 0.20 + , zippers >= 0.2 && < 0.4 + , vector >= 0.12 && < 0.13 + , generics-sop >= 0.4 && < 0.5 + , attoparsec >= 0.13 && < 0.15 + , scientific >= 0.3 && < 0.4 + , tagged >= 0.8.5 && < 0.9 + , mtl >= 2.2.2 && < 2.3 + , semigroupoids >= 5.2.2 && < 5.6 + , containers >= 0.5.6 && < 0.7 + , natural >= 0.3 && < 0.4 + , contravariant >= 1.4 && < 1.6 + , filepath >= 1.4 && < 1.5 + , tasty-golden >= 2.3 && < 2.4 + , unordered-containers >= 0.2.9 && < 0.3 + , hw-balancedparens >= 0.2 && < 0.4 + , hw-rankselect >= 0.13 && < 0.14 + , hw-bits >= 0.7 && < 0.8 + , hw-json-standard-cursor >= 0.2.1.1 && < 0.3 + , hw-prim >= 0.6 && < 0.7 , waargonaut