{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}

module Data.Aeson.WarningParser
  ( WarningParser
  , JSONWarning (..)
  , WithJSONWarnings (..)
  , withObjectWarnings
  , jsonSubWarnings
  , jsonSubWarningsT
  , jsonSubWarningsTT
  , logJSONWarnings
  , noJSONWarnings
  , tellJSONField
  , unWarningParser
  , (.:)
  , (.:?)
  , (..:)
  , (...:)
  , (..:?)
  , (...:?)
  , (..!=)
  ) where

import           Control.Monad.Trans.Writer.Strict
                   ( WriterT, mapWriterT, runWriterT, tell )
import qualified Data.Aeson as A
import           Data.Aeson.Types hiding ( (.:), (.:?) )
import qualified Data.Set as Set
import           Data.Text ( unpack )
import qualified Data.Text as T
import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
import           RIO
import           RIO.PrettyPrint.StylesUpdate ( StylesUpdate )

#if MIN_VERSION_aeson(2, 0, 0)
import qualified Data.Aeson.Key
import qualified Data.Aeson.KeyMap as HashMap

keyToText :: Data.Aeson.Key.Key -> Text
keyToText :: Key -> Text
keyToText = Key -> Text
Data.Aeson.Key.toText

textToKey :: Text -> Data.Aeson.Key.Key
textToKey :: Text -> Key
textToKey = Text -> Key
Data.Aeson.Key.fromText
#else
import qualified Data.HashMap.Strict as HashMap

keyToText :: Text -> Text
keyToText = id

textToKey :: Text -> Text
textToKey = id
#endif

-- | Extends the @.:@ warning to include the field name that failed to parse.

(.:) :: FromJSON a => Object -> Text -> Parser a
.: :: forall a. FromJSON a => Object -> Text -> Parser a
(.:) Object
o Text
p = (String -> String) -> Parser a -> Parser a
forall a. (String -> String) -> Parser a -> Parser a
modifyFailure
  ((String
"failed to parse field '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
p String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"': ") String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)
  (Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
A..: Text -> Key
textToKey Text
p)
{-# INLINE (.:) #-}

-- | Extends the @.:?@ warning to include the field name that failed to parse.

(.:?) :: FromJSON a => Object -> Text -> Parser (Maybe a)
.:? :: forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
(.:?) Object
o Text
p = (String -> String) -> Parser (Maybe a) -> Parser (Maybe a)
forall a. (String -> String) -> Parser a -> Parser a
modifyFailure
  ((String
"failed to parse field '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
p String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"': ") String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)
  (Object
o Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Text -> Key
textToKey Text
p)
{-# INLINE (.:?) #-}

-- | 'WarningParser' version of @.:@.

(..:) ::
     FromJSON a
  => Object
  -> Text
  -> WarningParser a
Object
o ..: :: forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
k = Text -> WarningParser ()
tellJSONField Text
k WarningParser ()
-> WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser a
forall a b.
WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
-> WriterT WarningParserMonoid Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT WarningParserMonoid m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Object
o Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
k)

-- | 'WarningParser' version of @.:?@.

(..:?) ::
     FromJSON a
  => Object
  -> Text
  -> WarningParser (Maybe a)
Object
o ..:? :: forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
k = Text -> WarningParser ()
tellJSONField Text
k WarningParser ()
-> WriterT WarningParserMonoid Parser (Maybe a)
-> WriterT WarningParserMonoid Parser (Maybe a)
forall a b.
WriterT WarningParserMonoid Parser a
-> WriterT WarningParserMonoid Parser b
-> WriterT WarningParserMonoid Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (Maybe a) -> WriterT WarningParserMonoid Parser (Maybe a)
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT WarningParserMonoid m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Object
o Object -> Text -> Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
k)

-- | 'WarningParser' version of @.!=@.

(..!=) :: WarningParser (Maybe a) -> a -> WarningParser a
WarningParser (Maybe a)
wp ..!= :: forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= a
d =
  ((Parser (Maybe a, WarningParserMonoid)
  -> Parser (a, WarningParserMonoid))
 -> WarningParser (Maybe a) -> WarningParser a)
