lehins / conduit-aeson / 45

Committed 24 Jun 2024 04:46PM UTC coverage: 81.034%. Remained the same

Build # 45

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #2 from lehins/fix-ci

Fix ci

Run Details

2 of 2 new or added lines in 1 file covered. (100.0%)

10 existing lines in 1 file now uncovered.

47 of 58 relevant lines covered (81.03%)

1.38 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

81.03

/src/Data/Conduit/Aeson.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonoLocalBinds #-}
-- |
-- Module      : Data.Conduit.Aeson
-- Copyright   : (c) Alexey Kuleshevich 2021-2022
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Conduit.Aeson
  ( ParserError(..)
  , conduitArray
  , conduitArrayEither
  , conduitObject
  , conduitObjectEither
  -- * Helpers
  -- ** Conduit
  , conduitArrayParserEither
  , conduitArrayParserNoStartEither
  , conduitObjectParserEither
  , conduitObjectParserNoStartEither
  -- ** Attoparsec
  , skipSpace
  , commaParser
  , delimiterParser
  , valuePrefixParser
  , valueParser
  , valueMaybeParser
  , objectEntryPrefixParser
  , objectEntryParser
  , objectEntryMaybeParser
  ) where

import Conduit
import Control.Applicative
import Control.Exception
import Control.Monad
import Data.Aeson as Aeson
import qualified Data.Aeson.Parser as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Attoparsec.ByteString as Atto
import qualified Data.Attoparsec.ByteString.Char8 as Atto8
import Data.Bifunctor (first)
import qualified Data.ByteString as BS
import Data.Conduit.Attoparsec
import qualified Data.Text as T
#if MIN_VERSION_aeson(1,5,0)
import Data.Coerce
#endif

-- | Various reason for failed parsing.
--
-- @since 0.1.0
data ParserError
  = AttoParserError ParseError
  -- ^ Attoparsec parser failure
  | AesonParserError String
  -- ^ Aeson parser failure
  | NonTerminatedInput
  -- ^ Parser failure when end of input was reached without proper termination.
  deriving Show
instance Exception ParserError


-- | Parse a top level array into a stream of json values.  Throws a
-- `ParserError` on invalid input, see `conduitArrayEither` for more graceful
-- error handling.
--
-- ===__Examples__
--
-- >>> :set -XTypeApplications
-- >>> :set -XOverloadedStrings
-- >>> import Conduit
-- >>> import Data.Conduit.Aeson
-- >>> runConduit $ yield ("[1,2,3,4]") .| conduitArray @Int .| printC
-- 1
-- 2
-- 3
-- 4
--
-- @since 0.1.0
conduitArray ::
     forall v m. (FromJSON v, MonadThrow m)
  => ConduitM BS.ByteString v m ()
conduitArray = conduitArrayEither .| mapMC (either throwM pure)

-- | Same as `conduitArray`, parse a top level array into a stream of values,
-- but produce @`Left` `ParserError`@ instead of failing immediately with an
-- exception.
--
-- @since 0.1.0
conduitArrayEither ::
     forall v m. (FromJSON v, Monad m)
  => ConduitM BS.ByteString (Either ParserError v) m ()
conduitArrayEither = conduitArrayParserEither .| stopOnNothing .| mapC toValue
  where
    toValue (Left err) = Left err
    toValue (Right (_, v)) = first AesonParserError $ Aeson.parseEither Aeson.parseJSON v

-- | Parse a top level array as a stream of JSON values. Expects opening and
-- closing braket @'['@ and @']'@ at the beginning and the end of the stream
-- respectfully. `Nothing` indicates terminating closing square braket has been
-- reached, but it does not mean there are no left over bytes in the input stream.
--
-- @since 0.1.0
conduitArrayParserEither ::
     Monad m
  => ConduitM  BS.ByteString (Either ParseError (PositionRange, Maybe Value)) m ()
conduitArrayParserEither = do
  sinkParserEither valuePrefixParser >>= \case
    Left err -> yield $ Left err
    Right () -> conduitParserEither (valueMaybeParser commaParser)

-- | Parse a stream of JSON values. Expects that there are no opening or closing
-- top level array braces @[@ and @]@. Could be very useful for consuming
-- infinite streams of log entries, where each entry is formatted as a JSON
-- value.
--
-- ===__Examples__
--
-- Parse a new line delimited JSON values.
--
-- >>> import Conduit
-- >>> import Data.Conduit.Aeson
-- >>> import Data.ByteString.Char8 (ByteString, pack)
-- >>> import Data.Attoparsec.ByteString.Char8 (char8)
-- >>> let input = pack "{\"foo\":1}\n{\"bar\":2}\n" :: ByteString
-- >>> let parser = conduitArrayParserNoStartEither (char8 '\n')
-- >>> runConduit (yield input .| parser .| printC)
-- Right (1:1 (0)-2:1 (10),Object (fromList [("foo",Number 1.0)]))
-- Right (2:1 (10)-3:1 (20),Object (fromList [("bar",Number 2.0)]))
--
-- Or a simple comma delimited list:
--
-- >>> runConduit $ yield (pack "1,2,3,\"Haskell\",") .| conduitArrayParserNoStartEither (char8 ',') .| printC
-- Right (1:1 (0)-1:3 (2),Number 1.0)
-- Right (1:3 (2)-1:5 (4),Number 2.0)
-- Right (1:5 (4)-1:7 (6),Number 3.0)
-- Right (1:7 (6)-1:17 (16),String "Haskell")
--
-- @since 0.1.0
conduitArrayParserNoStartEither ::
     forall m a. Monad m
  => Atto.Parser a
  -- ^ Delimiter parser (in JSON it is a comma @','@)
  -> ConduitM BS.ByteString (Either ParseError (PositionRange, Value)) m ()
conduitArrayParserNoStartEither = conduitParserEither . valueParser


-- | Parse a top level object into a stream of key/value pairs. Throws a
-- `ParserError` on invalid input, see `conduitObjectEither` for more graceful
-- error handling.
--
-- ===__Examples__
--
-- >>> :set -XOverloadedStrings
-- >>> :set -XTypeApplications
-- >>> import Conduit
-- >>> import Data.Conduit.Aeson
-- >>> let input = "{ \"foo\": 1, \"bar\": 2, \"baz\": 3 }"
-- >>> runConduit $ yield input .| conduitObject @String @Int .| printC
-- ("foo",1)
-- ("bar",2)
-- ("baz",3)
--
-- @since 0.1.0
conduitObject ::
     forall k v m. (FromJSONKey k, FromJSON v, MonadThrow m)
  => ConduitM BS.ByteString (k, v) m ()
conduitObject = conduitObjectEither .| mapMC (either throwM pure)

-- | Same as `conduitObject`, except fails gracefully. Parse a top level object
-- into a stream of key/value pairs with potential failures as @`Left` `ParserError`@.
--
-- @since 0.1.0
conduitObjectEither ::
     forall k v m. (FromJSONKey k, FromJSON v, Monad m)
  => ConduitM BS.ByteString (Either ParserError (k, v)) m ()
conduitObjectEither = conduitObjectParserEither .| stopOnNothing .| mapC toKeyValue
  where
    _id x = x -- work around an aeson rewrite rule.
    toKeyValue (Left err) = Left err
    toKeyValue (Right (_, (k, v))) =
      first AesonParserError $ do
        key <-
          case fromJSONKey of
#if MIN_VERSION_aeson(1,5,0)
            FromJSONKeyCoerce       -> Right $ coerce k
#else
            FromJSONKeyCoerce {}
               | FromJSONKeyText f <- fmap _id fromJSONKey -> Right $ f k
               | otherwise -> error "Impossible: failed to convert coercible FromJSONKeyCoerce"
#endif
            FromJSONKeyText f       -> Right $ f k
            FromJSONKeyTextParser p -> Aeson.parseEither p k
            FromJSONKeyValue p      -> Aeson.parseEither p (String k)
        val <- Aeson.parseEither Aeson.parseJSON v
        Right (key, val)

-- | Parse a top level key value mapping. Expects opening and closing braces
-- @'{'@ and @'}'@. `Nothing` indicates terminating closing curly brace has been
-- reached, but it does not mean there are no left over bytes in the input stream.
--
-- @since 0.1.0
conduitObjectParserEither ::
     Monad m
  => ConduitM BS.ByteString (Either ParseError (PositionRange, Maybe (T.Text, Value))) m ()