-> WarningParser (Maybe a)
-> (Parser (Maybe a, WarningParserMonoid)
    -> Parser (a, WarningParserMonoid))
-> WarningParser a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Parser (Maybe a, WarningParserMonoid)
 -> Parser (a, WarningParserMonoid))
-> WarningParser (Maybe a) -> WarningParser a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT WarningParser (Maybe a)
wp ((Parser (Maybe a, WarningParserMonoid)
  -> Parser (a, WarningParserMonoid))
 -> WarningParser a)
-> (Parser (Maybe a, WarningParserMonoid)
    -> Parser (a, WarningParserMonoid))
-> WarningParser a
forall a b. (a -> b) -> a -> b
$
  \Parser (Maybe a, WarningParserMonoid)
p -> do
    WarningParserMonoid
a <- ((Maybe a, WarningParserMonoid) -> WarningParserMonoid)
-> Parser (Maybe a, WarningParserMonoid)
-> Parser WarningParserMonoid
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe a, WarningParserMonoid) -> WarningParserMonoid
forall a b. (a, b) -> b
snd Parser (Maybe a, WarningParserMonoid)
p
    (a -> (a, WarningParserMonoid))
-> Parser a -> Parser (a, WarningParserMonoid)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, WarningParserMonoid
a) (((Maybe a, WarningParserMonoid) -> Maybe a)
-> Parser (Maybe a, WarningParserMonoid) -> Parser (Maybe a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe a, WarningParserMonoid) -> Maybe a
forall a b. (a, b) -> a
fst Parser (Maybe a, WarningParserMonoid)
p Parser (Maybe a) -> a -> Parser a
forall a. Parser (Maybe a) -> a -> Parser a
.!= a
d)

present :: Object -> [Text] -> [Text]
present :: Object -> [Text] -> [Text]
present Object
o = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
x -> Key -> Object -> Bool
forall a. Key -> KeyMap a -> Bool
HashMap.member (Text -> Key
textToKey Text
x) Object
o)

-- | Synonym version of @..:@.

(...:) :: FromJSON a => Object -> [Text] -> WarningParser a
Object
_ ...: :: forall a. FromJSON a => Object -> [Text] -> WarningParser a
...: [] = String -> WriterT WarningParserMonoid Parser a
forall a. String -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to find an empty key"
Object
o ...: ss :: [Text]
ss@(Text
key:[Text]
_) = WriterT WarningParserMonoid Parser a
apply
 where
  apply :: WriterT WarningParserMonoid Parser a
apply = case Object -> [Text] -> [Text]
present Object
o [Text]
ss of
    [] -> String -> WriterT WarningParserMonoid Parser a
forall a. String -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WriterT WarningParserMonoid Parser a)
-> String -> WriterT WarningParserMonoid Parser a
forall a b. (a -> b) -> a -> b
$
      String
"failed to parse field " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      Text -> String
forall a. Show a => a -> String
show Text
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"keys " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
ss String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not present"
    [Text
s] -> Object
o Object -> Text -> WriterT WarningParserMonoid Parser a
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
s
    [Text]
_ -> String -> WriterT WarningParserMonoid Parser a
forall a. String -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WriterT WarningParserMonoid Parser a)
-> String -> WriterT WarningParserMonoid Parser a
forall a b. (a -> b) -> a -> b
$
      String
"failed to parse field " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      Text -> String
forall a. Show a => a -> String
show Text
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"two or more synonym keys " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      [Text] -> String
forall a. Show a => a -> String
show [Text]
ss String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" present"

-- | Synonym version of @..:?@.

(...:?) :: FromJSON a => Object -> [Text] -> WarningParser (Maybe a)
Object
_ ...:? :: forall a. FromJSON a => Object -> [Text] -> WarningParser (Maybe a)
...:? [] = String -> WriterT WarningParserMonoid Parser (Maybe a)
forall a. String -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to find an empty key"
Object
o ...:? ss :: [Text]
ss@(Text
key:[Text]
_) = WriterT WarningParserMonoid Parser (Maybe a)
apply
 where
  apply :: WriterT WarningParserMonoid Parser (Maybe a)