conduitObjectParserEither = do
  sinkParserEither objectEntryPrefixParser >>= \case
    Left err -> yield $ Left err
    Right () -> conduitParserEither (objectEntryMaybeParser commaParser)

-- | Parse a stream of key/value pairs. Expects that there are no opening or
-- closing top level curly braces @'{'@ and @'}'@. It is suitable for infinite
-- streams of key value/pairs delimited by a custom character, eg. a new line.
--
-- ===__Examples__
--
-- >>> import Conduit
-- >>> import Data.Conduit.Aeson
-- >>> import Data.ByteString.Char8 (ByteString, pack)
-- >>> import Data.Attoparsec.ByteString.Char8 (char8)
-- >>> let input = pack "\"foo\":1|\"bar\":2|" :: ByteString
-- >>> let parser = conduitObjectParserNoStartEither (char8 '|')
-- >>> runConduit (yield input .| parser .| printC)
-- Right (1:1 (0)-1:9 (8),("foo",Number 1.0))
-- Right (1:9 (8)-1:17 (16),("bar",Number 2.0))
--
-- @since 0.1.0
conduitObjectParserNoStartEither ::
     forall m a. Monad m
  => Atto.Parser a
  -- ^ Delimiter parser (in JSON it is a comma @','@)
  -> ConduitM BS.ByteString (Either ParseError (PositionRange, (T.Text, Value))) m ()
conduitObjectParserNoStartEither = conduitParserEither . objectEntryParser


stopOnNothing ::
     Monad m
  => ConduitM (Either ParseError (PositionRange, Maybe a))
              (Either ParserError (PositionRange, a)) m ()
stopOnNothing = do
  await >>= \case
    Nothing -> yield $ Left NonTerminatedInput
    Just e
      | Left err <- e -> yield (Left (AttoParserError err)) >> stopOnNothing
      | Right (p, Just r) <- e -> yield (Right (p, r)) >> stopOnNothing
      | Right (_, Nothing) <- e -> pure ()

-- Attoparsec

-- | Skips all spaces and newlines
--
-- @since 0.1.0
skipSpace :: Atto.Parser ()
skipSpace = Atto.skipWhile $ \w -> w == 0x20 || w == 0x0a || w == 0x0d || w == 0x09

-- | Use a comma for delimiter.
--
-- @since 0.1.0
commaParser ::
     Char
  -- ^ Terminating character.
  -> Atto.Parser ()
commaParser = delimiterParser (Atto.word8 0x2c Atto8.<?> "','")

-- | Parser for delimiter with terminating character
--
-- @since 0.1.0
delimiterParser :: Atto.Parser a -> Char -> Atto.Parser ()
delimiterParser dp t =
  skipSpace <* (void dp <|> expectTermination)
  where
    expectTermination =
      Atto8.peekChar >>= \case
        Just c
          | c /= t -> fail $ "Unexpected delimiter: " ++ show c
        _ -> pure ()

-- | Consume @'['@ with all preceeding space characters
--
-- @since 0.1.0
valuePrefixParser :: Atto.Parser ()
valuePrefixParser = skipSpace <* Atto8.char '['

-- | Parse a JSON value potentially prefixed by whitespace followed by a suffix
--
-- @since 0.1.0
valueParser ::
     Atto.Parser a
  -- ^ Suffix parser
  -> Atto.Parser Aeson.Value
valueParser dp = skipSpace *> Aeson.json' <* dp

-- | Parse a JSON value followed either by a delimiter or terminating
-- character @']'@, which is also supplied to the delimiter parser. Nothing is
-- returned when terminating character is reached.
--
-- @since 0.1.1
valueMaybeParser ::
     (Char -> Atto.Parser a)
  -- ^ Delimiter parser (accepts terminating character as argument)
  -> Atto.Parser (Maybe Aeson.Value)