apply = case Object -> [Text] -> [Text]
present Object
o [Text]
ss of
    [] -> Maybe a -> WriterT WarningParserMonoid Parser (Maybe a)
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    [Text
s] -> Object
o Object -> Text -> WriterT WarningParserMonoid Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
s
    [Text]
_ -> String -> WriterT WarningParserMonoid Parser (Maybe a)
forall a. String -> WriterT WarningParserMonoid Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WriterT WarningParserMonoid Parser (Maybe a))
-> String -> WriterT WarningParserMonoid Parser (Maybe a)
forall a b. (a -> b) -> a -> b
$
      String
"failed to parse field " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      Text -> String
forall a. Show a => a -> String
show Text
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"two or more synonym keys " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      [Text] -> String
forall a. Show a => a -> String
show [Text]
ss String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" present"

-- | Tell the warning parser about an expected field, so it doesn't warn about

-- it.

tellJSONField :: Text -> WarningParser ()
tellJSONField :: Text -> WarningParser ()
tellJSONField Text
key = WarningParserMonoid -> WarningParser ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (WarningParserMonoid
forall a. Monoid a => a
mempty { wpmExpectedFields = Set.singleton key})

-- | 'WarningParser' version of 'withObject'.

withObjectWarnings ::
     String
  -> (Object -> WarningParser a)
  -> Value
  -> Parser (WithJSONWarnings a)
withObjectWarnings :: forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
expected Object -> WarningParser a
f =
  String
-> (Object -> Parser (WithJSONWarnings a))
-> Value
-> Parser (WithJSONWarnings a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
expected ((Object -> Parser (WithJSONWarnings a))
 -> Value -> Parser (WithJSONWarnings a))
-> (Object -> Parser (WithJSONWarnings a))
-> Value
-> Parser (WithJSONWarnings a)
forall a b. (a -> b) -> a -> b
$
  \Object
obj -> do
    (a
a,WarningParserMonoid
w) <- WarningParser a -> Parser (a, WarningParserMonoid)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (Object -> WarningParser a
f Object
obj)
    let unrecognizedFields :: [Text]
unrecognizedFields =
          Set Text -> [Text]
forall a. Set a -> [a]
Set.toList
            ( Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Set.difference
                ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ((Key -> Text) -> [Key] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Key -> Text
keyToText (Object -> [Key]
forall v. KeyMap v -> [Key]
HashMap.keys Object
obj)))
                (WarningParserMonoid -> Set Text
wpmExpectedFields WarningParserMonoid
w)
            )
    WithJSONWarnings a -> Parser (WithJSONWarnings a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( a -> [JSONWarning] -> WithJSONWarnings a
forall a. a -> [JSONWarning] -> WithJSONWarnings a
WithJSONWarnings a
a
          ( WarningParserMonoid -> [JSONWarning]
wpmWarnings WarningParserMonoid
w [JSONWarning] -> [JSONWarning] -> [JSONWarning]
forall a. [a] -> [a] -> [a]
++
            case [Text]
unrecognizedFields of
                [] -> []
                [Text]
_ -> [String -> [Text] -> JSONWarning
JSONUnrecognizedFields String
expected [Text]
unrecognizedFields]
          )
      )

-- | Convert a 'WarningParser' to a 'Parser'.

unWarningParser :: WarningParser a -> Parser a
unWarningParser :: forall a. WarningParser a -> Parser a
unWarningParser WarningParser a
wp = do
  (a
a,WarningParserMonoid
_) <- WarningParser a -> Parser (a, WarningParserMonoid)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WarningParser a
wp
  a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | Log JSON warnings.

logJSONWarnings ::
     (MonadReader env m, HasLogFunc env, HasCallStack, MonadIO m)
  => FilePath
  -> [JSONWarning]
  -> m ()
logJSONWarnings :: forall env (m :: * -> *).
(MonadReader env m, HasLogFunc env, HasCallStack, MonadIO m) =>
String -> [JSONWarning] -> m ()
logJSONWarnings String
fp =
  (JSONWarning -> m ()) -> [JSONWarning] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\JSONWarning
w -> Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn (Utf8Builder
"Warning: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
fp Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> JSONWarning -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow JSONWarning
w))

-- | Handle warnings in a sub-object.

jsonSubWarnings :: WarningParser (WithJSONWarnings a) -> WarningParser a
jsonSubWarnings :: forall a. WarningParser (WithJSONWarnings a) -> WarningParser a
jsonSubWarnings WarningParser (WithJSONWarnings a)
f = do
  WithJSONWarnings a
result [JSONWarning]
warnings <- WarningParser (WithJSONWarnings a)
f
  WarningParserMonoid -> WarningParser ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell
    ( WarningParserMonoid
forall a. Monoid a => a
mempty
        { wpmWarnings = warnings
        }
    )
  a -> WarningParser a
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

-- | Handle warnings in a @Traversable@ of sub-objects.

jsonSubWarningsT ::
     Traversable t
  => WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT :: forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT WarningParser (t (WithJSONWarnings a))
f =
  (WithJSONWarnings a -> WriterT WarningParserMonoid Parser a)
-> t (WithJSONWarnings a)
-> WriterT WarningParserMonoid Parser (t a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM (WarningParser (WithJSONWarnings a)
-> WriterT WarningParserMonoid Parser a
forall a. WarningParser (WithJSONWarnings a) -> WarningParser a
jsonSubWarnings (WarningParser (WithJSONWarnings a)
 -> WriterT WarningParserMonoid Parser a)
-> (WithJSONWarnings a -> WarningParser (WithJSONWarnings a))
-> WithJSONWarnings a
-> WriterT WarningParserMonoid Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithJSONWarnings a -> WarningParser (WithJSONWarnings a)
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (t (WithJSONWarnings a)
 -> WriterT WarningParserMonoid Parser (t a))
-> WarningParser (t (WithJSONWarnings a))
-> WriterT WarningParserMonoid Parser (t a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WarningParser (t (WithJSONWarnings a))
f

-- | Handle warnings in a @Maybe Traversable@ of sub-objects.

jsonSubWarningsTT ::
     (Traversable t, Traversable u)
  => WarningParser (u (t (WithJSONWarnings a)))
  -> WarningParser (u (t a))
jsonSubWarningsTT :: forall (t :: * -> *) (u :: * -> *) a.
(Traversable t, Traversable u) =>
WarningParser (u (t (WithJSONWarnings a)))
-> WarningParser (u (t a))
jsonSubWarningsTT WarningParser (u (t (WithJSONWarnings a)))
f =
  (t (WithJSONWarnings a)
 -> WriterT WarningParserMonoid Parser (t a))
-> u (t (WithJSONWarnings a))
-> WriterT WarningParserMonoid Parser (u (t a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> u a -> m (u b)
mapM (WarningParser (t (WithJSONWarnings a))
-> WriterT WarningParserMonoid Parser (t a)
forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT (WarningParser (t (WithJSONWarnings a))
 -> WriterT WarningParserMonoid Parser (t a))
-> (t (WithJSONWarnings a)
    -> WarningParser (t (WithJSONWarnings a)))
-> t (WithJSONWarnings a)
-> WriterT WarningParserMonoid Parser (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (WithJSONWarnings a) -> WarningParser (t (WithJSONWarnings a))
forall a. a -> WriterT WarningParserMonoid Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (u (t (WithJSONWarnings a))
 -> WriterT WarningParserMonoid Parser (u (t a)))
-> WarningParser (u (t (WithJSONWarnings a)))
-> WriterT WarningParserMonoid Parser (u (t a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WarningParser (u (t (WithJSONWarnings a)))
f

-- Parsed JSON value without any warnings.

noJSONWarnings :: a -> WithJSONWarnings a
noJSONWarnings :: forall a. a -> WithJSONWarnings a
noJSONWarnings a
v = a -> [JSONWarning] -> WithJSONWarnings a
forall a. a -> [JSONWarning] -> WithJSONWarnings a
WithJSONWarnings a
v []

-- | A JSON parser that warns about unexpected fields in objects.

type WarningParser a = WriterT WarningParserMonoid Parser a

-- | Monoid used by 'WarningParser' to track expected fields and warnings.

data WarningParserMonoid = WarningParserMonoid
  { WarningParserMonoid -> Set Text
wpmExpectedFields :: !(Set Text)
  , WarningParserMonoid -> [JSONWarning]
wpmWarnings :: [JSONWarning]
  } deriving (forall x. WarningParserMonoid -> Rep WarningParserMonoid x)
-> (forall x. Rep WarningParserMonoid x -> WarningParserMonoid)
-> Generic WarningParserMonoid
forall x. Rep WarningParserMonoid x -> WarningParserMonoid
forall x. WarningParserMonoid -> Rep WarningParserMonoid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WarningParserMonoid -> Rep WarningParserMonoid x
from :: forall x. WarningParserMonoid -> Rep WarningParserMonoid x
$cto :: forall x. Rep WarningParserMonoid x -> WarningParserMonoid
to :: forall x. Rep WarningParserMonoid x -> WarningParserMonoid
Generic

instance Semigroup WarningParserMonoid where
  <> :: WarningParserMonoid -> WarningParserMonoid -> WarningParserMonoid
(<>) = WarningParserMonoid -> WarningParserMonoid -> WarningParserMonoid
forall a. (Generic a, Monoid' (Rep a)) => a -> a -> a
mappenddefault

instance Monoid WarningParserMonoid where
  mempty :: WarningParserMonoid
mempty = WarningParserMonoid
forall a. (Generic a, Monoid' (Rep a)) => a
memptydefault
  mappend :: WarningParserMonoid -> WarningParserMonoid -> WarningParserMonoid
mappend = WarningParserMonoid -> WarningParserMonoid -> WarningParserMonoid
forall a. Semigroup a => a -> a -> a
(<>)

instance IsString WarningParserMonoid where
  fromString :: String -> WarningParserMonoid
fromString String
s = WarningParserMonoid
forall a. Monoid a => a
mempty { wpmWarnings = [fromString s] }

-- Parsed JSON value with its warnings.

data WithJSONWarnings a = WithJSONWarnings a [JSONWarning]
  deriving (WithJSONWarnings a -> WithJSONWarnings a -> Bool
(WithJSONWarnings a -> WithJSONWarnings a -> Bool)
-> (WithJSONWarnings a -> WithJSONWarnings a -> Bool)
-> Eq (WithJSONWarnings a)
forall a. Eq a => WithJSONWarnings a -> WithJSONWarnings a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithJSONWarnings a -> WithJSONWarnings a -> Bool
== :: WithJSONWarnings a -> WithJSONWarnings a -> Bool
$c/= :: forall a. Eq a => WithJSONWarnings a -> WithJSONWarnings a -> Bool
/= :: WithJSONWarnings a -> WithJSONWarnings a -> Bool
Eq, (forall x. WithJSONWarnings a -> Rep (WithJSONWarnings a) x)
-> (forall x. Rep (WithJSONWarnings a) x -> WithJSONWarnings a)
-> Generic (WithJSONWarnings a)
forall x. Rep (WithJSONWarnings a) x -> WithJSONWarnings a
forall x. WithJSONWarnings a -> Rep (WithJSONWarnings a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (WithJSONWarnings a) x -> WithJSONWarnings a
forall a x. WithJSONWarnings a -> Rep (WithJSONWarnings a) x
$cfrom :: forall a x. WithJSONWarnings a -> Rep (WithJSONWarnings a) x
from :: forall x. WithJSONWarnings a -> Rep (WithJSONWarnings a) x
$cto :: forall a x. Rep (WithJSONWarnings a) x -> WithJSONWarnings a
to :: forall x. Rep (WithJSONWarnings a) x -> WithJSONWarnings a
Generic, Int -> WithJSONWarnings a -> String -> String
[WithJSONWarnings a] -> String -> String
WithJSONWarnings a -> String
(Int -> WithJSONWarnings a -> String -> String)
-> (WithJSONWarnings a -> String)
-> ([WithJSONWarnings a] -> String -> String)
-> Show (WithJSONWarnings a)
forall a. Show a => Int -> WithJSONWarnings a -> String -> String
forall a. Show a => [WithJSONWarnings a] -> String -> String
forall a. Show a => WithJSONWarnings a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithJSONWarnings a -> String -> String
showsPrec :: Int -> WithJSONWarnings a -> String -> String
$cshow :: forall a. Show a => WithJSONWarnings a -> String
show :: WithJSONWarnings a -> String
$cshowList :: forall a. Show a => [WithJSONWarnings a] -> String -> String
showList :: [WithJSONWarnings a] -> String -> String
Show)

instance Functor WithJSONWarnings where
  fmap :: forall a b. (a -> b) -> WithJSONWarnings a -> WithJSONWarnings b
fmap a -> b
f (WithJSONWarnings a
x [JSONWarning]
w) = b -> [JSONWarning] -> WithJSONWarnings b
forall a. a -> [JSONWarning] -> WithJSONWarnings a
WithJSONWarnings (a -> b
f a
x) [JSONWarning]
w

instance Monoid a => Semigroup (WithJSONWarnings a) where
  <> :: WithJSONWarnings a -> WithJSONWarnings a -> WithJSONWarnings a
(<>) = WithJSONWarnings a -> WithJSONWarnings a -> WithJSONWarnings a
forall a. (Generic a, Monoid' (Rep a)) => a -> a -> a
mappenddefault

instance Monoid a => Monoid (WithJSONWarnings a) where
  mempty :: WithJSONWarnings a
mempty = WithJSONWarnings a
forall a. (Generic a, Monoid' (Rep a)) => a
memptydefault
  mappend :: WithJSONWarnings a -> WithJSONWarnings a -> WithJSONWarnings a
mappend = WithJSONWarnings a -> WithJSONWarnings a -> WithJSONWarnings a
forall a. Semigroup a => a -> a -> a
(<>)

-- | Warning output from 'WarningParser'.

data JSONWarning
  = JSONUnrecognizedFields String [Text]
  | JSONGeneralWarning !Text
  deriving JSONWarning -> JSONWarning -> Bool
(JSONWarning -> JSONWarning -> Bool)
-> (JSONWarning -> JSONWarning -> Bool) -> Eq JSONWarning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSONWarning -> JSONWarning -> Bool
== :: JSONWarning -> JSONWarning -> Bool
$c/= :: JSONWarning -> JSONWarning -> Bool
/= :: JSONWarning -> JSONWarning -> Bool
Eq

instance Show JSONWarning where
  show :: JSONWarning -> String
show = Text -> String
T.unpack (Text -> String) -> (JSONWarning -> Text) -> JSONWarning -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (JSONWarning -> Utf8Builder) -> JSONWarning -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONWarning -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display

instance Display JSONWarning where
  display :: JSONWarning -> Utf8Builder
display (JSONUnrecognizedFields String
obj [Text
field]) =
    Utf8Builder
"Unrecognized field in " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
obj Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
field
  display (JSONUnrecognizedFields String
obj [Text]
fields) =
       Utf8Builder
"Unrecognized fields in "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
obj
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
    Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Text -> [Text] -> Text
T.intercalate Text
", " [Text]
fields)
  display (JSONGeneralWarning Text
t) = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
t

instance IsString JSONWarning where
  fromString :: String -> JSONWarning
fromString = Text -> JSONWarning
JSONGeneralWarning (Text -> JSONWarning) -> (String -> Text) -> String -> JSONWarning
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance FromJSON (WithJSONWarnings StylesUpdate) where
  parseJSON :: Value -> Parser (WithJSONWarnings StylesUpdate)
parseJSON Value
v = StylesUpdate -> WithJSONWarnings StylesUpdate
forall a. a -> WithJSONWarnings a
noJSONWarnings (StylesUpdate -> WithJSONWarnings StylesUpdate)
-> Parser StylesUpdate -> Parser (WithJSONWarnings StylesUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser StylesUpdate
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v