valueMaybeParser dp =
  let t = ']'
   in skipSpace *> ((Nothing <$ Atto8.char t) <|> (Just <$> Aeson.json' <* dp t))

-- | Consume @'{'@ with all preceeding space characters
--
-- @since 0.1.0
objectEntryPrefixParser :: Atto.Parser ()
objectEntryPrefixParser = skipSpace <* Atto8.char '{'


-- | Parse JSON object key followed by a colon
--
-- @since 0.1.0
keyParser :: Atto.Parser T.Text
keyParser =
  skipSpace *>
  (Aeson.jstring Atto.<?> "key") <*
  skipSpace <*
  (Atto.word8 0x3a Atto.<?> "':'")

-- | Parse a JSON key value pair followed by a suffix
--
-- @since 0.1.0
objectEntryParser ::
     Atto.Parser a
  -- ^ Suffix parser
  -> Atto.Parser (T.Text, Aeson.Value)
objectEntryParser dp = (,) <$> keyParser <*> valueParser dp


-- | Parse JSON key value pairs followed either by a delimiter or terminating
-- character @']'@, which is also supplied to the delimiter parser. Nothing is
-- returned when terminating character is reached.
--
-- @since 0.1.0
objectEntryMaybeParser :: (Char -> Atto.Parser a) -> Atto.Parser (Maybe (T.Text, Aeson.Value))
objectEntryMaybeParser dp =
  let t = '}'
   in skipSpace *>
      ((Nothing <$ Atto8.char t) <|> (Just <$> objectEntryParser (dp t)))

1	{-# LANGUAGE CPP #-}
2	{-# LANGUAGE ExplicitForAll #-}
3	{-# LANGUAGE LambdaCase #-}
4	{-# LANGUAGE MonoLocalBinds #-}
5	-- \|
6	-- Module : Data.Conduit.Aeson
7	-- Copyright : (c) Alexey Kuleshevich 2021-2022
8	-- License : BSD3
9	-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>
10	-- Stability : experimental
11	-- Portability : non-portable
12	--
13	module Data.Conduit.Aeson
14	( ParserError(..)
15	, conduitArray
16	, conduitArrayEither
17	, conduitObject
18	, conduitObjectEither
19	-- * Helpers
20	-- ** Conduit
21	, conduitArrayParserEither
22	, conduitArrayParserNoStartEither
23	, conduitObjectParserEither
24	, conduitObjectParserNoStartEither
25	-- ** Attoparsec
26	, skipSpace
27	, commaParser
28	, delimiterParser
29	, valuePrefixParser
30	, valueParser
31	, valueMaybeParser
32	, objectEntryPrefixParser
33	, objectEntryParser
34	, objectEntryMaybeParser
35	) where
36
37	import Conduit
38	import Control.Applicative
39	import Control.Exception
40	import Control.Monad
41	import Data.Aeson as Aeson
42	import qualified Data.Aeson.Parser as Aeson
43	import qualified Data.Aeson.Types as Aeson
44	import Data.Attoparsec.ByteString as Atto
45	import qualified Data.Attoparsec.ByteString.Char8 as Atto8
46	import Data.Bifunctor (first)
47	import qualified Data.ByteString as BS
48	import Data.Conduit.Attoparsec
49	import qualified Data.Text as T
50	#if MIN_VERSION_aeson(1,5,0)
51	import Data.Coerce
52	#endif
53
54	-- \| Various reason for failed parsing.
55	--
56	-- @since 0.1.0
57	data ParserError
58	= AttoParserError ParseError
59	-- ^ Attoparsec parser failure
60	\| AesonParserError String
61	-- ^ Aeson parser failure
62	\| NonTerminatedInput
63	-- ^ Parser failure when end of input was reached without proper termination.
UNCOV 64	deriving Show	×
65	instance Exception ParserError	×
66
67
68	-- \| Parse a top level array into a stream of json values. Throws a
69	-- `ParserError` on invalid input, see `conduitArrayEither` for more graceful
70	-- error handling.
71	--
72	-- ===__Examples__
73	--
74	-- >>> :set -XTypeApplications
75	-- >>> :set -XOverloadedStrings
76	-- >>> import Conduit
77	-- >>> import Data.Conduit.Aeson
78	-- >>> runConduit $ yield ("[1,2,3,4]") .\| conduitArray @Int .\| printC
79	-- 1
80	-- 2
81	-- 3
82	-- 4
83	--
84	-- @since 0.1.0
85	conduitArray ::
86	forall v m. (FromJSON v, MonadThrow m)
87	=> ConduitM BS.ByteString v m ()
88	conduitArray = conduitArrayEither .\| mapMC (either throwM pure)	1✔
89
90	-- \| Same as `conduitArray`, parse a top level array into a stream of values,
91	-- but produce @`Left` `ParserError`@ instead of failing immediately with an
92	-- exception.
93	--
94	-- @since 0.1.0
95	conduitArrayEither ::
96	forall v m. (FromJSON v, Monad m)
97	=> ConduitM BS.ByteString (Either ParserError v) m ()
98	conduitArrayEither = conduitArrayParserEither .\| stopOnNothing .\| mapC toValue	2✔
99	where
100	toValue (Left err) = Left err	1✔
101	toValue (Right (_, v)) = first AesonParserError $ Aeson.parseEither Aeson.parseJSON v	1✔
102
103	-- \| Parse a top level array as a stream of JSON values. Expects opening and
104	-- closing braket @'['@ and @']'@ at the beginning and the end of the stream
105	-- respectfully. `Nothing` indicates terminating closing square braket has been
106	-- reached, but it does not mean there are no left over bytes in the input stream.
107	--
108	-- @since 0.1.0
109	conduitArrayParserEither ::
110	Monad m
111	=> ConduitM BS.ByteString (Either ParseError (PositionRange, Maybe Value)) m ()
112	conduitArrayParserEither = do	2✔
113	sinkParserEither valuePrefixParser >>= \case	2✔
UNCOV 114	Left err -> yield $ Left err	×
115	Right () -> conduitParserEither (valueMaybeParser commaParser)	2✔
116
117	-- \| Parse a stream of JSON values. Expects that there are no opening or closing
118	-- top level array braces @[@ and @]@. Could be very useful for consuming
119	-- infinite streams of log entries, where each entry is formatted as a JSON
120	-- value.
121	--
122	-- ===__Examples__
123	--
124	-- Parse a new line delimited JSON values.
125	--
126	-- >>> import Conduit
127	-- >>> import Data.Conduit.Aeson
128	-- >>> import Data.ByteString.Char8 (ByteString, pack)
129	-- >>> import Data.Attoparsec.ByteString.Char8 (char8)
130	-- >>> let input = pack "{\"foo\":1}\n{\"bar\":2}\n" :: ByteString
131	-- >>> let parser = conduitArrayParserNoStartEither (char8 '\n')
132	-- >>> runConduit (yield input .\| parser .\| printC)
133	-- Right (1:1 (0)-2:1 (10),Object (fromList [("foo",Number 1.0)]))
134	-- Right (2:1 (10)-3:1 (20),Object (fromList [("bar",Number 2.0)]))
135	--
136	-- Or a simple comma delimited list:
137	--
138	-- >>> runConduit $ yield (pack "1,2,3,\"Haskell\",") .\| conduitArrayParserNoStartEither (char8 ',') .\| printC
139	-- Right (1:1 (0)-1:3 (2),Number 1.0)
140	-- Right (1:3 (2)-1:5 (4),Number 2.0)
141	-- Right (1:5 (4)-1:7 (6),Number 3.0)
142	-- Right (1:7 (6)-1:17 (16),String "Haskell")
143	--
144	-- @since 0.1.0
145	conduitArrayParserNoStartEither ::
146	forall m a. Monad m
147	=> Atto.Parser a
148	-- ^ Delimiter parser (in JSON it is a comma @','@)
149	-> ConduitM BS.ByteString (Either ParseError (PositionRange, Value)) m ()
UNCOV 150	conduitArrayParserNoStartEither = conduitParserEither . valueParser	×
151
152
153	-- \| Parse a top level object into a stream of key/value pairs. Throws a
154	-- `ParserError` on invalid input, see `conduitObjectEither` for more graceful
155	-- error handling.
156	--
157	-- ===__Examples__
158	--
159	-- >>> :set -XOverloadedStrings
160	-- >>> :set -XTypeApplications
161	-- >>> import Conduit
162	-- >>> import Data.Conduit.Aeson
163	-- >>> let input = "{ \"foo\": 1, \"bar\": 2, \"baz\": 3 }"
164	-- >>> runConduit $ yield input .\| conduitObject @String @Int .\| printC
165	-- ("foo",1)
166	-- ("bar",2)
167	-- ("baz",3)
168	--
169	-- @since 0.1.0
170	conduitObject ::
171	forall k v m. (FromJSONKey k, FromJSON v, MonadThrow m)
172	=> ConduitM BS.ByteString (k, v) m ()
173	conduitObject = conduitObjectEither .\| mapMC (either throwM pure)	1✔
174
175	-- \| Same as `conduitObject`, except fails gracefully. Parse a top level object
176	-- into a stream of key/value pairs with potential failures as @`Left` `ParserError`@.
177	--
178	-- @since 0.1.0
179	conduitObjectEither ::
180	forall k v m. (FromJSONKey k, FromJSON v, Monad m)
181	=> ConduitM BS.ByteString (Either ParserError (k, v)) m ()
182	conduitObjectEither = conduitObjectParserEither .\| stopOnNothing .\| mapC toKeyValue	2✔
183	where
UNCOV 184	_id x = x -- work around an aeson rewrite rule.	×
185	toKeyValue (Left err) = Left err	1✔
186	toKeyValue (Right (_, (k, v))) =
187	first AesonParserError $ do	1✔
188	key <-
189	case fromJSONKey of	2✔
190	#if MIN_VERSION_aeson(1,5,0)
UNCOV 191	FromJSONKeyCoerce -> Right $ coerce k	×
192	#else
193	FromJSONKeyCoerce {}
194	\| FromJSONKeyText f <- fmap _id fromJSONKey -> Right $ f k
195	\| otherwise -> error "Impossible: failed to convert coercible FromJSONKeyCoerce"
196	#endif
197	FromJSONKeyText f -> Right $ f k	2✔
UNCOV 198	FromJSONKeyTextParser p -> Aeson.parseEither p k	×
UNCOV 199	FromJSONKeyValue p -> Aeson.parseEither p (String k)	×
200	val <- Aeson.parseEither Aeson.parseJSON v	2✔
201	Right (key, val)	2✔
202
203	-- \| Parse a top level key value mapping. Expects opening and closing braces
204	-- @'{'@ and @'}'@. `Nothing` indicates terminating closing curly brace has been
205	-- reached, but it does not mean there are no left over bytes in the input stream.
206	--
207	-- @since 0.1.0
208	conduitObjectParserEither ::
209	Monad m
210	=> ConduitM BS.ByteString (Either ParseError (PositionRange, Maybe (T.Text, Value))) m ()
211	conduitObjectParserEither = do	2✔
212	sinkParserEither objectEntryPrefixParser >>= \case	2✔
UNCOV 213	Left err -> yield $ Left err	×
214	Right () -> conduitParserEither (objectEntryMaybeParser commaParser)	2✔
215
216	-- \| Parse a stream of key/value pairs. Expects that there are no opening or
217	-- closing top level curly braces @'{'@ and @'}'@. It is suitable for infinite
218	-- streams of key value/pairs delimited by a custom character, eg. a new line.
219	--
220	-- ===__Examples__
221	--
222	-- >>> import Conduit
223	-- >>> import Data.Conduit.Aeson
224	-- >>> import Data.ByteString.Char8 (ByteString, pack)
225	-- >>> import Data.Attoparsec.ByteString.Char8 (char8)
226	-- >>> let input = pack "\"foo\":1\|\"bar\":2\|" :: ByteString
227	-- >>> let parser = conduitObjectParserNoStartEither (char8 '\|')
228	-- >>> runConduit (yield input .\| parser .\| printC)
229	-- Right (1:1 (0)-1:9 (8),("foo",Number 1.0))
230	-- Right (1:9 (8)-1:17 (16),("bar",Number 2.0))
231	--
232	-- @since 0.1.0
233	conduitObjectParserNoStartEither ::
234	forall m a. Monad m
235	=> Atto.Parser a
236	-- ^ Delimiter parser (in JSON it is a comma @','@)
237	-> ConduitM BS.ByteString (Either ParseError (PositionRange, (T.Text, Value))) m ()
UNCOV 238	conduitObjectParserNoStartEither = conduitParserEither . objectEntryParser	×
239
240
241	stopOnNothing ::
242	Monad m
243	=> ConduitM (Either ParseError (PositionRange, Maybe a))
244	(Either ParserError (PositionRange, a)) m ()
245	stopOnNothing = do	2✔
246	await >>= \case	2✔
UNCOV 247	Nothing -> yield $ Left NonTerminatedInput	×
248	Just e
249	\| Left err <- e -> yield (Left (AttoParserError err)) >> stopOnNothing	1✔
250	\| Right (p, Just r) <- e -> yield (Right (p, r)) >> stopOnNothing	1✔
251	\| Right (_, Nothing) <- e -> pure ()	1✔
252
253	-- Attoparsec
254
255	-- \| Skips all spaces and newlines
256	--
257	-- @since 0.1.0
258	skipSpace :: Atto.Parser ()
259	skipSpace = Atto.skipWhile $ \w -> w == 0x20 \|\| w == 0x0a \|\| w == 0x0d \|\| w == 0x09	2✔
260
261	-- \| Use a comma for delimiter.
262	--
263	-- @since 0.1.0
264	commaParser ::
265	Char
266	-- ^ Terminating character.
267	-> Atto.Parser ()
268	commaParser = delimiterParser (Atto.word8 0x2c Atto8.<?> "','")	1✔
269
270	-- \| Parser for delimiter with terminating character
271	--
272	-- @since 0.1.0
273	delimiterParser :: Atto.Parser a -> Char -> Atto.Parser ()
274	delimiterParser dp t =	2✔
275	skipSpace <* (void dp <\|> expectTermination)	2✔
276	where
277	expectTermination =	2✔
278	Atto8.peekChar >>= \case	2✔
279	Just c
280	\| c /= t -> fail $ "Unexpected delimiter: " ++ show c	1✔
281	_ -> pure ()	1✔
282
283	-- \| Consume @'['@ with all preceeding space characters
284	--
285	-- @since 0.1.0
286	valuePrefixParser :: Atto.Parser ()
287	valuePrefixParser = skipSpace <* Atto8.char '['	2✔
288
289	-- \| Parse a JSON value potentially prefixed by whitespace followed by a suffix
290	--
291	-- @since 0.1.0
292	valueParser ::
293	Atto.Parser a
294	-- ^ Suffix parser
295	-> Atto.Parser Aeson.Value
296	valueParser dp = skipSpace > Aeson.json' < dp	2✔
297
298	-- \| Parse a JSON value followed either by a delimiter or terminating
299	-- character @']'@, which is also supplied to the delimiter parser. Nothing is
300	-- returned when terminating character is reached.
301	--
302	-- @since 0.1.1
303	valueMaybeParser ::
304	(Char -> Atto.Parser a)
305	-- ^ Delimiter parser (accepts terminating character as argument)
306	-> Atto.Parser (Maybe Aeson.Value)
307	valueMaybeParser dp =	2✔
308	let t = ']'	2✔
309	in skipSpace > ((Nothing <$ Atto8.char t) <\|> (Just <$> Aeson.json' < dp t))	2✔
310
311	-- \| Consume @'{'@ with all preceeding space characters
312	--
313	-- @since 0.1.0
314	objectEntryPrefixParser :: Atto.Parser ()
315	objectEntryPrefixParser = skipSpace <* Atto8.char '{'	2✔
316
317
318	-- \| Parse JSON object key followed by a colon
319	--
320	-- @since 0.1.0
321	keyParser :: Atto.Parser T.Text
322	keyParser =	2✔
323	skipSpace *>	2✔
324	(Aeson.jstring Atto.<?> "key") <*	1✔
325	skipSpace <*	2✔
326	(Atto.word8 0x3a Atto.<?> "':'")	1✔
327
328	-- \| Parse a JSON key value pair followed by a suffix
329	--
330	-- @since 0.1.0
331	objectEntryParser ::
332	Atto.Parser a
333	-- ^ Suffix parser
334	-> Atto.Parser (T.Text, Aeson.Value)
335	objectEntryParser dp = (,) <$> keyParser <*> valueParser dp	2✔
336
337
338	-- \| Parse JSON key value pairs followed either by a delimiter or terminating
339	-- character @']'@, which is also supplied to the delimiter parser. Nothing is
340	-- returned when terminating character is reached.
341	--
342	-- @since 0.1.0
343	objectEntryMaybeParser :: (Char -> Atto.Parser a) -> Atto.Parser (Maybe (T.Text, Aeson.Value))
344	objectEntryMaybeParser dp =	2✔
345	let t = '}'	2✔
346	in skipSpace *>	2✔
347	((Nothing <$ Atto8.char t) <\|> (Just <$> objectEntryParser (dp t)))	2✔

lehins / conduit-aeson / 45

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous